/************************************************************************* * * * YAP Prolog %W% %G% * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: Yap.h.m4 * * mods: * * comments: main header file for YAP * * version: $Id: Yap.h.m4,v 1.9 2001-08-08 21:17:27 vsc Exp $ * *************************************************************************/ #include "config.h" /* #define RATIONAL_TREES 1 #define DEPTH_LIMIT 1 #define COROUTINING 1 #define YAPOR 1 #define ANALYST 1 */ #define MULTI_ASSIGNMENT_VARIABLES 1 #if defined(TABLING) #error Do not explicitly define TABLING #endif /* YAPOR */ #if defined(TABLING_BATCHED_SCHEDULING) && defined(TABLING_LOCAL_SCHEDULING) #error Do not define multiple tabling scheduling strategies #endif /* TABLING_BATCHED_SCHEDULING || TABLING_LOCAL_SCHEDULING */ #if defined(TABLING_BATCHED_SCHEDULING) || defined(TABLING_LOCAL_SCHEDULING) #define TABLING 1 #endif /* TABLING_BATCHED_SCHEDULING || TABLING_LOCAL_SCHEDULING */ #if defined(YAPOR) #error Do not explicitly define YAPOR #endif /* YAPOR */ #if (defined(ENV_COPY) && (defined(ACOW) || defined(SBA))) || (defined(ACOW) && defined(SBA)) #error Do not define multiple or-parallel models #endif /* (ENV_COPY && (ACOW || SBA)) || (ACOW && SBA) */ #if defined(ENV_COPY) || defined(ACOW) || defined(SBA) #define YAPOR 1 #endif /* ENV_COPY || ACOW || SBA */ #if defined(TABLING) && (defined(ACOW) || defined(SBA)) #error Currently TABLING only works with ENV_COPY #endif /* TABLING && (ACOW || SBA) */ #ifdef YAPOR #define FIXED_STACKS 1 #endif /* YAPOR */ #if defined(YAPOR) || defined(TABLING) #undef TRAILING_REQUIRES_BRANCH #endif /* YAPOR || TABLING */ #if ANALYST #ifdef USE_THREADED_CODE #undef USE_THREADED_CODE #endif #endif #ifdef COROUTINING #ifndef TERM_EXTENSIONS #define TERM_EXTENSIONS 1 #endif #endif #ifdef SBA #ifdef YAPOR #ifndef FROZEN_STACKS #define FROZEN_STACKS 1 #endif #endif #endif #ifdef TABLING #ifndef FROZEN_STACKS #define FROZEN_STACKS 1 #endif #endif #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ /* adjust a config.h from mingw32 to work with vc++ */ #ifdef HAVE_GCC #undef HAVE_GCC #endif #ifdef USE_THREADED_CODE #undef USE_THREADED_CODE #endif #define inline __inline #define YAP_VERSION "Yap-4.3.17" #define BIN_DIR "c:\\Program Files\\Yap\\bin" #define LIB_DIR "c:\\Program Files\\Yap\\bin" #ifdef HOST_ALIAS #undef HOST_ALIAS #endif #define HOST_ALIAS "i386-pc-win32" #ifdef HAVE_IEEEFP_H #undef HAVE_IEEEFP_H #endif #ifdef HAVE_UNISTD_H #undef HAVE_UNISTD_H #endif #ifdef HAVE_SYS_TIME_H #undef HAVE_SYS_TIME_H #endif #endif #ifdef __MINGW32__ #ifndef _WIN32 #define _WIN32 1 #endif #endif #if HAVE_GCC #define MIN_ARRAY 0 #define DUMMY_FILLER_FOR_ABS_TYPE #else #define MIN_ARRAY 1 #define DUMMY_FILLER_FOR_ABS_TYPE int dummy; #endif #ifndef ADTDEFS_C #define EXTERN static #else #define EXTERN #endif /* truth-values */ #define TRUE 1 #define FALSE 0 /* null pointer */ #define NIL 0 /* Basic types */ /* defines integer types Int and UInt (unsigned) with the same size as a ptr ** and integer types Short and UShort with half the size of a ptr */ #if SIZEOF_INT_P==4 #if SIZEOF_INT==4 /* */ typedef int Int; /* */ typedef unsigned int UInt; #elif SIZEOF_LONG_INT==4 /* */ typedef long int Int; /* */ typedef unsigned long int UInt; #else error Yap require integer types of the same size as a pointer #endif #if SIZEOF_SHORT_INT==2 /* */ typedef short int Short; /* */ typedef unsigned short int UShort; #else error Yap requires integer types half the size of a pointer #endif #elif SIZEOF_INT_P==8 # if SIZEOF_INT==8 /* */ typedef int Int; /* */ typedef unsigned int UInt; #elif SIZEOF_LONG_INT==8 /* */ typedef long int Int; /* */ typedef unsigned long int UInt; # elif SIZEOF_LONG_LONG_INT==8 /* */ typedef long long int Int; /* */ typedef unsigned long long int UInt; # else error Yap requires integer types of the same size as a pointer # endif # if SIZEOF_SHORT_INT==4 /* */ typedef short int Short; /* */ typedef unsigned short int UShort; # elif SIZEOF_INT==4 /* */ typedef int Short; /* */ typedef short int UShort; # else error Yap requires integer types half the size of a pointer # endif #else error Yap requires pointers of size 4 or 8 #endif /* */ typedef double Float; #if SIZEOF_INT #else #ifdef i386 #include #endif #ifdef sparc #include #endif #ifdef mips #include #endif #ifdef __alpha #include #endif #endif /********************** use an auxiliary function for ranges ************/ #ifdef __GNUC__ #define IN_BETWEEN(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) <= \ Unsigned((Int)(MAX)-(Int)(MIN)) ) #define OUTSIDE(MIN,X,MAX) (Unsigned((Int)(X)-(Int)(MIN)) > \ Unsigned((Int)(MAX)-(Int)(MIN)) ) #else #define IN_BETWEEN(MIN,X,MAX) ((void *)(X) >= (void *)(MIN) && (void *)(X) <= (void *)(MAX)) #define OUTSIDE(MIN,X,MAX) ((void *)(X) < (void *)(MIN) || (void *)(X) > (void *)(MAX)) #endif /* ************************* Atoms *************************************/ #include "Atoms.h" /* ************************* Coroutining **********************************/ #ifdef COROUTINING /* Support for co-routining */ #include "corout.h" #endif /********* abstract machine registers **********************************/ #include "amidefs.h" #include "Regs.h" #if defined(YAPOR) ||defined(THREADS) #ifdef mips #include #endif #ifdef __alpha #include #endif #endif /************ variables concerned with Error Handling *************/ #include #if defined(SIMICS) || !HAVE_SIGSETJMP #define sigjmp_buf jmp_buf #define sigsetjmp(Env, Arg) setjmp(Env) #define siglongjmp(Env, Arg) longjmp(Env, Arg) #endif extern sigjmp_buf RestartEnv; /* used to restart after an abort */ /* Support for arrays */ #include "arrays.h" /************ variables concerned with Error Handling *************/ /* Types of Errors */ typedef enum { NO_ERROR, FATAL_ERROR, INTERNAL_ERROR, PURE_ABORT, /* ISO_ERRORS */ DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR_IO_MODE, DOMAIN_ERROR_MUTABLE, DOMAIN_ERROR_NON_EMPTY_LIST, DOMAIN_ERROR_NOT_LESS_THAN_ZERO, DOMAIN_ERROR_NOT_NL, DOMAIN_ERROR_NOT_ZERO, DOMAIN_ERROR_OUT_OF_RANGE, DOMAIN_ERROR_OPERATOR_PRIORITY, DOMAIN_ERROR_OPERATOR_SPECIFIER, DOMAIN_ERROR_RADIX, DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, DOMAIN_ERROR_SOURCE_SINK, DOMAIN_ERROR_STREAM, DOMAIN_ERROR_STREAM_OR_ALIAS, DOMAIN_ERROR_STREAM_POSITION, DOMAIN_ERROR_TIMEOUT_SPEC, DOMAIN_ERROR_SYNTAX_ERROR_HANDLER, EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR_ZERO_DIVISOR, EXISTENCE_ERROR_ARRAY, EXISTENCE_ERROR_SOURCE_SINK, EXISTENCE_ERROR_STREAM, INSTANTIATION_ERROR, PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM, PERMISSION_ERROR_CREATE_ARRAY, PERMISSION_ERROR_CREATE_OPERATOR, PERMISSION_ERROR_INPUT_BINARY_STREAM, PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, PERMISSION_ERROR_INPUT_STREAM, PERMISSION_ERROR_INPUT_TEXT_STREAM, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, PERMISSION_ERROR_OPEN_SOURCE_SINK, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, PERMISSION_ERROR_OUTPUT_STREAM, PERMISSION_ERROR_OUTPUT_TEXT_STREAM, PERMISSION_ERROR_RESIZE_ARRAY, PERMISSION_ERROR_REPOSITION_STREAM, REPRESENTATION_ERROR_CHARACTER, REPRESENTATION_ERROR_CHARACTER_CODE, REPRESENTATION_ERROR_MAX_ARITY, SYNTAX_ERROR, SYSTEM_ERROR, TYPE_ERROR_ARRAY, TYPE_ERROR_ATOM, TYPE_ERROR_ATOMIC, TYPE_ERROR_BYTE, TYPE_ERROR_CALLABLE, TYPE_ERROR_CHARACTER, TYPE_ERROR_COMPOUND, TYPE_ERROR_DBREF, TYPE_ERROR_DBTERM, TYPE_ERROR_EVALUABLE, TYPE_ERROR_FLOAT, TYPE_ERROR_INTEGER, TYPE_ERROR_KEY, TYPE_ERROR_LIST, TYPE_ERROR_NUMBER, TYPE_ERROR_PREDICATE_INDICATOR, TYPE_ERROR_PTR, TYPE_ERROR_UBYTE, TYPE_ERROR_VARIABLE, UNKNOWN_ERROR } yap_error_number; extern char *ErrorMessage; /* used to pass error messages */ extern Term Error_Term; /* used to pass error terms */ extern yap_error_number Error_TYPE; /* used to pass the error */ typedef enum { YAP_INT_BOUNDED_FLAG = 0, MAX_ARITY_FLAG = 1, INTEGER_ROUNDING_FLAG = 2, YAP_MAX_INTEGER_FLAG = 3, YAP_MIN_INTEGER_FLAG = 4, CHAR_CONVERSION_FLAG = 5, YAP_DOUBLE_QUOTES_FLAG = 6, YAP_TO_CHARS_FLAG = 7, LANGUAGE_MODE_FLAG = 8, STRICT_ISO_FLAG = 9, SPY_CREEP_FLAG = 10, SOURCE_MODE_FLAG = 11, CHARACTER_ESCAPE_FLAG = 12, WRITE_QUOTED_STRING_FLAG = 13, ALLOW_ASSERTING_STATIC_FLAG = 14, HALT_AFTER_CONSULT_FLAG = 15 } yap_flags; #define STRING_AS_CHARS 0 #define STRING_AS_ATOM 2 #define QUINTUS_TO_CHARS 0 #define ISO_TO_CHARS 1 #define CPROLOG_CHARACTER_ESCAPES 0 #define ISO_CHARACTER_ESCAPES 1 #define SICSTUS_CHARACTER_ESCAPES 2 #define NUMBER_OF_YAP_FLAGS HALT_AFTER_CONSULT_FLAG+1 /************************ prototypes **********************************/ #include "Yapproto.h" /************************ OPTYap configuration ************************/ /* These must be included before unification handlers */ #if defined(YAPOR) || defined(TABLING) #include "opt.config.h" #endif /***********************************************************************/ /* absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var with AbsAppl(t) : *CELL -> Term and RepAppl(t) : Term -> *CELL and AbsPair(t) : *CELL -> Term and RepPair(t) : Term -> *CELL and IsIntTerm(t) = ... and IsAtomTerm(t) = ... and IsVarTerm(t) = ... and IsPairTerm(t) = ... and IsApplTerm(t) = ... and IsFloatTerm(t) = ... and IsRefTerm(t) = ... and IsNonVarTerm(t) = ! IsVar(t) and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t) and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t) and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t) and MkIntTerm(n) = ... and MkFloatTerm(f) = ... and MkAtomTerm(a) = ... and MkVarTerm(r) = ... and MkApplTerm(f,n,args) = ... and MkPairTerm(hd,tl) = ... and MkRefTerm(R) = ... and PtrOfTerm(t) : Term -> CELL * = ... and IntOfTerm(t) : Term -> int = ... and FloatOfTerm(t) : Term -> flt = ... and AtomOfTerm(t) : Term -> Atom = ... and VarOfTerm(t) : Term -> *Term = .... and HeadOfTerm(t) : Term -> Term = ... and TailOfTerm(t) : Term -> Term = ... and FunctorOfTerm(t) : Term -> Functor = ... and ArgOfTerm(i,t) : Term -> Term= ... and RefOfTerm(t) : Term -> DBRef = ... */ /* YAP can use several different tag schemes, according to the kind of machine we are experimenting with. */ #if LONG_ADDRESSES && defined(OLD_TAG_SCHEME) #include "Tags_32bits.h" #endif /* LONG_ADDRESSES && defined(OLD_TAG_SCHEME) */ /* AIX will by default place mmaped segments at 0x30000000. This is incompatible with the high tag scheme. Linux-ELF also does not like if you place things in the lower addresses (power to the libc people). */ #if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING) #define USE_LOW32_TAGS 1 #endif #if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS) #include "Tags_32Ops.h" #endif /* LONG_ADDRESSES && !defined(OLD_TAG_SCHEME) && !defined(USE_LOW32_TAGS) */ #if LONG_ADDRESSES && SIZEOF_INT_P==4 && !defined(OLD_TAG_SCHEME) && defined(USE_LOW32_TAGS) #include "Tags_32LowTag.h" #endif /* LONG_ADDRESSES && !defined(OLD_TAG_SCHEME) */ #if LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME) #include "Tags_64bits.h" #endif /* LONG_ADDRESSES && SIZEOF_INT_P==8 && !defined(OLD_TAG_SCHEME) */ #if !LONG_ADDRESSES #include "Tags_24bits.h" #endif /* !LONG_ADDRESSES */ #ifdef TAG_LOW_BITS_32 #define MBIT 0x80000000 #define RBIT 0x40000000 #if IN_SECOND_QUADRANT #define INVERT_RBIT 1 /* RBIT is 1 by default */ #endif #else #if defined(SBA) && defined(__linux__) #define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */ #else #define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */ #define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */ #endif #endif #define TermSize sizeof(Term) /* applies to unbound variables */ Destructor(Term, VarOf, Term *, t, t) #if SBA Inline0(MkVarTerm, Term, (*H = 0, H++)) Inline(IsUnboundVar, int, Term, t, t == 0) #else Inline0(MkVarTerm, Term, (*H = (CELL) H, H++)) Inline(IsUnboundVar, int, Term, t, *VarOfTerm(t) == (t)) #endif Inline(PtrOfTerm, CELL *, Term, t, *(CELL *)(t)) Inline(FunctorOfTerm, Functor, Term, t, *RepAppl(t)) #if IN_SECOND_QUADRANT Inline(MkAtomTerm, Term, Atom, a, TAGGEDA(AtomTag, (CELL *)(a)-(CELL *)HEAP_INIT_BASE)) Destructor(Term, AtomOf, Atom, t, (CELL *)HEAP_INIT_BASE+NonTagPart(t)) #else Inline(MkAtomTerm, Term, Atom, a, TAGGEDA(AtomTag, (a))) Destructor(Term, AtomOf, Atom, t, NonTagPart(t)) #endif Inline(IsAtomTerm, int, Term, t, CHKTAG((t), AtomTag)) Inline(MkIntTerm, Term, Int, n, TAGGED(NumberTag, (n))) /* A constant to subtract or add to a well-known term, we assume no overflow problems are possible */ Inline(MkIntConstant, Term, Int, n, NONTAGGED(NumberTag, (n))) Inline(IsIntTerm, int, Term, t, CHKTAG((t), NumberTag)) /* Needed to handle numbers: these two macros are fundamental in the integer/float conversions */ #ifdef M_WILLIAMS #define IntInBnd(X) (TRUE) #else #ifdef TAGS_FAST_OPS #define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1) #else #define IntInBnd(X) ( (X) < MAX_ABS_INT && \ (X) > -MAX_ABS_INT-1L ) #endif #endif #ifdef C_PROLOG #define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) ) #else #define FlIsInt(X) ( FALSE ) #endif /************* variables related to memory allocation *******************/ /* must be before TermExt.h */ extern ADDR HeapBase, LocalBase, GlobalBase, TrailBase, TrailTop, ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; /* There are two types of functors: o Special functors mark special terms on the heap that should be seen as constants. o Standard functors mark normal applications. */ #include "TermExt.h" #define IsAccessFunc(func) ((func) == FunctorAccess) Inline(MkIntegerTerm, Term, Int, n, IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n)) Inline(IsIntegerTerm, int, Term, t, IsIntTerm(t) || IsLongIntTerm(t)) Inline(IntegerOfTerm, Int, Term, t, IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t)) /*************** unification routines ***********************************/ #if SBA #include "sbaamiops.h" #else #include "amiops.h" #endif /*************** High level macros to access arguments ******************/ Inline2(ArgOfTerm, Term, int, i, Term, t, Derefa(RepAppl(t) + (i))) Inline(HeadOfTerm, Term, Term, t, Derefa(RepPair(t))) Inline(TailOfTerm, Term, Term, t, Derefa(RepPair(t) + 1)) Inline2(ArgOfTermCell, Term, int, i, Term, t, (CELL)(RepAppl(t) + (i))) Inline(HeadOfTermCell, Term, Term, t, (CELL)(RepPair(t))) Inline(TailOfTermCell, Term, Term, t, (CELL)(RepPair(t) + 1)) /*************** variables concerned with atoms table *******************/ #define MaxHash 1001 /************ variables concerned with save and restore *************/ extern int splfild; #define FAIL_RESTORE 0 #define DO_EVERYTHING 1 #define DO_ONLY_CODE 2 #ifdef EMACS /******************** using Emacs mode ********************************/ extern int emacs_mode; #endif /************ variable concerned with version number *****************/ extern char version_number[]; /* consult stack management */ typedef union CONSULT_OBJ { char *filename; int mode; Prop p; union CONSULT_OBJ *c; } consult_obj; /********* common instructions codes*************************/ #define MAX_PROMPT 256 #if USE_THREADED_CODE /************ reverse lookup of instructions *****************/ typedef struct opcode_tab_entry { OPCODE opc; op_numbers opnum; } opentry; #endif /******************* controlling the compiler ****************************/ extern int optimizer_on; /******************* the line for the current parse **********************/ extern int StartLine; extern int StartCh; extern int CurFileNo; /********************* how to write a Prolog term ***********************/ /********* Prolog may be in several modes *******************************/ typedef enum { BootMode = 1, /* if booting or restoring */ UserMode = 2, /* Normal mode */ CritMode = 4, /* If we are meddling with the heap */ AbortMode = 8, /* expecting to abort */ InterruptMode = 16 /* under an interrupt */ } prolog_exec_mode; extern prolog_exec_mode PrologMode; extern int CritLocks; #if SIZEOF_INT_P==4 #if defined(YAPOR) || defined(TABLING) #define MinTrailSpace 192 #define MinStackSpace 1200 #define MinHeapSpace 1200 #else #define MinTrailSpace 128 #define MinStackSpace 800 #define MinHeapSpace 800 #endif /* YAPOR || TABLING */ #else #if defined(YAPOR) || defined(TABLING) #define MinTrailSpace 384 #define MinStackSpace 2400 #define MinHeapSpace 2400 #else #define MinTrailSpace 256 #define MinStackSpace 1600 #define MinHeapSpace 1600 #endif /* YAPOR || TABLING */ #endif #define DefTrailSpace MinTrailSpace #define DefStackSpace MinStackSpace #define DefHeapSpace MinHeapSpace /************** Access to yap initial arguments ***************************/ extern char **yap_args; extern int yap_argc; #ifdef YAPOR #define YAPEnterCriticalSection() \ { \ if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \ LOCK(GLOBAL_LOCKS_heap_access); \ GLOBAL_LOCKS_who_locked_heap = worker_id; \ } \ PrologMode |= CritMode; \ CritLocks++; \ } #define YAPLeaveCriticalSection() \ { \ CritLocks--; \ if (!CritLocks) { \ PrologMode &= ~CritMode; \ if (PrologMode & InterruptMode) { \ PrologMode &= ~InterruptMode; \ ProcessSIGINT(); \ } \ if (PrologMode & AbortMode) { \ PrologMode &= ~AbortMode; \ Abort(""); \ } \ GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \ UNLOCK(GLOBAL_LOCKS_heap_access); \ } \ } #else #define YAPEnterCriticalSection() \ { \ PrologMode |= CritMode; \ CritLocks++; \ } #define YAPLeaveCriticalSection() \ { \ CritLocks--; \ if (!CritLocks) { \ PrologMode &= ~CritMode; \ if (PrologMode & InterruptMode) { \ PrologMode &= ~InterruptMode; \ ProcessSIGINT(); \ } \ if (PrologMode & AbortMode) { \ PrologMode &= ~AbortMode; \ Abort(""); \ } \ } \ } #endif /* YAPOR */ /* when we are calling the InitStaff procedures */ #define AT_BOOT 0 #define AT_RESTORE 1 /********* whether we should try to compile array references ******************/ extern int compile_arrays; /********* mutable variables ******************/ /* I assume that the size of this structure is a multiple of the size of CELL!!! */ typedef struct TIMED_MAVAR{ CELL value; CELL clock; } timed_var; /********* while debugging you may need some info ***********************/ #if DEBUG extern int output_msg; #endif #if EMACS extern char emacs_tmp[], emacs_tmp2[]; #endif #if HAVE_SIGNAL extern int snoozing; #endif #if defined(YAPOR) || defined(TABLING) #include "opt.structs.h" #include "opt.macros.h" #include "opt.proto.h" #endif /* YAPOR || TABLING */ #if SBA #include "sbaunify.h" #endif