1 /*************************************************************************
2 * *
3 * YAP Prolog %W% %G% *
4 * Yap Prolog was developed at NCCUP - Universidade do Porto *
5 * *
6 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
7 * *
8 **************************************************************************
9 * *
10 * File: Yap.h.m4 *
11 * mods: *
12 * comments: main header file for YAP *
13 * version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
14 *************************************************************************/
15
16 #include "config.h"
17 #if defined(ENV_COPY) || defined(TABLING) || defined(THREADS)
18 #include "opt.config.h"
19 #endif /* YAPOR || TABLING */
20
21 /*
22
23 #define RATIONAL_TREES 1
24
25 #define DEPTH_LIMIT 1
26
27 #define COROUTINING 1
28
29 #define ANALYST 1
30
31 */
32
33 #define MULTI_ASSIGNMENT_VARIABLES 1
34
35 #if defined(YAPOR)
36 #error Do not explicitly define YAPOR
37 #endif /* YAPOR */
38
39 #if (defined(ENV_COPY) && (defined(ACOW) || defined(SBA))) || (defined(ACOW) && defined(SBA))
40 #error Do not define multiple or-parallel models
41 #endif /* (ENV_COPY && (ACOW || SBA)) || (ACOW && SBA) */
42
43 #if defined(ENV_COPY) || defined(ACOW) || defined(SBA) || defined(THREADS)
44 #define YAPOR 1
45 #endif /* ENV_COPY || ACOW || SBA */
46
47 #if defined(TABLING) && (defined(ACOW) || defined(SBA))
48 #error Currently TABLING only works with ENV_COPY
49 #endif /* TABLING && (ACOW || SBA) */
50
51 #ifdef YAPOR
52 #define FIXED_STACKS 1
53 #ifdef THREADS
54 #undef ACOW
55 #undef SBA
56 #undef ENV_COPY
57 #endif
58 #endif /* YAPOR */
59
60 #if defined(YAPOR) || defined(TABLING)
61 #undef TRAILING_REQUIRES_BRANCH
62 #endif /* YAPOR || TABLING */
63
64 #ifdef ANALYST
65 #ifdef USE_THREADED_CODE
66 #undef USE_THREADED_CODE
67 #endif
68 #endif
69
70 #ifdef COROUTINING
71 #ifndef TERM_EXTENSIONS
72 #define TERM_EXTENSIONS 1
73 #endif
74 #endif
75
76 #if defined(SUPPORT_THREADS) || defined(SUPPORT_CONDOR)
77 #define USE_SYSTEM_MALLOC 1
78 #endif
79
80 #if defined(TABLING) || defined(SBA)
81 #define FROZEN_STACKS 1
82 #endif /* TABLING || SBA */
83
84 #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
85 /* adjust a config.h from mingw32 to work with vc++ */
86 #ifdef HAVE_GCC
87 #undef HAVE_GCC
88 #endif
89 #ifdef USE_THREADED_CODE
90 #undef USE_THREADED_CODE
91 #endif
92 #define inline __inline
93 #define YAP_VERSION "YAP-6.2.2"
94
95 #define BIN_DIR "c:\\Yap\\bin"
96 #define LIB_DIR "c:\\Yap\\lib\\Yap"
97 #define SHARE_DIR "c:\\Yap\\share\\Yap"
98 #ifdef HOST_ALIAS
99 #undef HOST_ALIAS
100 #endif
101 #define HOST_ALIAS "i386-pc-win32"
102 #ifdef HAVE_IEEEFP_H
103 #undef HAVE_IEEEFP_H
104 #endif
105 #ifdef HAVE_UNISTD_H
106 #undef HAVE_UNISTD_H
107 #endif
108 #ifdef HAVE_SYS_TIME_H
109 #undef HAVE_SYS_TIME_H
110 #endif
111 #endif
112
113 #ifdef __MINGW32__
114 #ifndef _WIN32
115 #define _WIN32 1
116 #endif
117 #endif
118
119 #if HAVE_GCC
120 #define MIN_ARRAY 0
121 #define DUMMY_FILLER_FOR_ABS_TYPE
122 #else
123 #define MIN_ARRAY 1
124 #define DUMMY_FILLER_FOR_ABS_TYPE int dummy;
125 #endif
126
127 #ifndef ADTDEFS_C
128 #define EXTERN static
129 #else
130 #define EXTERN
131 #endif
132
133 /* truth-values */
134 #define TRUE 1
135 #define FALSE 0
136
137 /* null pointer */
138 #define NIL 0
139
140 /* Basic types */
141
142 /* defines integer types Int and UInt (unsigned) with the same size as a ptr
143 ** and integer types Short and UShort with half the size of a ptr
144 */
145
146 #ifdef THREADS
147 #if USE_PTHREAD_LOCKING
148 #ifndef _XOPEN_SOURCE
149 #define _XOPEN_SOURCE 600
150 #endif
151 #endif
152 #include <pthread.h>
153 #endif
154
155 #if SIZEOF_INT_P==4
156
157 #if SIZEOF_INT==4
158 /* */ typedef int Int;
159 /* */ typedef unsigned int UInt;
160
161 #define Int_FORMAT "%d"
162 #define UInt_FORMAT "%u"
163
164 #elif SIZEOF_LONG_INT==4
165 /* */ typedef long int Int;
166 /* */ typedef unsigned long int UInt;
167
168 #define Int_FORMAT "%ld"
169 #define UInt_FORMAT "%lu"
170
171 #else
172 # error Yap require integer types of the same size as a pointer
173 #endif
174
175 #if SIZEOF_SHORT_INT==2
176 /* */ typedef short int Short;
177 /* */ typedef unsigned short int UShort;
178
179 #else
180 # error Yap requires integer types half the size of a pointer
181 #endif
182
183 #elif SIZEOF_INT_P==8
184
185 #if SIZEOF_INT==8
186 /* */ typedef int Int;
187 /* */ typedef unsigned int UInt;
188
189 #define Int_FORMAT "%d"
190 #define UInt_FORMAT "%u"
191
192 #elif SIZEOF_LONG_INT==8
193 /* */ typedef long int Int;
194 /* */ typedef unsigned long int UInt;
195
196 #define Int_FORMAT "%ld"
197 #define UInt_FORMAT "%lu"
198
199 # elif SIZEOF_LONG_LONG_INT==8
200 /* */ typedef long long int Int;
201 /* */ typedef unsigned long long int UInt;
202
203 #define Int_FORMAT "%I64d"
204 #define UInt_FORMAT "%I64u"
205
206 # else
207 # error Yap requires integer types of the same size as a pointer
208 # endif
209
210 # if SIZEOF_SHORT_INT==4
211 /* */ typedef short int Short;
212 /* */ typedef unsigned short int UShort;
213
214 # elif SIZEOF_INT==4
215 /* */ typedef int Short;
216 /* */ typedef unsigned int UShort;
217
218 # else
219 # error Yap requires integer types half the size of a pointer
220 # endif
221
222 #else
223
224 # error Yap requires pointers of size 4 or 8
225
226 #endif
227
228 /* */ typedef double Float;
229
230 #if SIZEOF_INT<SIZEOF_INT_P
231 #define SHORT_INTS 1
232 #else
233 #define SHORT_INTS 0
234 #endif
235
236 #ifdef __GNUC__
237 typedef long long int YAP_LONG_LONG;
238 typedef unsigned long long int YAP_ULONG_LONG;
239 #else
240 typedef long int YAP_LONG_LONG;
241 typedef unsigned long int YAP_ULONG_LONG;
242 #endif
243
244 #if HAVE_SIGPROF && (defined(__linux__) || defined(__APPLE__))
245 #define LOW_PROF 1
246 #endif
247
248 #ifdef DEBUG
249 extern char Yap_Option[20];
250 #endif
251
252 /* #define FORCE_SECOND_QUADRANT 1 */
253
254 #if defined(FORCE_SECOND_QUADRANT)
255 #define IN_SECOND_QUADRANT 1
256 #define MMAP_ADDR 0x42000000
257 #endif
258
259 #if !defined(IN_SECOND_QUADRANT)
260 #if defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(mips) || defined(__DragonFly__)
261 #if defined(YAPOR) && defined(__alpha)
262 #define MMAP_ADDR 0x40000000
263 #elif defined(mips)
264 #define MMAP_ADDR 0x02000000
265 #elif defined(__APPLE__) && __LP64__
266 // this address is high enough that it is likely not to confuse Apple's malloc debugger; lowest possible is 0x100200000
267 /* #define MMAP_ADDR 0x200000000 */
268 #define MMAP_ADDR 0x2000000000
269 #elif defined(__APPLE__) && !__LP64__
270 #define MMAP_ADDR 0x20000000
271 #elif defined(__powerpc__)
272 #define MMAP_ADDR 0x20000000
273 #else
274 #define MMAP_ADDR 0x10000000
275 #endif
276 #elif __svr4__ || defined(__SVR4)
277 #define MMAP_ADDR 0x02000000
278 #endif
279 #endif /* !IN_SECOND_QUADRANT */
280
281 /* #define RANDOMIZE_START_ADDRESS 1 */
282
283 #ifdef USE_SYSTEM_MALLOC
284 #define HEAP_INIT_BASE 0L
285 #define AtomBase NULL
286 #else
287 #if defined(MMAP_ADDR) && (defined(USE_MMAP) || USE_SHMAT) && !defined(__simplescalar__) && !defined(RANDOMIZE_START_ADDRESS)
288 #define HEAP_INIT_BASE (MMAP_ADDR)
289 #define AtomBase ((char *)MMAP_ADDR)
290 #else
291 #define HEAP_INIT_BASE ((CELL)Yap_HeapBase)
292 #define AtomBase (Yap_HeapBase)
293 #endif
294 #endif
295
296
297
298 #ifndef SHORT_ADDRESSES
299 # define LONG_ADDRESSES 1
300 #else
301 # define LONG_ADDRESSES 0
302 #endif
303
304 #ifndef ALIGN_LONGS
305 #define ALIGN_LONGS 1
306 #endif
307
308 #define K1 ((CELL)1024)
309 #define K16 ((CELL)(1024*64))
310 #define K64 ((CELL)(1024*64))
311 #define M1 ((CELL)(1024*1024))
312 #define M2 ((CELL)(2048*1024))
313
314 /* basic data types */
315
316 typedef UInt CELL;
317 typedef UShort BITS16;
318 typedef Short SBITS16;
319 typedef UInt BITS32;
320
321 #if ALIGN_LONGS
322 typedef CELL SFLAGS;
323 #else
324 typedef BITS16 SFLAGS;
325 #endif
326
327 typedef char *ADDR;
328 typedef CELL OFFSET;
329 typedef unsigned char *CODEADDR;
330
331 #define WordSize sizeof(BITS16)
332 #define CellSize sizeof(CELL)
333 #define SmallSize sizeof(SMALLUNSGN)
334
335 /* type casting macros */
336
337 #define Addr(V) ((ADDR) (V))
338 #define Unsigned(V) ((CELL) (V))
339 #define Signed(V) ((Int) (V))
340
341 #define CodePtr(V) ((CODEADDR)(V))
342 #define CellPtr(V) ((CELL *)(V))
343 #define OpCodePtr(V) ((OPCODE *)(V))
344 #define OpRegPtr(V) ((OPREG *)(V))
345 #define SmallPtr(V) ((SMALLUNSGN *)(V))
346 #define WordPtr(V) ((BITS16 *)(V))
347 #define DisplPtr(V) ((DISPREG *)(V))
348 #define TermPtr(V) ((Term *) (V))
349
350 /* Abstract Type Definitions for YAPProlog */
351
352 typedef CELL Term;
353
354 #if !defined(YAPOR) && !defined(THREADS)
355 #include <nolocks.h>
356 #elif USE_PTHREAD_LOCKING || defined(__CYGWIN__)
357
358 #ifndef _XOPEN_SOURCE
359 #define _XOPEN_SOURCE 600
360 #endif
361
362 #include <locks_pthread.h>
363 typedef pthread_mutex_t lockvar;
364 typedef pthread_rwlock_t rwlock_t;
365
366 #elif defined(i386)|| defined(__x86_64__)
367 typedef volatile int lockvar;
368 #include <locks_x86.h>
369 #elif defined(sparc) || defined(__sparc)
370 typedef volatile int lockvar;
371 #include <locks_sparc.h>
372 #elif defined(mips)
373 typedef volatile int lockvar;
374 #include <locks_mips.h>
375 #elif defined(__alpha)
376 typedef volatile int lockvar;
377 #include <locks_alpha.h>
378 #else
379
380 #ifndef _XOPEN_SOURCE
381 #define _XOPEN_SOURCE 600
382 #endif
383
384 typedef pthread_mutex_t lockvar;
385 typedef pthread_rwlock_t rwlock_t;
386 #include <locks_pthread.h>
387 #endif
388
389 /********************** use an auxiliary function for ranges ************/
390
391 #ifdef __GNUC__
392 #define IN_BETWEEN(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) <= \
393 Unsigned((Int)(MAX)-(Int)(MIN)) )
394
395 #define OUTSIDE(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) > \
396 Unsigned((Int)(MAX)-(Int)(MIN)) )
397 #else
398 #define IN_BETWEEN(MIN,X,MAX) ((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX))
399
400 #define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX))
401 #endif
402
403 /* ************************* Atoms *************************************/
404
405 #include "Atoms.h"
406
407 /* ************************* Coroutining **********************************/
408
409 #ifdef COROUTINING
410 /* Support for co-routining */
411 #include "corout.h"
412 #endif
413
414 /********* abstract machine registers **********************************/
415
416
417 #include "amidefs.h"
418
419 #include "Regs.h"
420
421 #if defined(YAPOR) ||defined(THREADS)
422 #ifdef mips
423 #include <locks_mips_funcs.h>
424 #endif
425 #ifdef __alpha
426 #include <locks_alpha_funcs.h>
427 #endif
428 #if defined(THREADS)
429 #define MAX_AGENTS MAX_THREADS
430 #elif defined(YAPOR)
431 #define MAX_AGENTS MAX_WORKERS
432 #endif
433 #endif
434
435 /************ variables concerned with Error Handling *************/
436
437 #include <setjmp.h>
438
439 #if defined(SIMICS) || !HAVE_SIGSETJMP
440 #define sigjmp_buf jmp_buf
441 #define sigsetjmp(Env, Arg) setjmp(Env)
442 #define siglongjmp(Env, Arg) longjmp(Env, Arg)
443 #endif
444
445 /* Support for arrays */
446 #include "arrays.h"
447
448 /************ variables concerned with Error Handling *************/
449
450 /* Types of Errors */
451 typedef enum
452 {
453 YAP_NO_ERROR,
454 FATAL_ERROR,
455 INTERNAL_ERROR,
456 INTERNAL_COMPILER_ERROR,
457 PURE_ABORT,
458 CALL_COUNTER_UNDERFLOW,
459 /* ISO_ERRORS */
460 CONSISTENCY_ERROR,
461 DOMAIN_ERROR_ARRAY_OVERFLOW,
462 DOMAIN_ERROR_ARRAY_TYPE,
463 DOMAIN_ERROR_IO_MODE,
464 DOMAIN_ERROR_MUTABLE,
465 DOMAIN_ERROR_NON_EMPTY_LIST,
466 DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
467 DOMAIN_ERROR_NOT_NL,
468 DOMAIN_ERROR_NOT_ZERO,
469 DOMAIN_ERROR_OUT_OF_RANGE,
470 DOMAIN_ERROR_OPERATOR_PRIORITY,
471 DOMAIN_ERROR_OPERATOR_SPECIFIER,
472 DOMAIN_ERROR_RADIX,
473 DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW,
474 DOMAIN_ERROR_SOURCE_SINK,
475 DOMAIN_ERROR_STREAM,
476 DOMAIN_ERROR_STREAM_ENCODING,
477 DOMAIN_ERROR_STREAM_OR_ALIAS,
478 DOMAIN_ERROR_STREAM_POSITION,
479 DOMAIN_ERROR_TIMEOUT_SPEC,
480 DOMAIN_ERROR_SYNTAX_ERROR_HANDLER,
481 EVALUATION_ERROR_FLOAT_OVERFLOW,
482 EVALUATION_ERROR_FLOAT_UNDERFLOW,
483 EVALUATION_ERROR_INT_OVERFLOW,
484 EVALUATION_ERROR_UNDEFINED,
485 EVALUATION_ERROR_UNDERFLOW,
486 EVALUATION_ERROR_ZERO_DIVISOR,
487 EXISTENCE_ERROR_ARRAY,
488 EXISTENCE_ERROR_KEY,
489 EXISTENCE_ERROR_SOURCE_SINK,
490 EXISTENCE_ERROR_STREAM,
491 EXISTENCE_ERROR_VARIABLE,
492 INSTANTIATION_ERROR,
493 INTERRUPT_ERROR,
494 OPERATING_SYSTEM_ERROR,
495 OUT_OF_HEAP_ERROR,
496 OUT_OF_STACK_ERROR,
497 OUT_OF_TRAIL_ERROR,
498 OUT_OF_ATTVARS_ERROR,
499 OUT_OF_AUXSPACE_ERROR,
500 PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE,
501 PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM,
502 PERMISSION_ERROR_CREATE_ARRAY,
503 PERMISSION_ERROR_CREATE_OPERATOR,
504 PERMISSION_ERROR_INPUT_BINARY_STREAM,
505 PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,
506 PERMISSION_ERROR_INPUT_STREAM,
507 PERMISSION_ERROR_INPUT_TEXT_STREAM,
508 PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
509 PERMISSION_ERROR_OPEN_SOURCE_SINK,
510 PERMISSION_ERROR_OUTPUT_BINARY_STREAM,
511 PERMISSION_ERROR_OUTPUT_STREAM,
512 PERMISSION_ERROR_OUTPUT_TEXT_STREAM,
513 PERMISSION_ERROR_RESIZE_ARRAY,
514 PERMISSION_ERROR_REPOSITION_STREAM,
515 PRED_ENTRY_COUNTER_UNDERFLOW,
516 REPRESENTATION_ERROR_CHARACTER,
517 REPRESENTATION_ERROR_CHARACTER_CODE,
518 REPRESENTATION_ERROR_MAX_ARITY,
519 REPRESENTATION_ERROR_VARIABLE,
520 RESOURCE_ERROR_HUGE_INT,
521 RESOURCE_ERROR_MAX_STREAMS,
522 RESOURCE_ERROR_MAX_THREADS,
523 RESOURCE_ERROR_MEMORY,
524 RESOURCE_ERROR_STACK,
525 RETRY_COUNTER_UNDERFLOW,
526 SYNTAX_ERROR,
527 SYSTEM_ERROR,
528 TYPE_ERROR_ARRAY,
529 TYPE_ERROR_ATOM,
530 TYPE_ERROR_ATOMIC,
531 TYPE_ERROR_BYTE,
532 TYPE_ERROR_CALLABLE,
533 TYPE_ERROR_CHAR,
534 TYPE_ERROR_CHARACTER,
535 TYPE_ERROR_COMPOUND,
536 TYPE_ERROR_DBREF,
537 TYPE_ERROR_DBTERM,
538 TYPE_ERROR_EVALUABLE,
539 TYPE_ERROR_FLOAT,
540 TYPE_ERROR_INTEGER,
541 TYPE_ERROR_KEY,
542 TYPE_ERROR_LIST,
543 TYPE_ERROR_NUMBER,
544 TYPE_ERROR_PREDICATE_INDICATOR,
545 TYPE_ERROR_PTR,
546 TYPE_ERROR_UBYTE,
547 TYPE_ERROR_UCHAR,
548 TYPE_ERROR_VARIABLE,
549 UNKNOWN_ERROR
550 } yap_error_number;
551
552 typedef enum
553 {
554 YAP_INT_BOUNDED_FLAG = 0,
555 MAX_ARITY_FLAG = 1,
556 INTEGER_ROUNDING_FLAG = 2,
557 YAP_MAX_INTEGER_FLAG = 3,
558 YAP_MIN_INTEGER_FLAG = 4,
559 CHAR_CONVERSION_FLAG = 5,
560 YAP_DOUBLE_QUOTES_FLAG = 6,
561 YAP_TO_CHARS_FLAG = 7,
562 LANGUAGE_MODE_FLAG = 8,
563 STRICT_ISO_FLAG = 9,
564 SOURCE_MODE_FLAG = 11,
565 CHARACTER_ESCAPE_FLAG = 12,
566 WRITE_QUOTED_STRING_FLAG = 13,
567 ALLOW_ASSERTING_STATIC_FLAG = 14,
568 HALT_AFTER_CONSULT_FLAG = 15,
569 FAST_BOOT_FLAG = 16,
570 STACK_DUMP_ON_ERROR_FLAG = 17,
571 GENERATE_DEBUG_INFO_FLAG = 18,
572 INDEXING_MODE_FLAG = 19,
573 TABLING_MODE_FLAG = 20,
574 VARS_CAN_HAVE_QUOTE_FLAG = 21,
575 QUIET_MODE_FLAG = 22,
576 /* let this be the last one */
577 LAST_FLAG = 23
578 } yap_flags;
579
580 #define STRING_AS_CHARS 0
581 #define STRING_AS_ATOM 2
582
583 #define QUINTUS_TO_CHARS 0
584 #define ISO_TO_CHARS 1
585
586 #define CPROLOG_CHARACTER_ESCAPES 0
587 #define ISO_CHARACTER_ESCAPES 1
588 #define SICSTUS_CHARACTER_ESCAPES 2
589
590 typedef enum
591 {
592 INDEX_MODE_OFF = 0,
593 INDEX_MODE_SINGLE = 1,
594 INDEX_MODE_COMPACT = 2,
595 INDEX_MODE_MULTI = 3,
596 INDEX_MODE_MAX = 4
597 } index_mode_options;
598
599 typedef enum
600 {
601 YAP_CREEP_SIGNAL = 0x1, /* received a creep */
602 YAP_WAKEUP_SIGNAL = 0x2, /* goals to wake up */
603 YAP_ALARM_SIGNAL = 0x4, /* received an alarm */
604 YAP_HUP_SIGNAL = 0x8, /* received SIGHUP */
605 YAP_USR1_SIGNAL = 0x10, /* received SIGUSR1 */
606 YAP_USR2_SIGNAL = 0x20, /* received SIGUSR2 */
607 YAP_INT_SIGNAL = 0x40, /* received SIGINT (unused for now) */
608 YAP_ITI_SIGNAL = 0x80, /* received inter thread signal */
609 YAP_TROVF_SIGNAL = 0x100, /* received trail overflow */
610 YAP_CDOVF_SIGNAL = 0x200, /* received code overflow */
611 YAP_STOVF_SIGNAL = 0x400, /* received stack overflow */
612 YAP_TRACE_SIGNAL = 0x800, /* received start trace */
613 YAP_DEBUG_SIGNAL = 0x1000, /* received start debug */
614 YAP_BREAK_SIGNAL = 0x2000, /* received break signal */
615 YAP_STACK_DUMP_SIGNAL = 0x4000, /* received stack dump signal */
616 YAP_STATISTICS_SIGNAL = 0x8000, /* received statistics */
617 YAP_DELAY_CREEP_SIGNAL = 0x10000, /* received a creep but should not do it */
618 YAP_AGC_SIGNAL = 0x20000, /* call atom garbage collector asap */
619 YAP_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */
620 YAP_VTALARM_SIGNAL = 0x80000, /* received SIGVTALARM */
621 YAP_FAIL_SIGNAL = 0x100000 /* P = FAILCODE */
622 } yap_signals;
623
624 #define NUMBER_OF_YAP_FLAGS LAST_FLAG
625
626 /************************ prototypes **********************************/
627
628 #include "Yapproto.h"
629
630 /***********************************************************************/
631
632 /*
633 absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
634
635 with AbsAppl(t) : *CELL -> Term
636 and RepAppl(t) : Term -> *CELL
637
638 and AbsPair(t) : *CELL -> Term
639 and RepPair(t) : Term -> *CELL
640
641 and IsIntTerm(t) = ...
642 and IsAtomTerm(t) = ...
643 and IsVarTerm(t) = ...
644 and IsPairTerm(t) = ...
645 and IsApplTerm(t) = ...
646 and IsFloatTerm(t) = ...
647 and IsRefTerm(t) = ...
648 and IsNonVarTerm(t) = ! IsVar(t)
649 and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t)
650 and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t)
651 and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t)
652
653 and MkIntTerm(n) = ...
654 and MkFloatTerm(f) = ...
655 and MkAtomTerm(a) = ...
656 and MkVarTerm(r) = ...
657 and MkApplTerm(f,n,args) = ...
658 and MkPairTerm(hd,tl) = ...
659 and MkRefTerm(R) = ...
660
661 and PtrOfTerm(t) : Term -> CELL * = ...
662 and IntOfTerm(t) : Term -> int = ...
663 and FloatOfTerm(t) : Term -> flt = ...
664 and AtomOfTerm(t) : Term -> Atom = ...
665 and VarOfTerm(t) : Term -> *Term = ....
666 and HeadOfTerm(t) : Term -> Term = ...
667 and TailOfTerm(t) : Term -> Term = ...
668 and FunctorOfTerm(t) : Term -> Functor = ...
669 and ArgOfTerm(i,t) : Term -> Term= ...
670 and RefOfTerm(t) : Term -> DBRef = ...
671
672 */
673
674 /*
675 YAP can use several different tag schemes, according to the kind of
676 machine we are experimenting with.
677 */
678
679 #if LONG_ADDRESSES && defined(OLD_TAG_SCHEME)
680
681 #include "Tags_32bits.h"
682
683 #endif /* LONG_ADDRESSES && defined(OLD_TAG_SCHEME) */
684
685 /* AIX will by default place mmaped segments at 0x30000000. This is
686 incompatible with the high tag scheme. Linux-ELF also does not like
687 if you place things in the lower addresses (power to the libc people).
688 */
689
690 #if (defined(_AIX) || (defined(__APPLE__) && !defined(__LP64__)) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__POWERPC__) || defined(__linux__) || defined(IN_SECOND_QUADRANT) || defined(__CYGWIN__)) || defined(__NetBSD__) || defined(__DragonFly__)
691 #define USE_LOW32_TAGS 1
692 #endif
693
694 #if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS)
695
696 #include "Tags_32Ops.h"
697
698 #endif /* LONG_ADDRESSES && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS) */
699
700 #if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && defined(USE_LOW32_TAGS)
701
702 #include "Tags_32LowTag.h"
703
704 #endif /* LONG_ADDRESSES && !defined(OLD_TAG_SCHEME) */
705
706 #if LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME)
707
708 #include "Tags_64bits.h"
709
710 #endif /* LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME) */
711
712 #if !LONG_ADDRESSES
713
714 #include "Tags_24bits.h"
715
716 #endif /* !LONG_ADDRESSES */
717
718 #ifdef TAG_LOW_BITS_32
719
720 #if !GC_NO_TAGS
721 #define MBIT 0x80000000
722 #define RBIT 0x40000000
723
724 #if IN_SECOND_QUADRANT
725 #define INVERT_RBIT 1 /* RBIT is 1 by default */
726 #endif
727 #endif /* !GC_NO_TAGS */
728
729 #else
730
731 #if !GC_NO_TAGS
732 #if defined(SBA) && defined(__linux__)
733 #define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */
734 #else
735 #define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */
736 #define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */
737 #endif
738 #endif /* !GC_NO_TAGS */
739
740 #endif
741
742 #define TermSize sizeof(Term)
743
744 /************* variables related to memory allocation *******************/
745 /* must be before TermExt.h */
746
747 extern ADDR Yap_HeapBase;
748
749 /* This is ok for Linux, should be ok for everyone */
750 #define YAP_FILENAME_MAX 1024
751
752 #define MAX_ERROR_MSG_SIZE YAP_FILENAME_MAX
753
754 #ifdef THREADS
755 typedef struct thread_globs
756 {
757 ADDR local_base;
758 ADDR global_base;
759 ADDR trail_base;
760 ADDR trail_top;
761 char *error_message;
762 Term error_term;
763 Term error_type;
764 UInt error_size;
765 char error_say[MAX_ERROR_MSG_SIZE];
766 jmp_buf io_botch;
767 sigjmp_buf restart_env;
768 struct TOKEN *tokptr;
769 struct TOKEN *toktide;
770 struct VARSTRUCT *var_table;
771 struct VARSTRUCT *anon_var_table;
772 int eot_before_eof;
773 char file_name_buf[YAP_FILENAME_MAX];
774 char file_name_buf2[YAP_FILENAME_MAX];
775
776 } tglobs;
777
778 extern struct thread_globs Yap_thread_gl[MAX_THREADS];
779
780 #define Yap_LocalBase Yap_thread_gl[worker_id].local_base
781 #define Yap_GlobalBase Yap_thread_gl[worker_id].global_base
782 #define Yap_TrailBase Yap_thread_gl[worker_id].trail_base
783 #define Yap_TrailTop Yap_thread_gl[worker_id].trail_top
784 #define Yap_ErrorMessage Yap_thread_gl[worker_id].error_message
785 #define Yap_Error_Term Yap_thread_gl[worker_id].error_term
786 #define Yap_Error_TYPE Yap_thread_gl[worker_id].error_type
787 #define Yap_Error_Size Yap_thread_gl[worker_id].error_size
788 #define Yap_ErrorSay Yap_thread_gl[worker_id].error_say
789 #define Yap_RestartEnv Yap_thread_gl[worker_id].restart_env
790
791 /* This is the guy who actually started the system, and who has the correct registers */
792 extern pthread_t Yap_master_thread;
793
794 #else
795 extern ADDR Yap_HeapBase,
796 Yap_LocalBase, Yap_GlobalBase, Yap_TrailBase, Yap_TrailTop;
797
798 extern sigjmp_buf Yap_RestartEnv; /* used to restart after an abort */
799
800 extern char *Yap_ErrorMessage; /* used to pass error messages */
801 extern Term Yap_Error_Term; /* used to pass error terms */
802 extern yap_error_number Yap_Error_TYPE; /* used to pass the error */
803 extern UInt Yap_Error_Size; /* used to pass the error */
804
805 /******************* storing error messages ****************************/
806 extern char Yap_ErrorSay[MAX_ERROR_MSG_SIZE];
807
808 #endif
809
810 #ifdef DEBUG
811 /************** Debugging Support ***************************/
812 extern int Yap_output_msg;
813 #endif
814
815
816 /* applies to unbound variables */
817
818 inline EXTERN Term *VarOfTerm (Term t);
819
820 inline EXTERN Term *
VarOfTerm(Term t)821 VarOfTerm (Term t)
822 {
823 return (Term *) (t);
824 }
825
826
827 #ifdef SBA
828
829 inline EXTERN Term MkVarTerm (void);
830
831 inline EXTERN Term
MkVarTerm()832 MkVarTerm ()
833 {
834 return (Term) ((*H = 0, H++));
835 }
836
837
838
839 inline EXTERN int IsUnboundVar (Term *);
840
841 inline EXTERN int
IsUnboundVar(Term * t)842 IsUnboundVar (Term * t)
843 {
844 return (int) (*(t) == 0);
845 }
846
847
848 #else
849
850 inline EXTERN Term MkVarTerm (void);
851
852 inline EXTERN Term
MkVarTerm()853 MkVarTerm ()
854 {
855 return (Term) ((*H = (CELL) H, H++));
856 }
857
858
859
860 inline EXTERN int IsUnboundVar (Term *);
861
862 inline EXTERN int
IsUnboundVar(Term * t)863 IsUnboundVar (Term * t)
864 {
865 return (int) (*(t) == (Term) (t));
866 }
867
868
869 #endif
870
871 inline EXTERN CELL *PtrOfTerm (Term);
872
873 inline EXTERN CELL *
PtrOfTerm(Term t)874 PtrOfTerm (Term t)
875 {
876 return (CELL *) (*(CELL *) (t));
877 }
878
879
880
881
882 inline EXTERN Functor FunctorOfTerm (Term);
883
884 inline EXTERN Functor
FunctorOfTerm(Term t)885 FunctorOfTerm (Term t)
886 {
887 return (Functor) (*RepAppl (t));
888 }
889
890
891 #if USE_LOW32_TAGS
892
893 inline EXTERN Term MkAtomTerm (Atom);
894
895 inline EXTERN Term
MkAtomTerm(Atom a)896 MkAtomTerm (Atom a)
897 {
898 return (Term) (AtomTag | (CELL) (a));
899 }
900
901
902
903 inline EXTERN Atom AtomOfTerm (Term t);
904
905 inline EXTERN Atom
AtomOfTerm(Term t)906 AtomOfTerm (Term t)
907 {
908 return (Atom) ((~AtomTag & (CELL) (t)));
909 }
910
911
912 #else
913
914 inline EXTERN Term MkAtomTerm (Atom);
915
916 inline EXTERN Term
MkAtomTerm(Atom a)917 MkAtomTerm (Atom a)
918 {
919 return (Term) (TAGGEDA ((CELL)AtomTag, (CELL) (a)));
920 }
921
922
923
924 inline EXTERN Atom AtomOfTerm (Term t);
925
926 inline EXTERN Atom
AtomOfTerm(Term t)927 AtomOfTerm (Term t)
928 {
929 return (Atom) (NonTagPart (t));
930 }
931
932
933 #endif
934
935 inline EXTERN int IsAtomTerm (Term);
936
937 inline EXTERN int
IsAtomTerm(Term t)938 IsAtomTerm (Term t)
939 {
940 return (int) (CHKTAG ((t), AtomTag));
941 }
942
943
944
945
946 inline EXTERN Term MkIntTerm (Int);
947
948 inline EXTERN Term
MkIntTerm(Int n)949 MkIntTerm (Int n)
950 {
951 return (Term) (TAGGED (NumberTag, (n)));
952 }
953
954
955 /*
956 A constant to subtract or add to a well-known term, we assume no
957 overflow problems are possible
958 */
959
960 inline EXTERN Term MkIntConstant (Int);
961
962 inline EXTERN Term
MkIntConstant(Int n)963 MkIntConstant (Int n)
964 {
965 return (Term) (NONTAGGED (NumberTag, (n)));
966 }
967
968
969
970 inline EXTERN int IsIntTerm (Term);
971
972 inline EXTERN int
IsIntTerm(Term t)973 IsIntTerm (Term t)
974 {
975 return (int) (CHKTAG ((t), NumberTag));
976 }
977
978
979
980 EXTERN inline Term STD_PROTO (MkPairTerm, (Term, Term));
981
982 EXTERN inline Term
MkPairTerm(Term head,Term tail)983 MkPairTerm (Term head, Term tail)
984 {
985 register CELL *p = H;
986
987 H[0] = head;
988 H[1] = tail;
989 H += 2;
990 return (AbsPair (p));
991 }
992
993
994 /* Needed to handle numbers:
995 these two macros are fundamental in the integer/float conversions */
996
997 #ifdef M_WILLIAMS
998 #define IntInBnd(X) (TRUE)
999 #else
1000 #ifdef TAGS_FAST_OPS
1001 #define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1)
1002 #else
1003 #define IntInBnd(X) ( (X) < MAX_ABS_INT && \
1004 (X) > -MAX_ABS_INT-1L )
1005 #endif
1006 #endif
1007 #ifdef C_PROLOG
1008 #define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
1009 #else
1010 #define FlIsInt(X) ( FALSE )
1011 #endif
1012
1013
1014 /*
1015 There are two types of functors:
1016
1017 o Special functors mark special terms
1018 on the heap that should be seen as constants.
1019
1020 o Standard functors mark normal applications.
1021
1022 */
1023
1024 #include "TermExt.h"
1025
1026 #define IsAccessFunc(func) ((func) == FunctorAccess)
1027
1028
1029 inline EXTERN Term MkIntegerTerm (Int);
1030
1031 inline EXTERN Term
MkIntegerTerm(Int n)1032 MkIntegerTerm (Int n)
1033 {
1034 return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n));
1035 }
1036
1037
1038
1039 inline EXTERN int IsIntegerTerm (Term);
1040
1041 inline EXTERN int
IsIntegerTerm(Term t)1042 IsIntegerTerm (Term t)
1043 {
1044 return (int) (IsIntTerm (t) || IsLongIntTerm (t));
1045 }
1046
1047
1048
1049 inline EXTERN Int IntegerOfTerm (Term);
1050
1051 inline EXTERN Int
IntegerOfTerm(Term t)1052 IntegerOfTerm (Term t)
1053 {
1054
1055 return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
1056 }
1057
1058
1059
1060
1061 /*************** unification routines ***********************************/
1062
1063 #ifdef SBA
1064 #include "or.sbaamiops.h"
1065 #else
1066 #include "amiops.h"
1067 #endif
1068
1069 /*************** High level macros to access arguments ******************/
1070
1071
1072 inline EXTERN Term ArgOfTerm (int i, Term t);
1073
1074 inline EXTERN Term
ArgOfTerm(int i,Term t)1075 ArgOfTerm (int i, Term t)
1076 {
1077 return (Term) (Derefa (RepAppl (t) + (i)));
1078 }
1079
1080
1081
1082 inline EXTERN Term HeadOfTerm (Term);
1083
1084 inline EXTERN Term
HeadOfTerm(Term t)1085 HeadOfTerm (Term t)
1086 {
1087 return (Term) (Derefa (RepPair (t)));
1088 }
1089
1090
1091
1092 inline EXTERN Term TailOfTerm (Term);
1093
1094 inline EXTERN Term
TailOfTerm(Term t)1095 TailOfTerm (Term t)
1096 {
1097 return (Term) (Derefa (RepPair (t) + 1));
1098 }
1099
1100
1101
1102
1103 inline EXTERN Term ArgOfTermCell (int i, Term t);
1104
1105 inline EXTERN Term
ArgOfTermCell(int i,Term t)1106 ArgOfTermCell (int i, Term t)
1107 {
1108 return (Term) ((CELL) (RepAppl (t) + (i)));
1109 }
1110
1111
1112
1113 inline EXTERN Term HeadOfTermCell (Term);
1114
1115 inline EXTERN Term
HeadOfTermCell(Term t)1116 HeadOfTermCell (Term t)
1117 {
1118 return (Term) ((CELL) (RepPair (t)));
1119 }
1120
1121
1122
1123 inline EXTERN Term TailOfTermCell (Term);
1124
1125 inline EXTERN Term
TailOfTermCell(Term t)1126 TailOfTermCell (Term t)
1127 {
1128 return (Term) ((CELL) (RepPair (t) + 1));
1129 }
1130
1131
1132
1133 /*************** variables concerned with atoms table *******************/
1134 #define MaxHash 3333
1135 #define MaxWideHash (MaxHash/10+1)
1136
1137 #define FAIL_RESTORE 0
1138 #define DO_EVERYTHING 1
1139 #define DO_ONLY_CODE 2
1140
1141
1142 #ifdef EMACS
1143
1144 /******************** using Emacs mode ********************************/
1145
1146 extern int emacs_mode;
1147
1148 #endif
1149
1150
1151 /********* common instructions codes*************************/
1152
1153 #define MAX_PROMPT 256
1154
1155 #if USE_THREADED_CODE
1156
1157 /************ reverse lookup of instructions *****************/
1158 typedef struct opcode_tab_entry
1159 {
1160 OPCODE opc;
1161 op_numbers opnum;
1162 } opentry;
1163
1164 #endif
1165
1166 /********* Prolog may be in several modes *******************************/
1167
1168 typedef enum
1169 {
1170 BootMode = 0x1, /* if booting or restoring */
1171 UserMode = 0x2, /* Normal mode */
1172 CritMode = 0x4, /* If we are meddling with the heap */
1173 AbortMode = 0x8, /* expecting to abort */
1174 InterruptMode = 0x10, /* under an interrupt */
1175 InErrorMode = 0x20, /* under an interrupt */
1176 ConsoleGetcMode = 0x40, /* blocked reading from console */
1177 ExtendStackMode = 0x80, /* trying to extend stack */
1178 GrowHeapMode = 0x100, /* extending Heap */
1179 GrowStackMode = 0x200, /* extending Stack */
1180 GCMode = 0x400, /* doing Garbage Collecting */
1181 ErrorHandlingMode = 0x800, /* doing error handling */
1182 CCallMode = 0x1000, /* In c Call */
1183 UnifyMode = 0x2000, /* In Unify Code */
1184 UserCCallMode = 0x4000, /* In User C-call Code */
1185 MallocMode = 0x8000, /* Doing malloc, realloc, free */
1186 SystemMode = 0x10000, /* in system mode */
1187 AsyncIntMode = 0x20000 /* YAP has just been interrupted from the outside */
1188 } prolog_exec_mode;
1189
1190 extern Int Yap_PrologMode;
1191 extern int Yap_CritLocks;
1192
1193 /************** Access to yap initial arguments ***************************/
1194
1195 extern char **Yap_argv;
1196 extern int Yap_argc;
1197
1198 /******** whether Yap is responsible for signal handling ******************/
1199
1200 extern int Yap_PrologShouldHandleInterrupts;
1201
1202 /******************* number of modules ****************************/
1203
1204 #define DefaultMaxModules 256
1205
1206 #ifdef YAPOR
1207 #define YAPEnterCriticalSection() \
1208 { \
1209 if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \
1210 LOCK(GLOBAL_LOCKS_heap_access); \
1211 GLOBAL_LOCKS_who_locked_heap = worker_id; \
1212 } \
1213 Yap_PrologMode |= CritMode; \
1214 Yap_CritLocks++; \
1215 }
1216 #define YAPLeaveCriticalSection() \
1217 { \
1218 Yap_CritLocks--; \
1219 if (!Yap_CritLocks) { \
1220 Yap_PrologMode &= ~CritMode; \
1221 if (Yap_PrologMode & InterruptMode) { \
1222 Yap_PrologMode &= ~InterruptMode; \
1223 Yap_ProcessSIGINT(); \
1224 } \
1225 if (Yap_PrologMode & AbortMode) { \
1226 Yap_PrologMode &= ~AbortMode; \
1227 Yap_Error(PURE_ABORT, 0, ""); \
1228 } \
1229 GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \
1230 UNLOCK(GLOBAL_LOCKS_heap_access); \
1231 } \
1232 }
1233 #elif defined(THREADS)
1234 #define YAPEnterCriticalSection() \
1235 { \
1236 /* LOCK(BGL); */ \
1237 Yap_PrologMode |= CritMode; \
1238 }
1239 #define YAPLeaveCriticalSection() \
1240 { \
1241 Yap_PrologMode &= ~CritMode; \
1242 if (Yap_PrologMode & InterruptMode) { \
1243 Yap_PrologMode &= ~InterruptMode; \
1244 Yap_ProcessSIGINT(); \
1245 } \
1246 if (Yap_PrologMode & AbortMode) { \
1247 Yap_PrologMode &= ~AbortMode; \
1248 Yap_Error(PURE_ABORT, 0, ""); \
1249 } \
1250 /* UNLOCK(BGL); */ \
1251 }
1252 #else
1253 #define YAPEnterCriticalSection() \
1254 { \
1255 Yap_PrologMode |= CritMode; \
1256 Yap_CritLocks++; \
1257 }
1258 #define YAPLeaveCriticalSection() \
1259 { \
1260 Yap_CritLocks--; \
1261 if (!Yap_CritLocks) { \
1262 Yap_PrologMode &= ~CritMode; \
1263 if (Yap_PrologMode & InterruptMode) { \
1264 Yap_PrologMode &= ~InterruptMode; \
1265 Yap_ProcessSIGINT(); \
1266 } \
1267 if (Yap_PrologMode & AbortMode) { \
1268 Yap_PrologMode &= ~AbortMode; \
1269 Yap_Error(PURE_ABORT, 0, ""); \
1270 } \
1271 } \
1272 }
1273 #endif /* YAPOR */
1274
1275 /* when we are calling the InitStaff procedures */
1276 #define AT_BOOT 0
1277 #define AT_RESTORE 1
1278
1279 /********* mutable variables ******************/
1280
1281 /* I assume that the size of this structure is a multiple of the size
1282 of CELL!!! */
1283 typedef struct TIMED_MAVAR
1284 {
1285 CELL value;
1286 CELL clock;
1287 } timed_var;
1288
1289 /********* while debugging you may need some info ***********************/
1290
1291 #ifdef EMACS
1292 extern char emacs_tmp[], emacs_tmp2[];
1293 #endif
1294
1295 #if defined(YAPOR) || defined(TABLING)
1296 #include "opt.structs.h"
1297 #include "opt.proto.h"
1298 #include "opt.macros.h"
1299 #endif /* YAPOR || TABLING */
1300
1301 #ifdef SBA
1302 #include "or.sbaunify.h"
1303 #endif
1304
1305 /********* execution mode ***********************/
1306
1307 typedef enum
1308 {
1309 INTERPRETED, /* interpreted */
1310 MIXED_MODE_USER, /* mixed mode only for user predicates */
1311 MIXED_MODE_ALL, /* mixed mode for all predicates */
1312 COMPILE_USER, /* compile all user predicates*/
1313 COMPILE_ALL /* compile all predicates */
1314 } yap_exec_mode;
1315
1316 /********* slots ***********************/
1317
1318
1319 static inline void
Yap_StartSlots(void)1320 Yap_StartSlots(void) {
1321 *--ASP = MkIntegerTerm(CurSlot);
1322 *--ASP = MkIntTerm(0);
1323 CurSlot = LCL0-ASP;
1324 }
1325
1326 static inline void
Yap_CloseSlots(void)1327 Yap_CloseSlots(void) {
1328 Int old_slots;
1329 old_slots = IntOfTerm(ASP[0]);
1330 ASP += (old_slots+1);
1331 CurSlot = IntegerOfTerm(*ASP);
1332 ASP++;
1333 }
1334
1335 /* pop slots when pruning */
1336 static inline void
Yap_PopSlots(void)1337 Yap_PopSlots(void) {
1338 while (LCL0-CurSlot < ASP) {
1339 Int old_slots;
1340 CELL *ptr = LCL0-CurSlot;
1341 old_slots = IntOfTerm(ptr[0]);
1342 ptr += (old_slots+1);
1343 CurSlot = IntOfTerm(*ptr);
1344 }
1345 }
1346
1347 static inline Int
Yap_CurrentSlot(void)1348 Yap_CurrentSlot(void) {
1349 return IntOfTerm(ASP[0]);
1350 }
1351
1352