1
2 #include "config.h"
3
4 #define PL_KERNEL 1
5
6 #ifdef __MINGW32__
7 #define O_XOS 1
8 #endif
9
10 #include <SWI-Prolog.h>
11 typedef int bool;
12
13 #define Arg(N) (PL__t0+((n)-1))
14 #define A1 (PL__t0)
15 #define A2 (PL__t0+1)
16 #define A3 (PL__t0+2)
17 #define A3 (PL__t0+2)
18 #define A4 (PL__t0+3)
19 #define A5 (PL__t0+4)
20 #define A6 (PL__t0+5)
21 #define A7 (PL__t0+6)
22 #define A8 (PL__t0+7)
23 #define A9 (PL__t0+8)
24 #define A10 (PL__t0+9)
25
26
27 /* atom_t macro layer */
28 #define NULL_ATOM ((atom_t)0)
29 #if __YAP_PROLOG__
30 #include "dswiatoms.h"
31 #else
32 #include "atoms.h"
33 #endif
34 #if HAVE_STRING_H
35 #include <string.h>
36 #endif
37 #define COMMON(X) X
38
39 #ifdef HAVE_LOCALE_H
40 #include <locale.h>
41 #endif
42 #include <setjmp.h>
43 #include <assert.h>
44 #if HAVE_SYS_PARAM_H
45 #include <sys/param.h> //MAXPATHLEN
46 #endif
47 #if __YAP_PROLOG__
48 #include "pl-yap.h"
49 #endif
50
51
52 /********************************
53 * UTILITIES *
54 *********************************/
55 #define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
56
57 /********************************
58 * HASH TABLES *
59 *********************************/
60
61 #include "pl-table.h"
62 #include "SWI-Stream.h"
63 #include "pl-os.h"
64 #include "pl-error.h"
65
66 /********************************
67 * BUFFERS *
68 *********************************/
69
70 #include "pl-buffer.h"
71
72 /*******************************
73 * OPTION LISTS *
74 *******************************/
75
76 #include "pl-opts.h"
77
78 /*******************************
79 * LIST BUILDING *
80 *******************************/
81
82 #include "pl-privitf.h"
83
84 // numbers
85
86 typedef enum
87 { V_INTEGER, /* integer (64-bit) value */
88 #ifdef O_GMP
89 V_MPZ, /* mpz_t */
90 V_MPQ, /* mpq_t */
91 #endif
92 V_REAL /* Floating point number (double) */
93 } numtype;
94
95 typedef struct
96 { numtype type; /* type of number */
97 union { double f; /* value as real */
98 int64_t i; /* value as integer */
99 word w[WORDS_PER_DOUBLE]; /* for packing/unpacking the double */
100 #ifdef O_GMP
101 mpz_t mpz; /* GMP integer */
102 mpq_t mpq; /* GMP rational */
103 #endif
104 } value;
105 } number, *Number;
106
107 typedef enum
108 { CLN_NORMAL = 0, /* Normal mode */
109 CLN_ACTIVE, /* Started cleanup */
110 CLN_FOREIGN, /* Foreign hooks */
111 CLN_PROLOG, /* Prolog hooks */
112 CLN_SHARED, /* Unload shared objects */
113 CLN_DATA /* Remaining data */
114 } cleanup_status;
115
116 typedef struct tempfile * TempFile; /* pl-os.c */
117 typedef struct canonical_dir * CanonicalDir; /* pl-os.c */
118 typedef struct on_halt * OnHalt; /* pl-os.c */
119 typedef struct extension_cell * ExtensionCell; /* pl-ext.c */
120 typedef struct initialise_handle * InitialiseHandle;
121
122 /* The GD global variable */
123 typedef struct {
124 int io_initialised;
125 cleanup_status cleaning; /* Inside PL_cleanup() */
126
127 struct
128 { Table table; /* global (read-only) features */
129 } prolog_flag;
130
131 #if THREADS
132 struct
133 { int enabled; /* threads are enabled */
134 } thread;
135 #endif
136
137 struct
138 { Table tmp_files; /* Known temporary files */
139 CanonicalDir _canonical_dirlist;
140 char * myhome; /* expansion of ~ */
141 char * fred; /* last expanded ~user */
142 char * fredshome; /* home of fred */
143 OnHalt on_halt_list; /* list of onhalt hooks */
144 int halting; /* process is shutting down */
145 int gui_app; /* Win32: Application is a gui app */
146 IOFUNCTIONS iofunctions; /* initial IO functions */
147 IOFUNCTIONS org_terminal; /* IO+Prolog terminal functions */
148 IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
149 } os;
150
151 struct
152 { size_t heap; /* heap in use */
153 size_t atoms; /* No. of atoms defined */
154 size_t atomspace; /* # bytes used to store atoms */
155 size_t stack_space; /* # bytes on stacks */
156 #ifdef O_ATOMGC
157 size_t atomspacefreed; /* Freed atom-space */
158 #endif
159 int functors; /* No. of functors defined */
160 int predicates; /* No. of predicates defined */
161 int modules; /* No. of modules in the system */
162 intptr_t codes; /* No. of byte codes generated */
163 #ifdef O_PLMT
164 int threads_created; /* # threads created */
165 int threads_finished; /* # finished threads */
166 double thread_cputime; /* Total CPU time of threads */
167 #endif
168 } statistics;
169
170 struct
171 { atom_t * array; /* index --> atom */
172 size_t count; /* elements in array */
173 atom_t *for_code[256]; /* code --> one-char-atom */
174 } atoms;
175
176 struct
177 { ExtensionCell _ext_head; /* head of registered extensions */
178 ExtensionCell _ext_tail; /* tail of this chain */
179
180 InitialiseHandle initialise_head; /* PL_initialise_hook() */
181 InitialiseHandle initialise_tail;
182 PL_dispatch_hook_t dispatch_events; /* PL_dispatch_hook() */
183
184 int _loaded; /* system extensions are loaded */
185 } foreign;
186
187 } gds_t;
188
189 extern gds_t gds;
190
191 #define GD (&gds)
192 #define GLOBAL_LD (&gds)
193
194
195
196 typedef struct
197 { unsigned long flags; /* Fast access to some boolean Prolog flags */
198 } pl_features_t;
199
200 #define truePrologFlag(flag) true(&LD->prolog_flag.mask, flag)
201 #define setPrologFlagMask(flag) set(&LD->prolog_flag.mask, flag)
202 #define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag)
203
204
205 // LOCAL variables (heap will get this form LOCAL
206
207 #define FT_ATOM 0 /* atom feature */
208 #define FT_BOOL 1 /* boolean feature (true, false) */
209 #define FT_INTEGER 2 /* integer feature */
210 #define FT_TERM 3 /* term feature */
211 #define FT_INT64 4 /* passed as int64_t */
212 #define FT_MASK 0x0f /* mask to get type */
213
214 #define FF_READONLY 0x10 /* feature is read-only */
215 #define FF_KEEP 0x20 /* keep value it already set */
216
217 #define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */
218 #define PLFLAG_GC 0x000002 /* do GC */
219 #define PLFLAG_TRACE_GC 0x000004 /* verbose gc */
220 #define PLFLAG_TTY_CONTROL 0x000008 /* allow for tty control */
221 #define PLFLAG_READLINE 0x000010 /* readline is loaded */
222 #define PLFLAG_DEBUG_ON_ERROR 0x000020 /* start tracer on error */
223 #define PLFLAG_REPORT_ERROR 0x000040 /* print error message */
224 #define PLFLAG_FILE_CASE 0x000080 /* file names are case sensitive */
225 #define PLFLAG_FILE_CASE_PRESERVING 0x000100 /* case preserving file names */
226 #define PLFLAG_DOS_FILE_NAMES 0x000200 /* dos (8+3) file names */
227 #define ALLOW_VARNAME_FUNCTOR 0x000400 /* Read Foo(x) as 'Foo'(x) */
228 #define PLFLAG_ISO 0x000800 /* Strict ISO compliance */
229 #define PLFLAG_OPTIMISE 0x001000 /* -O: optimised compilation */
230 #define PLFLAG_FILEVARS 0x002000 /* Expand $var and ~ in filename */
231 #define PLFLAG_AUTOLOAD 0x004000 /* do autoloading */
232 #define PLFLAG_CHARCONVERSION 0x008000 /* do character-conversion */
233 #define PLFLAG_LASTCALL 0x010000 /* Last call optimization enabled? */
234 #define PLFLAG_EX_ABORT 0x020000 /* abort with exception */
235 #define PLFLAG_BACKQUOTED_STRING 0x040000 /* `a string` */
236 #define PLFLAG_SIGNALS 0x080000 /* Handle signals */
237 #define PLFLAG_DEBUGINFO 0x100000 /* generate debug info */
238 #define PLFLAG_FILEERRORS 0x200000 /* Edinburgh file errors */
239
240 typedef enum
241 { OCCURS_CHECK_FALSE = 0,
242 OCCURS_CHECK_TRUE,
243 OCCURS_CHECK_ERROR
244 } occurs_check_t;
245
246 typedef struct
247 { atom_t file; /* current source file */
248 int line; /* current line */
249 int linepos; /* position in the line */
250 int64_t character; /* current character location */
251 } source_location;
252
253
254 typedef struct exception_frame /* PL_throw exception environments */
255 { struct exception_frame *parent; /* parent frame */
256 jmp_buf exception_jmp_env; /* longjmp environment */
257 } exception_frame;
258
259 #define EXCEPTION_GUARDED(code, cleanup) \
260 { exception_frame __throw_env; \
261 __throw_env.parent = LD->exception.throw_environment; \
262 if ( setjmp(__throw_env.exception_jmp_env) != 0 ) \
263 { LD->exception.throw_environment = __throw_env.parent; \
264 cleanup; \
265 } else \
266 { LD->exception.throw_environment = &__throw_env; \
267 code; \
268 LD->exception.throw_environment = __throw_env.parent; \
269 } \
270 }
271
272 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
273 At times an abort is not allowed because the heap is inconsistent the
274 programmer should call startCritical to start such a code region and
275 endCritical to end it.
276
277 MT/TBD: how to handle this gracefully in the multi-threading case. Does
278 it mean anything?
279 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
280
281 /* vsc: needs defining */
282 #define startCritical
283 #define endCritical
284
285 /* The LD macro layer */
286 typedef struct PL_local_data {
287
288 struct /* Local IO stuff */
289 { IOSTREAM *streams[6]; /* handles for standard streams */
290 struct input_context *input_stack; /* maintain input stream info */
291 struct output_context *output_stack; /* maintain output stream info */
292 } IO;
293
294 struct
295 { Table table; /* Feature table */
296 pl_features_t mask; /* Masked access to booleans */
297 int write_attributes; /* how to write attvars? */
298 occurs_check_t occurs_check; /* Unify and occurs check */
299 } feature;
300
301 source_location read_source; /* file, line, char of last term */
302
303 struct
304 { int active; /* doing pipe I/O */
305 jmp_buf context; /* context of longjmp() */
306 } pipe;
307
308 struct
309 { atom_t current; /* current global prompt */
310 atom_t first; /* how to prompt first line */
311 int first_used; /* did we do the first line? */
312 int next; /* prompt on next read operation */
313 } prompt;
314
315 struct
316 { Table table; /* Feature table */
317 pl_features_t mask; /* Masked access to booleans */
318 int write_attributes; /* how to write attvars? */
319 occurs_check_t occurs_check; /* Unify and occurs check */
320 } prolog_flag;
321
322 void * glob_info; /* pl-glob.c */
323 IOENC encoding; /* default I/O encoding */
324
325 struct
326 { char * _CWDdir;
327 size_t _CWDlen;
328 #ifdef __BEOS__
329 status_t dl_error; /* dlopen() emulation in pl-beos.c */
330 #endif
331 int rand_initialised; /* have we initialised random? */
332 } os;
333
334 struct
335 { int64_t pending; /* PL_raise() pending signals */
336 int current; /* currently processing signal */
337 int is_sync; /* current signal is synchronous */
338 record_t exception; /* Pending exception from signal */
339 #ifdef O_PLMT
340 simpleMutex sig_lock; /* lock delivery and processing */
341 #endif
342 } signal;
343
344 int critical; /* heap is being modified */
345
346 struct
347 { term_t term; /* exception term */
348 term_t bin; /* temporary handle for exception */
349 term_t printed; /* already printed exception */
350 term_t tmp; /* tmp for errors */
351 term_t pending; /* used by the debugger */
352 int in_hook; /* inside exception_hook() */
353 int processing; /* processing an exception */
354 exception_frame *throw_environment; /* PL_throw() environments */
355 } exception;
356 const char *float_format; /* floating point format */
357
358 buffer discardable_buffer; /* PL_*() character buffers */
359 buffer buffer_ring[BUFFER_RING_SIZE];
360 int current_buffer_id;
361
362 } PL_local_data_t;
363
364 #define usedStack(D) 0
365
366 #define features (LD->feature.mask)
367
368 extern PL_local_data_t lds;
369
370 #define exception_term (LD->exception.term)
371
372 // THIS HAS TO BE ABSTRACTED
373
374 #define LD (&lds)
375 #define LOCAL_LD (&lds)
376
377 #define ARG_LD
378 #define GET_LD
379 #define PRED_LD
380 #define PASS_LD
381
382 #define Suser_input (LD->IO.streams[0])
383 #define Suser_output (LD->IO.streams[1])
384 #define Suser_error (LD->IO.streams[2])
385 #define Scurin (LD->IO.streams[3])
386 #define Scurout (LD->IO.streams[4])
387 #define Sprotocol (LD->IO.streams[5])
388 #define Sdin Suser_input /* not used for now */
389 #define Sdout Suser_output
390
391 #define source_line_no (LD->read_source.line)
392 #define source_file_name (LD->read_source.file)
393
394
395 /* Support PL_LOCK in the interface */
396 #if THREADS
397
398 typedef pthread_mutex_t simpleMutex;
399
400 #define simpleMutexInit(p) pthread_mutex_init(p, NULL)
401 #define simpleMutexDelete(p) pthread_mutex_destroy(p)
402 #define simpleMutexLock(p) pthread_mutex_lock(p)
403 #define simpleMutexUnlock(p) pthread_mutex_unlock(p)
404
405 extern counting_mutex _PL_mutexes[]; /* Prolog mutexes */
406
407 #define L_MISC 0
408 #define L_ALLOC 1
409 #define L_ATOM 2
410 #define L_FLAG 3
411 #define L_FUNCTOR 4
412 #define L_RECORD 5
413 #define L_THREAD 6
414 #define L_PREDICATE 7
415 #define L_MODULE 8
416 #define L_TABLE 9
417 #define L_BREAK 10
418 #define L_FILE 11
419 #define L_PLFLAG 12
420 #define L_OP 13
421 #define L_INIT 14
422 #define L_TERM 15
423 #define L_GC 16
424 #define L_AGC 17
425 #define L_FOREIGN 18
426 #define L_OS 19
427
428 #define IF_MT(id, g) if ( id == L_THREAD || GD->thread.enabled ) g
429
430 #ifdef O_CONTENTION_STATISTICS
431 #define countingMutexLock(cm) \
432 do \
433 { if ( pthread_mutex_trylock(&(cm)->mutex) == EBUSY ) \
434 { (cm)->collisions++; \
435 pthread_mutex_lock(&(cm)->mutex); \
436 } \
437 (cm)->count++; \
438 } while(0)
439 #else
440 #define countingMutexLock(cm) \
441 do \
442 { simpleMutexLock(&(cm)->mutex); \
443 (cm)->count++; \
444 } while(0)
445 #endif
446 #define countingMutexUnlock(cm) \
447 do \
448 { (cm)->unlocked++; \
449 assert((cm)->unlocked <= (cm)->count); \
450 simpleMutexUnlock(&(cm)->mutex); \
451 } while(0)
452
453 #define PL_LOCK(id) IF_MT(id, countingMutexLock(&_PL_mutexes[id]))
454 #define PL_UNLOCK(id) IF_MT(id, countingMutexUnlock(&_PL_mutexes[id]))
455
456 #else
457 #define PL_LOCK(X)
458 #define PL_UNLOCK(X)
459 #endif
460
461
462 #ifndef TRUE
463 #define TRUE 1
464 #define FALSE 0
465 #endif
466 #define succeed return TRUE
467 #define fail return FALSE
468 #define TRY(goal) if ((goal) == FALSE) fail
469
470
471 extern int fileerrors;
472
473 extern int ttymode;
474
475 #define CHARESCAPE_FEATURE 0x00001 /* handle \ in atoms */
476 #define GC_FEATURE 0x00002 /* do GC */
477 #define TRACE_GC_FEATURE 0x00004 /* verbose gc */
478 #define TTY_CONTROL_FEATURE 0x00008 /* allow for tty control */
479 #define READLINE_FEATURE 0x00010 /* readline is loaded */
480 #define DEBUG_ON_ERROR_FEATURE 0x00020 /* start tracer on error */
481 #define REPORT_ERROR_FEATURE 0x00040 /* print error message */
482 #define FILE_CASE_FEATURE 0x00080 /* file names are case sensitive */
483 #define FILE_CASE_PRESERVING_FEATURE 0x0100 /* case preserving file names */
484 #define DOS_FILE_NAMES_FEATURE 0x00200 /* dos (8+3) file names */
485 #define ISO_FEATURE 0x00800 /* Strict ISO compliance */
486 #define OPTIMISE_FEATURE 0x01000 /* -O: optimised compilation */
487 #define FILEVARS_FEATURE 0x02000 /* Expand $var and ~ in filename */
488 #define AUTOLOAD_FEATURE 0x04000 /* do autoloading */
489 #define CHARCONVERSION_FEATURE 0x08000 /* do character-conversion */
490 #define LASTCALL_FEATURE 0x10000 /* Last call optimization enabled? */
491 #define EX_ABORT_FEATURE 0x20000 /* abort with exception */
492 #define BACKQUOTED_STRING_FEATURE 0x40000 /* `a string` */
493 #define SIGNALS_FEATURE 0x80000 /* Handle signals */
494 #define DEBUGINFO_FEATURE 0x100000 /* generate debug info */
495
496 int defFeature(const char *c, int f, ...);
497
498 int trueFeature(int f);
499
500 /*******************************
501 * STREAM I/O *
502 *******************************/
503
504 #define REDIR_MAGIC 0x23a9bef3
505
506 typedef struct redir_context
507 { int magic; /* REDIR_MAGIC */
508 IOSTREAM *stream; /* temporary output */
509 int is_stream; /* redirect to stream */
510 int redirected; /* output is redirected */
511 term_t term; /* redirect target */
512 int out_format; /* output type */
513 int out_arity; /* 2 for difference-list versions */
514 size_t size; /* size of I/O buffer */
515 char *data; /* data written */
516 char buffer[1024]; /* fast temporary buffer */
517 } redir_context;
518
519
520 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
521 Defining built-in predicates using the new interface
522 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
523
524 #define EOS '\0'
525 #define ESC ((char) 27)
526 #define streq(s, q) ((strcmp((s), (q)) == 0))
527
528 #define CHAR_MODE 0 /* See PL_unify_char() */
529 #define CODE_MODE 1
530 #define BYTE_MODE 2
531
532
533 /* string stuff */
534 /*******************************
535 * STRING SUPPORT *
536 *******************************/
537 char * store_string(const char *s);
538 void remove_string(char *s);
539
540
541 /* from foreign interface */
542 /*******************************
543 * FILENAME SUPPORT *
544 *******************************/
545
546 #define PL_FILE_ABSOLUTE 0x01 /* return absolute path */
547 #define PL_FILE_OSPATH 0x02 /* return path in OS notation */
548 #define PL_FILE_SEARCH 0x04 /* use file_search_path */
549 #define PL_FILE_EXIST 0x08 /* demand file to exist */
550 #define PL_FILE_READ 0x10 /* demand read-access */
551 #define PL_FILE_WRITE 0x20 /* demand write-access */
552 #define PL_FILE_EXECUTE 0x40 /* demand execute-access */
553 #define PL_FILE_NOERRORS 0x80 /* do not raise exceptions */
554
555
556 #define PL_FA_ISO (0x20) /* Internal: ISO core predicate */
557
558 /********************************
559 * READ WARNINGS *
560 *********************************/
561
562 #define ReadingSource (source_line_no > 0 && \
563 source_file_name != NULL_ATOM)
564
565
566 #include <pl-text.h>
567
568 typedef double real;
569
570 #define true(s, a) ((s)->flags & (a))
571 #define false(s, a) (!true((s), (a)))
572 #define set(s, a) ((s)->flags |= (a))
573 #define clear(s, a) ((s)->flags &= ~(a))
574 #define DEBUG(LEVEL, COMMAND)
575
576 #define forwards static /* forwards function declarations */
577
578 /* uxnt package interface */
579 #if defined(__YAP_PROLOG__) && defined(__MINGW32__)
580 #define O_XOS 1
581
582 #define _XOS_ISFILE 0x01
583 #define _XOS_ISDIR 0x02
584
585 #define _XOS_FILE 0x0001 /* is a file */
586 #define _XOS_DIR 0x0002 /* is a directory */
587
588 #define XOS_DOWNCASE 0x01 /* _xos_canonical_filename() */
589
590 #ifndef __WINDOWS__
591 #define __WINDOWS__ 1
592 #endif
593
594 #endif
595
596 extern int PL_unify_char(term_t chr, int c, int how);
597 extern int PL_get_char(term_t chr, int *c, int eof);
598 extern int PL_get_text(term_t l, PL_chars_t *text, int flags);
599 extern void PL_cleanup_fork(void);
600 extern int PL_rethrow(void);
601 extern void PL_get_number(term_t l, number *n);
602 extern int PL_unify_atomic(term_t t, PL_atomic_t a);
603
604 #define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
605 #define _PL_unify_atomic PL_unify_atomic
606 extern IOSTREAM ** /* provide access to Suser_input, */
607 _PL_streams(void); /* Suser_output and Suser_error */
608
609 #define PL_get_text__LD PL_get_text
610 #define getInputStream__LD getInputStream
611 extern int get_atom_text(atom_t atom, PL_chars_t *text);
612 extern int get_string_text(word w, PL_chars_t *text);
613 extern char *format_float(double f, char *buf, const char *format);
614
615 /**** stuff from pl-ctype.c ****/
616 extern IOENC initEncoding(void);
617
618 /**** stuff from pl-error.c ****/
619 extern int PL_get_bool_ex(term_t t, int *i);
620 extern int PL_get_nchars_ex(term_t t, size_t *len, char **s, unsigned int flags);
621 extern int PL_get_chars_ex(term_t t, char **s, unsigned int flags);
622 extern int PL_get_atom_ex(term_t t, atom_t *a);
623 extern int PL_get_integer_ex(term_t t, int *i);
624 extern int PL_get_long_ex(term_t t, long *i);
625 extern int PL_get_int64_ex(term_t t, int64_t *i);
626 extern int PL_get_intptr_ex(term_t t, intptr_t *i);
627 extern int PL_get_bool_ex(term_t t, int *i);
628 extern int PL_get_float_ex(term_t t, double *f);
629 extern int PL_get_char_ex(term_t t, int *p, int eof);
630 extern int PL_unify_list_ex(term_t l, term_t h, term_t t);
631 extern int PL_unify_nil_ex(term_t l);
632 extern int PL_get_list_ex(term_t l, term_t h, term_t t);
633 extern int PL_get_nil_ex(term_t l);
634 extern int PL_get_module_ex(term_t name, module_t *m);
635 extern int PL_unify_bool_ex(term_t t, bool val);
636 extern int PL_unify_bool_ex(term_t t, bool val);
637 extern int PL_get_bool_ex(term_t t, int *i);
638 extern int PL_get_integer_ex(term_t t, int *i);
639
640 /**** stuff from pl-file.c ****/
641 extern void initIO(void);
642
643 extern void dieIO(void);
644 extern void protocol(const char *str, size_t n);
645 extern bool readLine(IOSTREAM *in, IOSTREAM *out, char *buffer);
646 extern bool tellString(char **s, size_t *size, IOENC enc);
647 extern bool tellString(char **s, size_t *size, IOENC enc);
648 extern bool toldString(void);
649
650 extern int setupOutputRedirect(term_t to, redir_context *ctx, int redir);
651 extern void discardOutputRedirect(redir_context *ctx);
652 extern int closeOutputRedirect(redir_context *ctx);
653
654 extern IOENC atom_to_encoding(atom_t);
655
656 void closeFiles(int);
657 atom_t PrologPrompt(void);
658 word pl_current_input(term_t);
659 word pl_current_output(term_t);
660 word pl_exists_file(term_t name);
661 char *DirName(const char *f, char *dir);
662 void outOfCore(void);
663
664 word pl_noprotocol(void);
665
666 IOSTREAM *PL_current_input(void);
667 IOSTREAM *PL_current_output(void);
668
669 int reportStreamError(IOSTREAM *s);
670
671 PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s);
672 PL_EXPORT(int) PL_unify_stream_or_alias(term_t t, IOSTREAM *s);
673 PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s);
674 PL_EXPORT(void) PL_write_prompt(int);
675 PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
676
677 /**** stuff from pl-error.c ****/
678 extern void outOfCore(void);
679 extern void fatalError(const char *fm, ...);
680 extern void printMessage(int type, ...);
681 extern int callProlog(void * module, term_t goal, int flags, term_t *ex);
682 extern word notImplemented(char *name, int arity);
683
684 /**** stuff from pl-ctype.c ****/
685 extern void initCharTypes(void);
686
687 /**** stuff from pl-glob.c ****/
688 extern void initGlob(void);
689
690 /**** stuff from pl-os.c ****/
691 extern void cleanupOs(void);
692 extern void PL_clock_wait_ticks(long waited);
693 extern void setOSFeatures(void);
694 extern uintptr_t FreeMemory(void);
695 extern uint64_t _PL_Random(void);
696 extern void RemoveTemporaryFiles(void);
697 extern int Pause(real t);
698 char *findExecutable(const char *av0, char *buffer);
699
700 void setOSPrologFlags(void);
701 void setRandom(unsigned int *seedp);
702 char *canoniseFileName(char *path);
703 char *canonisePath(char *path);
704 void PL_changed_cwd(void);
705 struct tm *LocalTime(long *t, struct tm *r);
706 size_t getenv3(const char *name, char *buf, size_t len);
707 int Setenv(char *name, char *value);
708 int Unsetenv(char *name);
709 int System(char *cmd);
710 bool expandVars(const char *pattern, char *expanded, int maxlen);
711
712 /**** stuff from pl-utils.c ****/
713 bool stripostfix(char *s, char *e);
714
715 /**** SWI stuff (emulated in pl-yap.c) ****/
716 extern int writeAtomToStream(IOSTREAM *so, atom_t at);
717 extern int valueExpression(term_t t, Number r ARG_LD);
718 extern word lookupAtom(const char *s, size_t len);
719 extern atom_t lookupUCSAtom(const pl_wchar_t *s, size_t len);
720 extern int toIntegerNumber(Number n, int flags);
721 extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
722 extern int warning(const char *fm, ...);
723
724 /**** stuff from pl-files.c ****/
725 void initFiles(void);
726 int RemoveFile(const char *path);
727 int PL_get_file_name(term_t n, char **namep, int flags);
728
729 /**** stuff from pl-utf8.c ****/
730 size_t utf8_strlen(const char *s, size_t len);
731
732 /* empty stub */
733 void setPrologFlag(const char *name, int flags, ...);
734 void PL_set_prolog_flag(const char *name, int flags, ...);
735
736 static inline word
setBoolean(int * flag,term_t old,term_t new)737 setBoolean(int *flag, term_t old, term_t new)
738 { if ( !PL_unify_bool_ex(old, *flag) ||
739 !PL_get_bool_ex(new, flag) )
740 fail;
741
742 succeed;
743 }
744
745 static inline word
setInteger(int * flag,term_t old,term_t new)746 setInteger(int *flag, term_t old, term_t new)
747 { if ( !PL_unify_integer(old, *flag) ||
748 !PL_get_integer_ex(new, flag) )
749 fail;
750
751 succeed;
752 }
753
754 #if defined(__SWI_PROLOG__)
755
756 static inline word
INIT_SEQ_CODES(size_t n)757 INIT_SEQ_CODES(size_t n)
758 {
759 return allocGlobal(1+(n)*3); /* TBD: shift */
760 }
761
762 static inline word
EXTEND_SEQ_CODES(word gstore,int c)763 EXTEND_SEQ_CODES(word gstore, int c) {
764 *gstore = consPtr(&gstore[1], TAG_COMPOUND|STG_GLOBAL);
765 gstore++;
766 *gstore++ = FUNCTOR_dot2;
767 *gstore++ = consInt(c);
768 return gstore;
769 }
770
771 static inline int
772 CLOSE_SEQ_OF_CODES(word gstore, word lp, word A2, word A3)) {
773 setVar(*gstore);
774 gTop = gstore+1;
775
776 a = valTermRef(A2);
777 deRef(a);
778 if ( !unify_ptrs(a, lp PASS_LD) )
779 return FALSE;
780 a = valTermRef(A3);
781 deRef(a);
782 if ( !unify_ptrs(a, gstore PASS_LD) )
783 return FALSE;
784 return TRUE;
785 }
786
787 #else
788
789 #endif
790