diff --git a/VC/include/Atoms.h b/VC/include/Atoms.h index d1de5a725..ea09c52ab 100755 --- a/VC/include/Atoms.h +++ b/VC/include/Atoms.h @@ -1,116 +1,112 @@ - - - - - - - -/************************************************************************* -* * -* 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: Atoms.h.m4 * -* Last rev: 19/2/88 * -* mods: * -* comments: atom properties header file for YAP * -* * -*************************************************************************/ - -#undef EXTERN -#ifndef ADTDEFS_C -#define EXTERN static -#else -#define EXTERN -#endif - -/********* operations for atoms ****************************************/ - -/* Atoms are assumed to be uniquely represented by an OFFSET and to have - associated with them a struct of type AtomEntry - The two functions - RepAtom : Atom -> *AtomEntry - AbsAtom : *AtomEntry -> Atom - are used to encapsulate the implementation of atoms -*/ - -typedef struct AtomEntryStruct *Atom; -typedef struct PropEntryStruct *Prop; - - -/* I can only define the structure after I define the actual atoms */ - -/* atom structure */ -typedef struct AtomEntryStruct -{ - Atom NextOfAE; /* used to build hash chains */ - Prop PropsOfAE; /* property list for this atom */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t ARWLock; -#endif - - char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */ -} -AtomEntry; - -/* Props and Atoms are stored in chains, ending with a NIL */ -#if USE_OFFSETS -# define EndOfPAEntr(P) ( Addr(P) == AtomBase) -#else -# define EndOfPAEntr(P) ( Addr(P) == NIL ) -#endif - -#define AtomName(at) RepAtom(at)->StrOfAE - - -/* ********************** Properties **********************************/ - -#if USE_OFFSETS -#define USE_OFFSETS_IN_PROPS 1 -#else -#define USE_OFFSETS_IN_PROPS 0 -#endif - -typedef SFLAGS PropFlags; - -/* basic property entry structure */ -typedef struct PropEntryStruct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ -} -PropEntry; - -/* ************************* Functors **********************************/ - - /* Functor data type - abstype Functor = atom # int - with MkFunctor(a,n) = ... - and NameOfFunctor(f) = ... - and ArityOfFunctor(f) = ... */ - -#define MaxArity 255 - - -#define FunctorProperty ((PropFlags)(0xbb00)) - -/* functor property */ -typedef struct FunctorEntryStruct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfFE; /* arity of functor */ - Atom NameOfFE; /* back pointer to owner atom */ - Prop PropsOfFE; /* pointer to list of properties for this functor */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t FRWLock; -#endif -} -FunctorEntry; - -typedef FunctorEntry *Functor; + + + + + + + +/************************************************************************* +* * +* 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: Atoms.h.m4 * +* Last rev: 19/2/88 * +* mods: * +* comments: atom properties header file for YAP * +* * +*************************************************************************/ + +#undef EXTERN +#ifndef ADTDEFS_C +#define EXTERN static +#else +#define EXTERN +#endif + +/********* operations for atoms ****************************************/ + +/* Atoms are assumed to be uniquely represented by an OFFSET and to have + associated with them a struct of type AtomEntry + The two functions + RepAtom : Atom -> *AtomEntry + AbsAtom : *AtomEntry -> Atom + are used to encapsulate the implementation of atoms +*/ + +typedef struct AtomEntryStruct *Atom; +typedef struct PropEntryStruct *Prop; + + +/* I can only define the structure after I define the actual atoms */ + +/* atom structure */ +typedef struct AtomEntryStruct { + Atom NextOfAE; /* used to build hash chains */ + Prop PropsOfAE; /* property list for this atom */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t ARWLock; +#endif + + char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */ +} +AtomEntry; + +/* Props and Atoms are stored in chains, ending with a NIL */ +#if USE_OFFSETS +# define EndOfPAEntr(P) ( Addr(P) == AtomBase) +#else +# define EndOfPAEntr(P) ( Addr(P) == NIL ) +#endif + +#define AtomName(at) RepAtom(at)->StrOfAE + + +/* ********************** Properties **********************************/ + +#if USE_OFFSETS +#define USE_OFFSETS_IN_PROPS 1 +#else +#define USE_OFFSETS_IN_PROPS 0 +#endif + +typedef SFLAGS PropFlags; + +/* basic property entry structure */ +typedef struct PropEntryStruct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + } PropEntry; + +/* ************************* Functors **********************************/ + + /* Functor data type + abstype Functor = atom # int + with MkFunctor(a,n) = ... + and NameOfFunctor(f) = ... + and ArityOfFunctor(f) = ... */ + +#define MaxArity 255 + + +#define FunctorProperty ((PropFlags)(0xbb00)) + +/* functor property */ +typedef struct FunctorEntryStruct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfFE; /* arity of functor */ + Atom NameOfFE; /* back pointer to owner atom */ + Prop PropsOfFE; /* pointer to list of properties for this functor */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t FRWLock; +#endif +} FunctorEntry; + +typedef FunctorEntry *Functor; + diff --git a/VC/include/Tags_24bits.h b/VC/include/Tags_24bits.h index 80b1fcc47..9d94a5f77 100644 --- a/VC/include/Tags_24bits.h +++ b/VC/include/Tags_24bits.h @@ -18,7 +18,7 @@ * Last rev: December 90 * * mods: * * comments: Tag Scheme for machines with 24 bits adresses (m68000) * -* version: $Id: Tags_24bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: Tags_24bits.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ /* Version for 24 bit addresses (68000) diff --git a/VC/include/Tags_32LowTag.h b/VC/include/Tags_32LowTag.h index 18b28c5b2..1e241488c 100644 --- a/VC/include/Tags_32LowTag.h +++ b/VC/include/Tags_32LowTag.h @@ -18,7 +18,7 @@ * Last rev: December 90 * * mods: * * comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32LowTag.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: Tags_32LowTag.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ #define TAG_LOW_BITS_32 1 @@ -72,10 +72,10 @@ property list #define NumberBits /* 0x0000000aL */ MKTAG(0x2,2) #define NumberMask /* 0x0000000bL */ MKTAG(0x2,3) -#define NonTagPart(V) (Unsigned(V)>>(SHIFT_LOW_TAG+SHIFT_HIGH_TAG)) +#define NonTagPart(V) ((Unsigned(V)>>1) & ~LowTagBits) #define TAGGED(TAG,V) (((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)|(TAG)) #define NONTAGGED(TAG,V) ((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1) -#define TAGGEDA(TAG,V) ((Unsigned(V) << (SHIFT_HIGH_TAG+SHIFT_LOW_TAG))|(TAG)) +#define TAGGEDA(TAG,V) ((Unsigned(V) << 1)|(TAG)) #define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) /* bits that should not be used by anyone but us */ diff --git a/VC/include/Tags_32Ops.h b/VC/include/Tags_32Ops.h index 80a57a540..1ca233951 100644 --- a/VC/include/Tags_32Ops.h +++ b/VC/include/Tags_32Ops.h @@ -18,7 +18,7 @@ * Last rev: December 90 * * mods: * * comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32Ops.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: Tags_32Ops.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ /* diff --git a/VC/include/Tags_32bits.h b/VC/include/Tags_32bits.h index 4e7d8228b..dc976cc1b 100644 --- a/VC/include/Tags_32bits.h +++ b/VC/include/Tags_32bits.h @@ -18,7 +18,7 @@ * Last rev: December 90 * * mods: * * comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: Tags_32bits.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ /* Original version for 32 bit addresses machines, diff --git a/VC/include/Tags_64bits.h b/VC/include/Tags_64bits.h index 94759079d..19a9e4979 100644 --- a/VC/include/Tags_64bits.h +++ b/VC/include/Tags_64bits.h @@ -18,7 +18,7 @@ * Last rev: December 90 * * mods: * * comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_64bits.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: Tags_64bits.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ #define TAG_64BITS 1 diff --git a/VC/include/TermExt.h b/VC/include/TermExt.h index 969779c14..5c3d2f61f 100644 --- a/VC/include/TermExt.h +++ b/VC/include/TermExt.h @@ -17,7 +17,7 @@ * File: TermExt.h * * mods: * * comments: Extensions to standard terms for YAP * -* version: $Id: TermExt.h,v 1.8 2002-02-04 16:12:54 vsc Exp $ * +* version: $Id: TermExt.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ * *************************************************************************/ #if USE_OFFSETS diff --git a/VC/include/Yap.h b/VC/include/Yap.h index c861fa76c..cb9306320 100644 --- a/VC/include/Yap.h +++ b/VC/include/Yap.h @@ -1,1102 +1,1052 @@ - - - - - - - -/************************************************************************* -* * -* 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,v 1.8 2002-02-04 16:12:54 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.21" -#define BIN_DIR "c:\\Program Files\\Yap\\bin" -#define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap" -#define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap" -#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 -#if defined(sparc) || defined(__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, - FAST_BOOT_FLAG = 16 -} -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 FAST_BOOT_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(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || 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 */ - -inline EXTERN Term *VarOfTerm (Term t); - -inline EXTERN Term * -VarOfTerm (Term t) -{ - return (Term *) (t); -} - - -#if SBA - -inline EXTERN Term MkVarTerm (void); - -inline EXTERN Term -MkVarTerm () -{ - return (Term) ((*H = 0, H++)); -} - - - -inline EXTERN int IsUnboundVar (Term); - -inline EXTERN int -IsUnboundVar (Term t) -{ - return (int) (t == 0); -} - - -#else - -inline EXTERN Term MkVarTerm (void); - -inline EXTERN Term -MkVarTerm () -{ - return (Term) ((*H = (CELL) H, H++)); -} - - - -inline EXTERN int IsUnboundVar (Term); - -inline EXTERN int -IsUnboundVar (Term t) -{ - return (int) (*VarOfTerm (t) == (t)); -} - - -#endif - -inline EXTERN CELL *PtrOfTerm (Term); - -inline EXTERN CELL * -PtrOfTerm (Term t) -{ - return (CELL *) (*(CELL *) (t)); -} - - - - -inline EXTERN Functor FunctorOfTerm (Term); - -inline EXTERN Functor -FunctorOfTerm (Term t) -{ - return (Functor) (*RepAppl (t)); -} - - -#if IN_SECOND_QUADRANT - -inline EXTERN Term MkAtomTerm (Atom); - -inline EXTERN Term -MkAtomTerm (Atom a) -{ - return (Term) (TAGGEDA (AtomTag, (CELL *) (a) - (CELL *) HEAP_INIT_BASE)); -} - - - -inline EXTERN Atom AtomOfTerm (Term t); - -inline EXTERN Atom -AtomOfTerm (Term t) -{ - return (Atom) ((CELL *) HEAP_INIT_BASE + NonTagPart (t)); -} - - -#else - -inline EXTERN Term MkAtomTerm (Atom); - -inline EXTERN Term -MkAtomTerm (Atom a) -{ - return (Term) (TAGGEDA (AtomTag, (a))); -} - - - -inline EXTERN Atom AtomOfTerm (Term t); - -inline EXTERN Atom -AtomOfTerm (Term t) -{ - return (Atom) (NonTagPart (t)); -} - - -#endif - -inline EXTERN int IsAtomTerm (Term); - -inline EXTERN int -IsAtomTerm (Term t) -{ - return (int) (CHKTAG ((t), AtomTag)); -} - - - - -inline EXTERN Term MkIntTerm (Int); - -inline EXTERN Term -MkIntTerm (Int n) -{ - return (Term) (TAGGED (NumberTag, (n))); -} - - -/* - A constant to subtract or add to a well-known term, we assume no - overflow problems are possible -*/ - -inline EXTERN Term MkIntConstant (Int); - -inline EXTERN Term -MkIntConstant (Int n) -{ - return (Term) (NONTAGGED (NumberTag, (n))); -} - - - -inline EXTERN int IsIntTerm (Term); - -inline EXTERN int -IsIntTerm (Term t) -{ - return (int) (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 EXTERN Term MkIntegerTerm (Int); - -inline EXTERN Term -MkIntegerTerm (Int n) -{ - return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n)); -} - - - -inline EXTERN int IsIntegerTerm (Term); - -inline EXTERN int -IsIntegerTerm (Term t) -{ - return (int) (IsIntTerm (t) || IsLongIntTerm (t)); -} - - - -inline EXTERN Int IntegerOfTerm (Term); - -inline EXTERN Int -IntegerOfTerm (Term t) -{ - return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t)); -} - - - - -/*************** unification routines ***********************************/ - -#if SBA -#include "sbaamiops.h" -#else -#include "amiops.h" -#endif - -/*************** High level macros to access arguments ******************/ - - -inline EXTERN Term ArgOfTerm (int i, Term t); - -inline EXTERN Term -ArgOfTerm (int i, Term t) -{ - return (Term) (Derefa (RepAppl (t) + (i))); -} - - - -inline EXTERN Term HeadOfTerm (Term); - -inline EXTERN Term -HeadOfTerm (Term t) -{ - return (Term) (Derefa (RepPair (t))); -} - - - -inline EXTERN Term TailOfTerm (Term); - -inline EXTERN Term -TailOfTerm (Term t) -{ - return (Term) (Derefa (RepPair (t) + 1)); -} - - - - -inline EXTERN Term ArgOfTermCell (int i, Term t); - -inline EXTERN Term -ArgOfTermCell (int i, Term t) -{ - return (Term) ((CELL) (RepAppl (t) + (i))); -} - - - -inline EXTERN Term HeadOfTermCell (Term); - -inline EXTERN Term -HeadOfTermCell (Term t) -{ - return (Term) ((CELL) (RepPair (t))); -} - - - -inline EXTERN Term TailOfTermCell (Term); - -inline EXTERN Term -TailOfTermCell (Term t) -{ - return (Term) ((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[]; - -/********* 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 */ - InErrorMode = 32 /* under an interrupt */ -} -prolog_exec_mode; - -extern prolog_exec_mode PrologMode; -extern int CritLocks; - -/************** 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; \ - Error(PURE_ABORT, 0, ""); \ - } \ - 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; \ - Error(PURE_ABORT, 0, ""); \ - } \ - } \ - } -#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 + + + + + + + +/************************************************************************* +* * +* 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,v 1.9 2002-06-01 04:29:01 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.21" +#define BIN_DIR "c:\\Program Files\\Yap\\bin" +#define LIB_DIR "c:\\Program Files\\Yap\\lib\\Yap" +#define SHARE_DIR "c:\\Program Files\\Yap\\share\\Yap" +#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 +#if defined(sparc) || defined(__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 { + YAP_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, + FAST_BOOT_FLAG = 16 +} 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 FAST_BOOT_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(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || 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) + +/************* variables related to memory allocation *******************/ +/* must be before TermExt.h */ +extern ADDR HeapBase, + LocalBase, + GlobalBase, + TrailBase, TrailTop, + ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; + + +/* applies to unbound variables */ + +inline EXTERN Term * VarOfTerm(Term t); + +inline EXTERN Term * VarOfTerm(Term t) +{ + return (Term *) (t); +} + + +#if SBA + +inline EXTERN Term MkVarTerm(void); + +inline EXTERN Term MkVarTerm() +{ + return (Term) ((*H = 0, H++)); +} + + + +inline EXTERN int IsUnboundVar(Term); + +inline EXTERN int IsUnboundVar(Term t) +{ + return (int) (t == 0); +} + + +#else + +inline EXTERN Term MkVarTerm(void); + +inline EXTERN Term MkVarTerm() +{ + return (Term) ((*H = (CELL) H, H++)); +} + + + +inline EXTERN int IsUnboundVar(Term); + +inline EXTERN int IsUnboundVar(Term t) +{ + return (int) (*VarOfTerm(t) == (t)); +} + + +#endif + +inline EXTERN CELL * PtrOfTerm(Term); + +inline EXTERN CELL * PtrOfTerm(Term t) +{ + return (CELL *) (*(CELL *)(t)); +} + + + + +inline EXTERN Functor FunctorOfTerm(Term); + +inline EXTERN Functor FunctorOfTerm(Term t) +{ + return (Functor) (*RepAppl(t)); +} + + + +inline EXTERN Term MkAtomTerm(Atom); + +inline EXTERN Term MkAtomTerm(Atom a) +{ + return (Term) (TAGGEDA(AtomTag, (CELL)(a)-HEAP_INIT_BASE)); +} + + + +inline EXTERN Atom AtomOfTerm(Term t); + +inline EXTERN Atom AtomOfTerm(Term t) +{ + return (Atom) (HEAP_INIT_BASE+NonTagPart(t)); +} + + + +inline EXTERN int IsAtomTerm(Term); + +inline EXTERN int IsAtomTerm(Term t) +{ + return (int) (CHKTAG((t), AtomTag)); +} + + + + +inline EXTERN Term MkIntTerm(Int); + +inline EXTERN Term MkIntTerm(Int n) +{ + return (Term) (TAGGED(NumberTag, (n))); +} + + +/* + A constant to subtract or add to a well-known term, we assume no + overflow problems are possible +*/ + +inline EXTERN Term MkIntConstant(Int); + +inline EXTERN Term MkIntConstant(Int n) +{ + return (Term) (NONTAGGED(NumberTag, (n))); +} + + + +inline EXTERN int IsIntTerm(Term); + +inline EXTERN int IsIntTerm(Term t) +{ + return (int) (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 + + +/* + 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 EXTERN Term MkIntegerTerm(Int); + +inline EXTERN Term MkIntegerTerm(Int n) +{ + return (Term) (IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n)); +} + + + +inline EXTERN int IsIntegerTerm(Term); + +inline EXTERN int IsIntegerTerm(Term t) +{ + return (int) (IsIntTerm(t) || IsLongIntTerm(t)); +} + + + +inline EXTERN Int IntegerOfTerm(Term); + +inline EXTERN Int IntegerOfTerm(Term t) +{ + return (Int) (IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t)); +} + + + + +/*************** unification routines ***********************************/ + +#if SBA +#include "sbaamiops.h" +#else +#include "amiops.h" +#endif + +/*************** High level macros to access arguments ******************/ + + +inline EXTERN Term ArgOfTerm(int i, Term t); + +inline EXTERN Term ArgOfTerm(int i, Term t) +{ + return (Term) (Derefa(RepAppl(t) + (i))); +} + + + +inline EXTERN Term HeadOfTerm(Term); + +inline EXTERN Term HeadOfTerm(Term t) +{ + return (Term) (Derefa(RepPair(t))); +} + + + +inline EXTERN Term TailOfTerm(Term); + +inline EXTERN Term TailOfTerm(Term t) +{ + return (Term) (Derefa(RepPair(t) + 1)); +} + + + + +inline EXTERN Term ArgOfTermCell(int i, Term t); + +inline EXTERN Term ArgOfTermCell(int i, Term t) +{ + return (Term) ((CELL)(RepAppl(t) + (i))); +} + + + +inline EXTERN Term HeadOfTermCell(Term); + +inline EXTERN Term HeadOfTermCell(Term t) +{ + return (Term) ((CELL)(RepPair(t))); +} + + + +inline EXTERN Term TailOfTermCell(Term); + +inline EXTERN Term TailOfTermCell(Term t) +{ + return (Term) ((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[]; + +/********* 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 */ + InErrorMode = 32, /* under an interrupt */ + ConsoleGetcMode = 64 /* blocked reading from console */ +} prolog_exec_mode; + +extern prolog_exec_mode PrologMode; +extern int CritLocks; + +/************** Access to yap initial arguments ***************************/ + +extern char **yap_args; +extern int yap_argc; + +/******************* controlling debugging ****************************/ +extern int creep_on; + +#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; \ + Error(PURE_ABORT, 0, ""); \ + } \ + 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; \ + Error(PURE_ABORT, 0, ""); \ + } \ + } \ + } +#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 + diff --git a/VC/include/Yatom.h b/VC/include/Yatom.h index 5419534bf..7460d1d7c 100644 --- a/VC/include/Yatom.h +++ b/VC/include/Yatom.h @@ -1,1184 +1,1079 @@ - - - - - - - -/************************************************************************* -* * -* 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: YAtom.h.m4 * -* Last rev: 19/2/88 * -* mods: * -* comments: atom properties header file for YAP * -* * -*************************************************************************/ - -/* This code can only be defined *after* including Regs.h!!! */ - -#if USE_OFFSETS - -inline EXTERN Atom AbsAtom (AtomEntry * p); - -inline EXTERN Atom -AbsAtom (AtomEntry * p) -{ - return (Atom) (Addr (p) - AtomBase); -} - - - -inline EXTERN AtomEntry *RepAtom (Atom a); - -inline EXTERN AtomEntry * -RepAtom (Atom a) -{ - return (AtomEntry *) (AtomBase + Unsigned (a)); -} - - -#else - -inline EXTERN Atom AbsAtom (AtomEntry * p); - -inline EXTERN Atom -AbsAtom (AtomEntry * p) -{ - return (Atom) (p); -} - - - -inline EXTERN AtomEntry *RepAtom (Atom a); - -inline EXTERN AtomEntry * -RepAtom (Atom a) -{ - return (AtomEntry *) (a); -} - - -#endif - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN Prop AbsProp (PropEntry * p); - -inline EXTERN Prop -AbsProp (PropEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - - -inline EXTERN PropEntry *RepProp (Prop p); - -inline EXTERN PropEntry * -RepProp (Prop p) -{ - return (PropEntry *) (AtomBase + Unsigned (p)); -} - - -#else - -inline EXTERN Prop AbsProp (PropEntry * p); - -inline EXTERN Prop -AbsProp (PropEntry * p) -{ - return (Prop) (p); -} - - - -inline EXTERN PropEntry *RepProp (Prop p); - -inline EXTERN PropEntry * -RepProp (Prop p) -{ - return (PropEntry *) (p); -} - - -#endif - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN FunctorEntry *RepFunctorProp (Prop p); - -inline EXTERN FunctorEntry * -RepFunctorProp (Prop p) -{ - return (FunctorEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsFunctorProp (FunctorEntry * p); - -inline EXTERN Prop -AbsFunctorProp (FunctorEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN FunctorEntry *RepFunctorProp (Prop p); - -inline EXTERN FunctorEntry * -RepFunctorProp (Prop p) -{ - return (FunctorEntry *) (p); -} - - - -inline EXTERN Prop AbsFunctorProp (FunctorEntry * p); - -inline EXTERN Prop -AbsFunctorProp (FunctorEntry * p) -{ - return (Prop) (p); -} - - -#endif - - -inline EXTERN Int ArityOfFunctor (Functor); - -inline EXTERN Int -ArityOfFunctor (Functor Fun) -{ - return (Int) (((FunctorEntry *) Fun)->ArityOfFE); -} - - - -inline EXTERN Atom NameOfFunctor (Functor); - -inline EXTERN Atom -NameOfFunctor (Functor Fun) -{ - return (Atom) (((FunctorEntry *) Fun)->NameOfFE); -} - - - - -inline EXTERN PropFlags IsFunctorProperty (int); - -inline EXTERN PropFlags -IsFunctorProperty (int flags) -{ - return (PropFlags) ((flags == FunctorProperty)); -} - - - -/* summary of property codes used - - 00 00 predicate entry - 80 00 db property - bb 00 functor entry - ff df sparse functor - ff ex arithmetic property - ff f7 array - ff fa module property - ff fb blackboard property - ff fc value property - ff ff op property -*/ - -/* Module property */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - SMALLUNSGN IndexOfMod; /* indec in module table */ -} -ModEntry; - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN ModEntry *RepModProp (Prop p); - -inline EXTERN ModEntry * -RepModProp (Prop p) -{ - return (ModEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsModProp (ModEntry * p); - -inline EXTERN Prop -AbsModProp (ModEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN ModEntry *RepModProp (Prop p); - -inline EXTERN ModEntry * -RepModProp (Prop p) -{ - return (ModEntry *) (p); -} - - - -inline EXTERN Prop AbsModProp (ModEntry * p); - -inline EXTERN Prop -AbsModProp (ModEntry * p) -{ - return (Prop) (p); -} - - -#endif - -#define ModProperty ((PropFlags)0xfffa) - - -inline EXTERN PropFlags IsModProperty (int); - -inline EXTERN PropFlags -IsModProperty (int flags) -{ - return (PropFlags) ((flags == ModProperty)); -} - - - -/* operator property entry structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t OpRWLock; /* a read-write lock to protect the entry */ -#endif - BITS16 Prefix, Infix, Posfix; /* precedences */ -} -OpEntry; -#if USE_OFFSETS_IN_PROPS - -inline EXTERN OpEntry *RepOpProp (Prop p); - -inline EXTERN OpEntry * -RepOpProp (Prop p) -{ - return (OpEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsOpProp (OpEntry * p); - -inline EXTERN Prop -AbsOpProp (OpEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN OpEntry *RepOpProp (Prop p); - -inline EXTERN OpEntry * -RepOpProp (Prop p) -{ - return (OpEntry *) (p); -} - - - -inline EXTERN Prop AbsOpProp (OpEntry * p); - -inline EXTERN Prop -AbsOpProp (OpEntry * p) -{ - return (Prop) (p); -} - - -#endif -#define OpProperty ((PropFlags)0xffff) - - -inline EXTERN PropFlags IsOpProperty (int); - -inline EXTERN PropFlags -IsOpProperty (int flags) -{ - return (PropFlags) ((flags == OpProperty)); -} - - - -/* defines related to operator specifications */ -#define MaskPrio 0x0fff -#define DcrlpFlag 0x1000 -#define DcrrpFlag 0x2000 - -typedef union arith_ret *eval_ret; - -/* expression property entry structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfEE; - BITS16 ENoOfEE; - BITS16 FlagsOfEE; - /* operations that implement the expression */ - union - { - blob_type (*constant) (eval_ret); - blob_type (*unary) (Term, eval_ret); - blob_type (*binary) (Term, Term, eval_ret); - } - FOfEE; -} -ExpEntry; -#if USE_OFFSETS_IN_PROPS - -inline EXTERN ExpEntry *RepExpProp (Prop p); - -inline EXTERN ExpEntry * -RepExpProp (Prop p) -{ - return (ExpEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsExpProp (ExpEntry * p); - -inline EXTERN Prop -AbsExpProp (ExpEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN ExpEntry *RepExpProp (Prop p); - -inline EXTERN ExpEntry * -RepExpProp (Prop p) -{ - return (ExpEntry *) (p); -} - - - -inline EXTERN Prop AbsExpProp (ExpEntry * p); - -inline EXTERN Prop -AbsExpProp (ExpEntry * p) -{ - return (Prop) (p); -} - - -#endif -#define ExpProperty 0xffe0 - -/* only unary and binary expressions are acceptable */ - -inline EXTERN PropFlags IsExpProperty (int); - -inline EXTERN PropFlags -IsExpProperty (int flags) -{ - return (PropFlags) ((flags == ExpProperty)); -} - - - - -/* value property entry structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t VRWLock; /* a read-write lock to protect the entry */ -#endif - Term ValueOfVE; /* (atomic) value associated with the atom */ -} -ValEntry; -#if USE_OFFSETS_IN_PROPS - -inline EXTERN ValEntry *RepValProp (Prop p); - -inline EXTERN ValEntry * -RepValProp (Prop p) -{ - return (ValEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsValProp (ValEntry * p); - -inline EXTERN Prop -AbsValProp (ValEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN ValEntry *RepValProp (Prop p); - -inline EXTERN ValEntry * -RepValProp (Prop p) -{ - return (ValEntry *) (p); -} - - - -inline EXTERN Prop AbsValProp (ValEntry * p); - -inline EXTERN Prop -AbsValProp (ValEntry * p) -{ - return (Prop) (p); -} - - -#endif -#define ValProperty ((PropFlags)0xfffc) - - -inline EXTERN PropFlags IsValProperty (int); - -inline EXTERN PropFlags -IsValProperty (int flags) -{ - return (PropFlags) ((flags == ValProperty)); -} - - - -/* predicate property entry structure */ -/* BasicPreds are things like var, nonvar, atom ...which are implemented - through dedicated machine instructions. In this case the 8 lower - bits of PredFlags are used to hold the machine instruction code - for the pred. - C_Preds are things write, read, ... implemented in C. In this case - CodeOfPred holds the address of the correspondent C-function. -*/ -typedef enum -{ - CutTransparentPredFlag = 0x800000L, /* ! should ! across */ - SourcePredFlag = 0x400000L, /* static predicate with source declaration */ - MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */ - SyncPredFlag = 0x100000L, /* has to synch before it can execute */ - UserCPredFlag = 0x080000L, /* CPred defined by the user */ - MultiFileFlag = 0x040000L, /* is multi-file */ - FastPredFlag = 0x020000L, /* is "compiled" */ - TestPredFlag = 0x010000L, /* is a test (optim. comit) */ - BasicPredFlag = 0x008000L, /* inline */ - StandardPredFlag = 0x004000L, /* system predicate */ - DynamicPredFlag = 0x002000L, /* dynamic predicate */ - CPredFlag = 0x001000L, /* written in C */ - SafePredFlag = 0x000800L, /* does not alter arguments */ - CompiledPredFlag = 0x000400L, /* is static */ - IndexedPredFlag = 0x000200L, /* has indexing code */ - SpiedPredFlag = 0x000100L, /* is a spy point */ - BinaryTestPredFlag = 0x000080L, /* test predicate. */ -#ifdef TABLING - TabledPredFlag = 0x000040L, /* is tabled */ -#endif /* TABLING */ -#ifdef YAPOR - SequentialPredFlag = 0x000020L, /* may not create par. choice points! */ -#endif /* YAPOR */ - ProfiledPredFlag = 0x000010L, /* pred is being profiled */ - LogUpdatePredFlag = 0x000008L /* dynamic predicate with log. upd. sem. */ -} -pred_flag; - -/* profile data */ -typedef struct -{ -#if defined(YAPOR) || defined(THREADS) - lockvar lock; /* a simple lock to protect this entry */ -#endif - Int NOfEntries; /* nbr of times head unification succeeded */ - Int NOfHeadSuccesses; /* nbr of times head unification succeeded */ - Int NOfRetries; /* nbr of times a clause for the pred - was retried */ -} -profile_data; - -typedef struct pred_entry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfPE; /* arity of property */ - CELL PredFlags; - CODEADDR CodeOfPred; /* code address */ - CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ - Functor FunctorOfPred; /* functor for Predicate */ - CODEADDR FirstClause, LastClause; - Atom OwnerFile; /* File where the predicate was defined */ - struct pred_entry *NextPredOfModule; /* next pred for same module */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t PRWLock; /* a simple lock to protect this entry */ -#endif -#ifdef TABLING - tab_ent_ptr TableOfPred; -#endif /* TABLING */ - SMALLUNSGN ModuleOfPred; /* module for this definition */ - OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ - profile_data StatisticsForPred; /* enable profiling for predicate */ - SMALLUNSGN StateOfPred; /* actual state of predicate */ -} -PredEntry; -#define PEProp ((PropFlags)(0x0000)) - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN PredEntry *RepPredProp (Prop p); - -inline EXTERN PredEntry * -RepPredProp (Prop p) -{ - return (PredEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsPredProp (PredEntry * p); - -inline EXTERN Prop -AbsPredProp (PredEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN PredEntry *RepPredProp (Prop p); - -inline EXTERN PredEntry * -RepPredProp (Prop p) -{ - return (PredEntry *) (p); -} - - - -inline EXTERN Prop AbsPredProp (PredEntry * p); - -inline EXTERN Prop -AbsPredProp (PredEntry * p) -{ - return (Prop) (p); -} - - -#endif - - -inline EXTERN PropFlags IsPredProperty (int); - -inline EXTERN PropFlags -IsPredProperty (int flags) -{ - return (PropFlags) ((flags == PEProp)); -} - - - -/********* maximum number of C-written predicates and cmp funcs ******************/ - -#define MAX_C_PREDS 360 -#define MAX_CMP_FUNCS 20 - -typedef struct -{ - PredEntry *p; - CmpPredicate f; -} -cmp_entry; - -extern CPredicate c_predicates[MAX_C_PREDS]; -extern cmp_entry cmp_funcs[MAX_CMP_FUNCS]; - - -/* Flags for code or dbase entry */ -/* There are several flags for code and data base entries */ -typedef enum -{ - GcFoundMask = 0x10000, /* informs this is a dynamic predicate */ - DynamicMask = 0x8000, /* informs this is a dynamic predicate */ - InUseMask = 0x4000, /* informs this block is being used */ - ErasedMask = 0x2000, /* informs this block has been erased */ - IndexMask = 0x1000, /* informs this is indexing code */ - DBClMask = 0x0800, /* informs this is a data base structure */ - LogUpdRuleMask = 0x0400, /* informs the code is for a log upd rule with env */ - LogUpdMask = 0x0200, /* informs this is a logic update index. */ - StaticMask = 0x0100, /* dealing with static predicates */ - SpiedMask = 0x0080 /* this predicate is being spied */ -/* other flags belong to DB */ -} -dbentry_flags; - -/* *********************** DBrefs **************************************/ - -#define KEEP_ENTRY_AGE 1 - -typedef struct DB_STRUCT -{ - Functor id; /* allow pointers to this struct to id */ - /* as dbref */ - Term EntryTerm; /* cell bound to itself */ - SMALLUNSGN Flags; /* Term Flags */ - SMALLUNSGN NOfRefsTo; /* Number of references pointing here */ - struct struct_dbentry *Parent; /* key of DBase reference */ - CODEADDR Code; /* pointer to code if this is a clause */ - struct DB_STRUCT **DBRefs; /* pointer to other references */ - struct DB_STRUCT *Prev; /* Previous element in chain */ - struct DB_STRUCT *Next; /* Next element in chain */ -#if defined(YAPOR) || defined(THREADS) - lockvar lock; /* a simple lock to protect this entry */ - Int ref_count; /* how many branches are using this entry */ -#endif -#ifdef KEEP_ENTRY_AGE - Int age; /* entry's age, negative if from recorda, - positive if it was recordz */ -#endif /* KEEP_ENTRY_AGE */ -#ifdef COROUTINING - CELL attachments; /* attached terms */ -#endif - CELL Mask; /* parts that should be cleared */ - CELL Key; /* A mask that can be used to check before - you unify */ - CELL NOfCells; /* Size of Term */ - CELL Entry; /* entry point */ - Term Contents[MIN_ARRAY]; /* stored term */ -} -DBStruct; - -#define DBStructFlagsToDBStruct(X) ((DBRef)((X) - (CELL) &(((DBRef) NIL)->Flags))) - -#if defined(YAPOR) || defined(THREADS) -#define INIT_DBREF_COUNT(X) (X)->ref_count = 0 -#define INC_DBREF_COUNT(X) (X)->ref_count++ -#define DEC_DBREF_COUNT(X) (X)->ref_count-- -#define DBREF_IN_USE(X) ((X)->ref_count != 0) -#else -#define INIT_DBREF_COUNT(X) -#define INC_DBREF_COUNT(X) -#define DEC_DBREF_COUNT(X) -#define DBREF_IN_USE(X) ((X)->Flags & InUseMask) -#endif - -typedef DBStruct *DBRef; - -/* extern Functor FunctorDBRef; */ - -inline EXTERN int IsDBRefTerm (Term); - -inline EXTERN int -IsDBRefTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef); -} - - - -inline EXTERN Term MkDBRefTerm (DBRef); - -inline EXTERN Term -MkDBRefTerm (DBRef p) -{ - return (Term) ((AbsAppl (((CELL *) (p))))); -} - - - -inline EXTERN DBRef DBRefOfTerm (Term t); - -inline EXTERN DBRef -DBRefOfTerm (Term t) -{ - return (DBRef) (((DBRef) (RepAppl (t)))); -} - - - - -inline EXTERN int IsRefTerm (Term); - -inline EXTERN int -IsRefTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDBRef); -} - - - -inline EXTERN CODEADDR RefOfTerm (Term t); - -inline EXTERN CODEADDR -RefOfTerm (Term t) -{ - return (CODEADDR) (DBRefOfTerm (t)); -} - - - -typedef struct struct_dbentry -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfDB; /* kind of property */ - Functor FunctorOfDB; /* functor for this property */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t DBRWLock; /* a simple lock to protect this entry */ -#endif - DBRef First; /* first DBase entry */ - DBRef Last; /* last DBase entry */ - SMALLUNSGN ModuleOfDB; /* module for this definition */ -#ifdef KEEP_ENTRY_AGE - Int age; /* age counter */ -#else - DBRef FirstNEr; /* first non-erased DBase entry */ -#endif /* KEEP_ENTRY_AGE */ -} -DBEntry; -typedef DBEntry *DBProp; -#define DBProperty ((PropFlags)0x8000) - -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfDB; /* kind of property */ - Functor FunctorOfDB; /* functor for this property */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t DBRWLock; /* a simple lock to protect this entry */ -#endif - DBRef First; /* first DBase entry */ - DBRef Last; /* last DBase entry */ - SMALLUNSGN ModuleOfDB; /* module for this definition */ - Int NOfEntries; /* age counter */ - DBRef Index; /* age counter */ -} -LogUpdDBEntry; -typedef LogUpdDBEntry *LogUpdDBProp; -#define LogUpdDBBit 0x1 -#define CodeDBBit 0x2 - -#define LogUpdDBProperty ((PropFlags)(0x8000|LogUpdDBBit)) -#define CodeLogUpdDBProperty (DBProperty|LogUpdDBBit|CodeDBBit) -#define CodeDBProperty (DBProperty|CodeDBBit) - - -inline EXTERN PropFlags IsDBProperty (int); - -inline EXTERN PropFlags -IsDBProperty (int flags) -{ - return (PropFlags) (((flags & ~(LogUpdDBBit | CodeDBBit)) == DBProperty)); -} - - - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN DBProp RepDBProp (Prop p); - -inline EXTERN DBProp -RepDBProp (Prop p) -{ - return (DBProp) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsDBProp (DBProp p); - -inline EXTERN Prop -AbsDBProp (DBProp p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN DBProp RepDBProp (Prop p); - -inline EXTERN DBProp -RepDBProp (Prop p) -{ - return (DBProp) (p); -} - - - -inline EXTERN Prop AbsDBProp (DBProp p); - -inline EXTERN Prop -AbsDBProp (DBProp p) -{ - return (Prop) (p); -} - - -#endif - - -/* These are the actual flags for DataBase terms */ -typedef enum -{ - DBAtomic = 0x1, - DBVar = 0x2, - DBNoVars = 0x4, - DBComplex = 0x8, - DBCode = 0x10, - DBNoCode = 0x20, - DBWithRefs = 0x40 -} -db_term_flags; - -#define MaxModules 255 - -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Atom KeyOfBB; /* functor for this property */ - DBRef Element; /* blackboard element */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t BBRWLock; /* a read-write lock to protect the entry */ -#endif - SMALLUNSGN ModuleOfBB; /* module for this definition */ -} -BlackBoardEntry; -typedef BlackBoardEntry *BBProp; - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN BlackBoardEntry *RepBBProp (Prop p); - -inline EXTERN BlackBoardEntry * -RepBBProp (Prop p) -{ - return (BlackBoardEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsBBProp (BlackBoardEntry * p); - -inline EXTERN Prop -AbsBBProp (BlackBoardEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN BlackBoardEntry *RepBBProp (Prop p); - -inline EXTERN BlackBoardEntry * -RepBBProp (Prop p) -{ - return (BlackBoardEntry *) (p); -} - - - -inline EXTERN Prop AbsBBProp (BlackBoardEntry * p); - -inline EXTERN Prop -AbsBBProp (BlackBoardEntry * p) -{ - return (Prop) (p); -} - - -#endif - -#define BBProperty ((PropFlags)0xfffb) - - -inline EXTERN PropFlags IsBBProperty (int); - -inline EXTERN PropFlags -IsBBProperty (int flags) -{ - return (PropFlags) ((flags == BBProperty)); -} - - - - -/* array property entry structure */ -/* first case is for dynamic arrays */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Int ArrayEArity; /* Arity of Array (positive) */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t ArRWLock; /* a read-write lock to protect the entry */ -#endif - Term ValueOfVE; /* Pointer to the actual array */ -} -ArrayEntry; - -/* second case is for static arrays */ - -/* first, the valid types */ -typedef enum -{ - array_of_ints, - array_of_chars, - array_of_uchars, - array_of_doubles, - array_of_ptrs, - array_of_atoms, - array_of_dbrefs, - array_of_terms -} -static_array_types; - -typedef union -{ - Int *ints; - char *chars; - unsigned char *uchars; - Float *floats; - AtomEntry **ptrs; - Term *atoms; - Term *dbrefs; - DBRef *terms; -} -statarray_elements; - -/* next, the actual data structure */ -typedef struct -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - Int ArrayEArity; /* Arity of Array (negative) */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t ArRWLock; /* a read-write lock to protect the entry */ -#endif - static_array_types ArrayType; /* Type of Array Elements. */ - statarray_elements ValueOfVE; /* Pointer to the Array itself */ -} -StaticArrayEntry; - - -#if USE_OFFSETS_IN_PROPS - -inline EXTERN ArrayEntry *RepArrayProp (Prop p); - -inline EXTERN ArrayEntry * -RepArrayProp (Prop p) -{ - return (ArrayEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsArrayProp (ArrayEntry * p); - -inline EXTERN Prop -AbsArrayProp (ArrayEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - - -inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p); - -inline EXTERN StaticArrayEntry * -RepStaticArrayProp (Prop p) -{ - return (StaticArrayEntry *) (AtomBase + Unsigned (p)); -} - - - -inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p); - -inline EXTERN Prop -AbsStaticArrayProp (StaticArrayEntry * p) -{ - return (Prop) (Addr (p) - AtomBase); -} - - -#else - -inline EXTERN ArrayEntry *RepArrayProp (Prop p); - -inline EXTERN ArrayEntry * -RepArrayProp (Prop p) -{ - return (ArrayEntry *) (p); -} - - - -inline EXTERN Prop AbsArrayProp (ArrayEntry * p); - -inline EXTERN Prop -AbsArrayProp (ArrayEntry * p) -{ - return (Prop) (p); -} - - - -inline EXTERN StaticArrayEntry *RepStaticArrayProp (Prop p); - -inline EXTERN StaticArrayEntry * -RepStaticArrayProp (Prop p) -{ - return (StaticArrayEntry *) (p); -} - - - -inline EXTERN Prop AbsStaticArrayProp (StaticArrayEntry * p); - -inline EXTERN Prop -AbsStaticArrayProp (StaticArrayEntry * p) -{ - return (Prop) (p); -} - - -#endif -#define ArrayProperty ((PropFlags)0xfff7) - - -inline EXTERN int ArrayIsDynamic (ArrayEntry *); - -inline EXTERN int -ArrayIsDynamic (ArrayEntry * are) -{ - return (int) (((are)->ArrayEArity > 0)); -} - - - - -inline EXTERN PropFlags IsArrayProperty (int); - -inline EXTERN PropFlags -IsArrayProperty (int flags) -{ - return (PropFlags) ((flags == ArrayProperty)); -} - - - -/* Proto types */ - -/* cdmgr.c */ -int STD_PROTO (RemoveIndexation, (PredEntry *)); - -/* dbase.c */ -void STD_PROTO (ErDBE, (DBRef)); -DBRef STD_PROTO (StoreTermInDB, (Term, int)); -Term STD_PROTO (FetchTermFromDB, (DBRef, int)); -void STD_PROTO (ReleaseTermFromDB, (DBRef)); - -/* .c */ -CODEADDR STD_PROTO (PredIsIndexable, (PredEntry *)); - -/* init.c */ -Atom STD_PROTO (GetOp, (OpEntry *, int *, int)); - -/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */ -Prop STD_PROTO (GetAProp, (Atom, PropFlags)); -Prop STD_PROTO (GetAPropHavingLock, (AtomEntry *, PropFlags)); - -EXTERN inline Prop -PredPropByFunc (Functor f, SMALLUNSGN cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - FunctorEntry *fe = (FunctorEntry *) f; - - WRITE_LOCK (fe->FRWLock); - p0 = fe->PropsOfFE; - while (p0) - { - PredEntry *p = RepPredProp (p0); - if ( /* p->KindOfPE != 0 || only props */ - (p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) - { - WRITE_UNLOCK (f->FRWLock); - return (p0); - } - p0 = p->NextOfPE; - } - return (NewPredPropByFunctor (fe, cur_mod)); -} - -EXTERN inline Prop -PredPropByAtom (Atom at, SMALLUNSGN cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - AtomEntry *ae = RepAtom (at); - - WRITE_LOCK (ae->ARWLock); - p0 = ae->PropsOfAE; - while (p0) - { - PredEntry *pe = RepPredProp (p0); - if (pe->KindOfPE == PEProp && - (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) - { - WRITE_UNLOCK (ae->ARWLock); - return (p0); - } - p0 = pe->NextOfPE; - } - return (NewPredPropByAtom (ae, cur_mod)); -} - -#if defined(YAPOR) || defined(THREADS) -void STD_PROTO (ReleasePreAllocCodeSpace, (ADDR)); -#else -#define ReleasePreAllocCodeSpace(x) -#endif + + + + + + + +/************************************************************************* +* * +* 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: YAtom.h.m4 * +* Last rev: 19/2/88 * +* mods: * +* comments: atom properties header file for YAP * +* * +*************************************************************************/ + +/* This code can only be defined *after* including Regs.h!!! */ + +#if USE_OFFSETS + +inline EXTERN Atom AbsAtom(AtomEntry * p); + +inline EXTERN Atom AbsAtom(AtomEntry * p) +{ + return (Atom) (Addr(p) - AtomBase); +} + + + +inline EXTERN AtomEntry * RepAtom(Atom a); + +inline EXTERN AtomEntry * RepAtom(Atom a) +{ + return (AtomEntry *) (AtomBase + Unsigned(a)); +} + + +#else + +inline EXTERN Atom AbsAtom(AtomEntry * p); + +inline EXTERN Atom AbsAtom(AtomEntry * p) +{ + return (Atom) (p); +} + + + +inline EXTERN AtomEntry * RepAtom(Atom a); + +inline EXTERN AtomEntry * RepAtom(Atom a) +{ + return (AtomEntry *) (a); +} + + +#endif + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN Prop AbsProp(PropEntry * p); + +inline EXTERN Prop AbsProp(PropEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + + +inline EXTERN PropEntry * RepProp(Prop p); + +inline EXTERN PropEntry * RepProp(Prop p) +{ + return (PropEntry *) (AtomBase+Unsigned(p)); +} + + +#else + +inline EXTERN Prop AbsProp(PropEntry * p); + +inline EXTERN Prop AbsProp(PropEntry * p) +{ + return (Prop) (p); +} + + + +inline EXTERN PropEntry * RepProp(Prop p); + +inline EXTERN PropEntry * RepProp(Prop p) +{ + return (PropEntry *) (p); +} + + +#endif + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN FunctorEntry * RepFunctorProp(Prop p); + +inline EXTERN FunctorEntry * RepFunctorProp(Prop p) +{ + return (FunctorEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsFunctorProp(FunctorEntry * p); + +inline EXTERN Prop AbsFunctorProp(FunctorEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN FunctorEntry * RepFunctorProp(Prop p); + +inline EXTERN FunctorEntry * RepFunctorProp(Prop p) +{ + return (FunctorEntry *) (p); +} + + + +inline EXTERN Prop AbsFunctorProp(FunctorEntry * p); + +inline EXTERN Prop AbsFunctorProp(FunctorEntry * p) +{ + return (Prop) (p); +} + + +#endif + + +inline EXTERN Int ArityOfFunctor(Functor); + +inline EXTERN Int ArityOfFunctor(Functor Fun) +{ + return (Int) (((FunctorEntry *)Fun)->ArityOfFE); +} + + + +inline EXTERN Atom NameOfFunctor(Functor); + +inline EXTERN Atom NameOfFunctor(Functor Fun) +{ + return (Atom) (((FunctorEntry *)Fun)->NameOfFE); +} + + + + +inline EXTERN PropFlags IsFunctorProperty(int); + +inline EXTERN PropFlags IsFunctorProperty(int flags) +{ + return (PropFlags) ((flags == FunctorProperty) ); +} + + + +/* summary of property codes used + + 00 00 predicate entry + 80 00 db property + bb 00 functor entry + ff df sparse functor + ff ex arithmetic property + ff f7 array + ff fa module property + ff fb blackboard property + ff fc value property + ff ff op property +*/ + +/* Module property */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + SMALLUNSGN IndexOfMod; /* indec in module table */ +} ModEntry; + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN ModEntry * RepModProp(Prop p); + +inline EXTERN ModEntry * RepModProp(Prop p) +{ + return (ModEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsModProp(ModEntry * p); + +inline EXTERN Prop AbsModProp(ModEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN ModEntry * RepModProp(Prop p); + +inline EXTERN ModEntry * RepModProp(Prop p) +{ + return (ModEntry *) (p); +} + + + +inline EXTERN Prop AbsModProp(ModEntry * p); + +inline EXTERN Prop AbsModProp(ModEntry * p) +{ + return (Prop) (p); +} + + +#endif + +#define ModProperty ((PropFlags)0xfffa) + + +inline EXTERN PropFlags IsModProperty(int); + +inline EXTERN PropFlags IsModProperty(int flags) +{ + return (PropFlags) ((flags == ModProperty)); +} + + + +/* operator property entry structure */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t OpRWLock; /* a read-write lock to protect the entry */ +#endif + BITS16 Prefix, Infix, Posfix; /* precedences */ + } OpEntry; +#if USE_OFFSETS_IN_PROPS + +inline EXTERN OpEntry * RepOpProp(Prop p); + +inline EXTERN OpEntry * RepOpProp(Prop p) +{ + return (OpEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsOpProp(OpEntry * p); + +inline EXTERN Prop AbsOpProp(OpEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN OpEntry * RepOpProp(Prop p); + +inline EXTERN OpEntry * RepOpProp(Prop p) +{ + return (OpEntry *) (p); +} + + + +inline EXTERN Prop AbsOpProp(OpEntry * p); + +inline EXTERN Prop AbsOpProp(OpEntry * p) +{ + return (Prop) (p); +} + + +#endif +#define OpProperty ((PropFlags)0xffff) + + +inline EXTERN PropFlags IsOpProperty(int); + +inline EXTERN PropFlags IsOpProperty(int flags) +{ + return (PropFlags) ((flags == OpProperty) ); +} + + + +/* defines related to operator specifications */ +#define MaskPrio 0x0fff +#define DcrlpFlag 0x1000 +#define DcrrpFlag 0x2000 + +typedef union arith_ret *eval_ret; + +/* expression property entry structure */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfEE; + BITS16 ENoOfEE; + BITS16 FlagsOfEE; + /* operations that implement the expression */ + union { + blob_type (*constant)(eval_ret); + blob_type (*unary)(Term, eval_ret); + blob_type (*binary)(Term, Term, eval_ret); + } FOfEE; +} ExpEntry; +#if USE_OFFSETS_IN_PROPS + +inline EXTERN ExpEntry * RepExpProp(Prop p); + +inline EXTERN ExpEntry * RepExpProp(Prop p) +{ + return (ExpEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsExpProp(ExpEntry * p); + +inline EXTERN Prop AbsExpProp(ExpEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN ExpEntry * RepExpProp(Prop p); + +inline EXTERN ExpEntry * RepExpProp(Prop p) +{ + return (ExpEntry *) (p); +} + + + +inline EXTERN Prop AbsExpProp(ExpEntry * p); + +inline EXTERN Prop AbsExpProp(ExpEntry * p) +{ + return (Prop) (p); +} + + +#endif +#define ExpProperty 0xffe0 + +/* only unary and binary expressions are acceptable */ + +inline EXTERN PropFlags IsExpProperty(int); + +inline EXTERN PropFlags IsExpProperty(int flags) +{ + return (PropFlags) ((flags == ExpProperty) ); +} + + + + +/* value property entry structure */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t VRWLock; /* a read-write lock to protect the entry */ +#endif + Term ValueOfVE; /* (atomic) value associated with the atom */ + } ValEntry; +#if USE_OFFSETS_IN_PROPS + +inline EXTERN ValEntry * RepValProp(Prop p); + +inline EXTERN ValEntry * RepValProp(Prop p) +{ + return (ValEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsValProp(ValEntry * p); + +inline EXTERN Prop AbsValProp(ValEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN ValEntry * RepValProp(Prop p); + +inline EXTERN ValEntry * RepValProp(Prop p) +{ + return (ValEntry *) (p); +} + + + +inline EXTERN Prop AbsValProp(ValEntry * p); + +inline EXTERN Prop AbsValProp(ValEntry * p) +{ + return (Prop) (p); +} + + +#endif +#define ValProperty ((PropFlags)0xfffc) + + +inline EXTERN PropFlags IsValProperty(int); + +inline EXTERN PropFlags IsValProperty(int flags) +{ + return (PropFlags) ((flags == ValProperty) ); +} + + + +/* predicate property entry structure */ +/* AsmPreds are things like var, nonvar, atom ...which are implemented + through dedicated machine instructions. In this case the 8 lower + bits of PredFlags are used to hold the machine instruction code + for the pred. + C_Preds are things write, read, ... implemented in C. In this case + CodeOfPred holds the address of the correspondent C-function. +*/ +typedef enum { + CArgsPredFlag = 0x1000000L, /* ! should ! across */ + CutTransparentPredFlag = 0x800000L, /* ! should ! across */ + SourcePredFlag = 0x400000L, /* static predicate with source declaration */ + MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */ + SyncPredFlag = 0x100000L, /* has to synch before it can execute*/ + UserCPredFlag = 0x080000L, /* CPred defined by the user */ + MultiFileFlag = 0x040000L, /* is multi-file */ + FastPredFlag = 0x020000L, /* is "compiled" */ + TestPredFlag = 0x010000L, /* is a test (optim. comit) */ + AsmPredFlag = 0x008000L, /* inline */ + StandardPredFlag= 0x004000L, /* system predicate */ + DynamicPredFlag= 0x002000L, /* dynamic predicate */ + CPredFlag = 0x001000L, /* written in C */ + SafePredFlag = 0x000800L, /* does not alter arguments */ + CompiledPredFlag= 0x000400L, /* is static */ + IndexedPredFlag= 0x000200L, /* has indexing code */ + SpiedPredFlag = 0x000100L, /* is a spy point */ + BinaryTestPredFlag=0x000080L, /* test predicate. */ +#ifdef TABLING + TabledPredFlag = 0x000040L, /* is tabled */ +#endif /* TABLING */ +#ifdef YAPOR + SequentialPredFlag=0x000020L, /* may not create par. choice points!*/ +#endif /* YAPOR */ + ProfiledPredFlag = 0x000010L, /* pred is being profiled */ + LogUpdatePredFlag= 0x000008L /* dynamic predicate with log. upd. sem.*/ +} pred_flag; + +/* profile data */ +typedef struct { +#if defined(YAPOR) || defined(THREADS) + lockvar lock; /* a simple lock to protect this entry */ +#endif + Int NOfEntries; /* nbr of times head unification succeeded*/ + Int NOfHeadSuccesses; /* nbr of times head unification succeeded*/ + Int NOfRetries; /* nbr of times a clause for the pred + was retried */ +} profile_data; + +typedef struct pred_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfPE; /* arity of property */ + CELL PredFlags; + CODEADDR CodeOfPred; /* code address */ + CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ + Functor FunctorOfPred; /* functor for Predicate */ + CODEADDR FirstClause, LastClause; + Atom OwnerFile; /* File where the predicate was defined */ + struct pred_entry *NextPredOfModule; /* next pred for same module */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t PRWLock; /* a simple lock to protect this entry */ +#endif +#ifdef TABLING + tab_ent_ptr TableOfPred; +#endif /* TABLING */ + SMALLUNSGN ModuleOfPred; /* module for this definition */ + OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ + profile_data StatisticsForPred; /* enable profiling for predicate */ + SMALLUNSGN StateOfPred; /* actual state of predicate */ +} PredEntry; +#define PEProp ((PropFlags)(0x0000)) + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN PredEntry * RepPredProp(Prop p); + +inline EXTERN PredEntry * RepPredProp(Prop p) +{ + return (PredEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsPredProp(PredEntry * p); + +inline EXTERN Prop AbsPredProp(PredEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN PredEntry * RepPredProp(Prop p); + +inline EXTERN PredEntry * RepPredProp(Prop p) +{ + return (PredEntry *) (p); +} + + + +inline EXTERN Prop AbsPredProp(PredEntry * p); + +inline EXTERN Prop AbsPredProp(PredEntry * p) +{ + return (Prop) (p); +} + + +#endif + + +inline EXTERN PropFlags IsPredProperty(int); + +inline EXTERN PropFlags IsPredProperty(int flags) +{ + return (PropFlags) ((flags == PEProp) ); +} + + + +/********* maximum number of C-written predicates and cmp funcs ******************/ + +#define MAX_C_PREDS 360 +#define MAX_CMP_FUNCS 20 + +typedef struct { + PredEntry *p; + CmpPredicate f; +} cmp_entry; + +extern CPredicate c_predicates[MAX_C_PREDS]; +extern cmp_entry cmp_funcs[MAX_CMP_FUNCS]; + + +/* Flags for code or dbase entry */ +/* There are several flags for code and data base entries */ +typedef enum { + GcFoundMask = 0x10000, /* informs this is a dynamic predicate */ + DynamicMask = 0x8000, /* informs this is a dynamic predicate */ + InUseMask = 0x4000, /* informs this block is being used */ + ErasedMask = 0x2000, /* informs this block has been erased */ + IndexMask = 0x1000, /* informs this is indexing code */ + DBClMask = 0x0800, /* informs this is a data base structure */ + LogUpdRuleMask= 0x0400, /* informs the code is for a log upd rule with env */ + LogUpdMask = 0x0200, /* informs this is a logic update index. */ + StaticMask = 0x0100, /* dealing with static predicates */ + SpiedMask = 0x0080 /* this predicate is being spied */ +/* other flags belong to DB */ +} dbentry_flags; + +/* *********************** DBrefs **************************************/ + +#define KEEP_ENTRY_AGE 1 + +typedef struct DB_STRUCT { + Functor id; /* allow pointers to this struct to id */ + /* as dbref */ + Term EntryTerm; /* cell bound to itself */ + SMALLUNSGN Flags; /* Term Flags */ + SMALLUNSGN NOfRefsTo; /* Number of references pointing here */ + struct struct_dbentry *Parent; /* key of DBase reference */ + CODEADDR Code; /* pointer to code if this is a clause */ + struct DB_STRUCT **DBRefs; /* pointer to other references */ + struct DB_STRUCT *Prev; /* Previous element in chain */ + struct DB_STRUCT *Next; /* Next element in chain */ +#if defined(YAPOR) || defined(THREADS) + lockvar lock; /* a simple lock to protect this entry */ + Int ref_count; /* how many branches are using this entry */ +#endif +#ifdef KEEP_ENTRY_AGE + Int age; /* entry's age, negative if from recorda, + positive if it was recordz */ +#endif /* KEEP_ENTRY_AGE */ +#ifdef COROUTINING + CELL attachments; /* attached terms */ +#endif + CELL Mask; /* parts that should be cleared */ + CELL Key; /* A mask that can be used to check before + you unify */ + CELL NOfCells; /* Size of Term */ + CELL Entry; /* entry point */ + Term Contents[MIN_ARRAY]; /* stored term */ +} DBStruct; + +#define DBStructFlagsToDBStruct(X) ((DBRef)((X) - (CELL) &(((DBRef) NIL)->Flags))) + +#if defined(YAPOR) || defined(THREADS) +#define INIT_DBREF_COUNT(X) (X)->ref_count = 0 +#define INC_DBREF_COUNT(X) (X)->ref_count++ +#define DEC_DBREF_COUNT(X) (X)->ref_count-- +#define DBREF_IN_USE(X) ((X)->ref_count != 0) +#else +#define INIT_DBREF_COUNT(X) +#define INC_DBREF_COUNT(X) +#define DEC_DBREF_COUNT(X) +#define DBREF_IN_USE(X) ((X)->Flags & InUseMask) +#endif + +typedef DBStruct *DBRef; + +/* extern Functor FunctorDBRef; */ + +inline EXTERN int IsDBRefTerm(Term); + +inline EXTERN int IsDBRefTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorDBRef); +} + + + +inline EXTERN Term MkDBRefTerm(DBRef); + +inline EXTERN Term MkDBRefTerm(DBRef p) +{ + return (Term) ((AbsAppl(((CELL *)(p))))); +} + + + +inline EXTERN DBRef DBRefOfTerm(Term t); + +inline EXTERN DBRef DBRefOfTerm(Term t) +{ + return (DBRef) (((DBRef)(RepAppl(t)))); +} + + + + +inline EXTERN int IsRefTerm(Term); + +inline EXTERN int IsRefTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorDBRef); +} + + + +inline EXTERN CODEADDR RefOfTerm(Term t); + +inline EXTERN CODEADDR RefOfTerm(Term t) +{ + return (CODEADDR) (DBRefOfTerm(t)); +} + + + +typedef struct struct_dbentry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfDB; /* kind of property */ + Functor FunctorOfDB; /* functor for this property */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t DBRWLock; /* a simple lock to protect this entry */ +#endif + DBRef First; /* first DBase entry */ + DBRef Last; /* last DBase entry */ + SMALLUNSGN ModuleOfDB; /* module for this definition */ +#ifdef KEEP_ENTRY_AGE + Int age; /* age counter */ +#else + DBRef FirstNEr; /* first non-erased DBase entry */ +#endif /* KEEP_ENTRY_AGE */ +} DBEntry; +typedef DBEntry *DBProp; +#define DBProperty ((PropFlags)0x8000) + +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfDB; /* kind of property */ + Functor FunctorOfDB; /* functor for this property */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t DBRWLock; /* a simple lock to protect this entry */ +#endif + DBRef First; /* first DBase entry */ + DBRef Last; /* last DBase entry */ + SMALLUNSGN ModuleOfDB; /* module for this definition */ + Int NOfEntries; /* age counter */ + DBRef Index; /* age counter */ +} LogUpdDBEntry; +typedef LogUpdDBEntry *LogUpdDBProp; +#define LogUpdDBBit 0x1 +#define CodeDBBit 0x2 + +#define LogUpdDBProperty ((PropFlags)(0x8000|LogUpdDBBit)) +#define CodeLogUpdDBProperty (DBProperty|LogUpdDBBit|CodeDBBit) +#define CodeDBProperty (DBProperty|CodeDBBit) + + +inline EXTERN PropFlags IsDBProperty(int); + +inline EXTERN PropFlags IsDBProperty(int flags) +{ + return (PropFlags) (((flags & ~(LogUpdDBBit|CodeDBBit)) == DBProperty) ); +} + + + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN DBProp RepDBProp(Prop p); + +inline EXTERN DBProp RepDBProp(Prop p) +{ + return (DBProp) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsDBProp(DBProp p); + +inline EXTERN Prop AbsDBProp(DBProp p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN DBProp RepDBProp(Prop p); + +inline EXTERN DBProp RepDBProp(Prop p) +{ + return (DBProp) (p); +} + + + +inline EXTERN Prop AbsDBProp(DBProp p); + +inline EXTERN Prop AbsDBProp(DBProp p) +{ + return (Prop) (p); +} + + +#endif + + +/* These are the actual flags for DataBase terms */ +typedef enum { + DBAtomic = 0x1, + DBVar = 0x2, + DBNoVars = 0x4, + DBComplex = 0x8, + DBCode = 0x10, + DBNoCode = 0x20, + DBWithRefs = 0x40 +} db_term_flags; + +#define MaxModules 256 + +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Atom KeyOfBB; /* functor for this property */ + DBRef Element; /* blackboard element */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t BBRWLock; /* a read-write lock to protect the entry */ +#endif + SMALLUNSGN ModuleOfBB; /* module for this definition */ +} BlackBoardEntry; +typedef BlackBoardEntry *BBProp; + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN BlackBoardEntry * RepBBProp(Prop p); + +inline EXTERN BlackBoardEntry * RepBBProp(Prop p) +{ + return (BlackBoardEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsBBProp(BlackBoardEntry * p); + +inline EXTERN Prop AbsBBProp(BlackBoardEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN BlackBoardEntry * RepBBProp(Prop p); + +inline EXTERN BlackBoardEntry * RepBBProp(Prop p) +{ + return (BlackBoardEntry *) (p); +} + + + +inline EXTERN Prop AbsBBProp(BlackBoardEntry * p); + +inline EXTERN Prop AbsBBProp(BlackBoardEntry * p) +{ + return (Prop) (p); +} + + +#endif + +#define BBProperty ((PropFlags)0xfffb) + + +inline EXTERN PropFlags IsBBProperty(int); + +inline EXTERN PropFlags IsBBProperty(int flags) +{ + return (PropFlags) ((flags == BBProperty)); +} + + + + +/* array property entry structure */ +/* first case is for dynamic arrays */ +typedef struct array_entry { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Int ArrayEArity; /* Arity of Array (positive) */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t ArRWLock; /* a read-write lock to protect the entry */ +#endif + struct array_entry *NextArrayE; /* Pointer to the actual array */ + Term ValueOfVE; /* Pointer to the actual array */ +} ArrayEntry; + +/* second case is for static arrays */ + +/* first, the valid types */ +typedef enum { + array_of_ints, + array_of_chars, + array_of_uchars, + array_of_doubles, + array_of_ptrs, + array_of_atoms, + array_of_dbrefs, + array_of_terms +} static_array_types; + +typedef union { + Int *ints; + char *chars; + unsigned char *uchars; + Float *floats; + AtomEntry **ptrs; + Term *atoms; + Term *dbrefs; + DBRef *terms; +} statarray_elements; + +/* next, the actual data structure */ +typedef struct { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + Int ArrayEArity; /* Arity of Array (negative) */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t ArRWLock; /* a read-write lock to protect the entry */ +#endif + static_array_types ArrayType; /* Type of Array Elements. */ + statarray_elements ValueOfVE; /* Pointer to the Array itself */ +} StaticArrayEntry; + + +#if USE_OFFSETS_IN_PROPS + +inline EXTERN ArrayEntry * RepArrayProp(Prop p); + +inline EXTERN ArrayEntry * RepArrayProp(Prop p) +{ + return (ArrayEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsArrayProp(ArrayEntry * p); + +inline EXTERN Prop AbsArrayProp(ArrayEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + + +inline EXTERN StaticArrayEntry * RepStaticArrayProp(Prop p); + +inline EXTERN StaticArrayEntry * RepStaticArrayProp(Prop p) +{ + return (StaticArrayEntry *) (AtomBase + Unsigned(p)); +} + + + +inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry * p); + +inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry * p) +{ + return (Prop) (Addr(p)-AtomBase); +} + + +#else + +inline EXTERN ArrayEntry * RepArrayProp(Prop p); + +inline EXTERN ArrayEntry * RepArrayProp(Prop p) +{ + return (ArrayEntry *) (p); +} + + + +inline EXTERN Prop AbsArrayProp(ArrayEntry * p); + +inline EXTERN Prop AbsArrayProp(ArrayEntry * p) +{ + return (Prop) (p); +} + + + +inline EXTERN StaticArrayEntry * RepStaticArrayProp(Prop p); + +inline EXTERN StaticArrayEntry * RepStaticArrayProp(Prop p) +{ + return (StaticArrayEntry *) (p); +} + + + +inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry * p); + +inline EXTERN Prop AbsStaticArrayProp(StaticArrayEntry * p) +{ + return (Prop) (p); +} + + +#endif +#define ArrayProperty ((PropFlags)0xfff7) + + +inline EXTERN int ArrayIsDynamic(ArrayEntry *); + +inline EXTERN int ArrayIsDynamic(ArrayEntry * are) +{ + return (int) (((are)->ArrayEArity > 0 )); +} + + + + +inline EXTERN PropFlags IsArrayProperty(int); + +inline EXTERN PropFlags IsArrayProperty(int flags) +{ + return (PropFlags) ((flags == ArrayProperty) ); +} + + + +/* Proto types */ + +/* cdmgr.c */ +int STD_PROTO(RemoveIndexation,(PredEntry *)); + +/* dbase.c */ +void STD_PROTO(ErDBE,(DBRef)); +DBRef STD_PROTO(StoreTermInDB,(int,int)); +Term STD_PROTO(FetchTermFromDB,(DBRef,int)); +void STD_PROTO(ReleaseTermFromDB,(DBRef)); + +/* .c */ +CODEADDR STD_PROTO(PredIsIndexable,(PredEntry *)); + +/* init.c */ +Atom STD_PROTO(GetOp,(OpEntry *,int *,int)); + +/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */ +Prop STD_PROTO(GetAProp,(Atom,PropFlags)); +Prop STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags)); + +EXTERN inline Prop +PredPropByFunc(Functor f, SMALLUNSGN cur_mod) +/* get predicate entry for ap/arity; create it if neccessary. */ +{ + Prop p0; + FunctorEntry *fe = (FunctorEntry *)f; + + WRITE_LOCK(fe->FRWLock); + p0 = fe->PropsOfFE; + while (p0) { + PredEntry *p = RepPredProp(p0); + if (/* p->KindOfPE != 0 || only props */ + (p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) { + WRITE_UNLOCK(f->FRWLock); + return (p0); + } + p0 = p->NextOfPE; + } + return(NewPredPropByFunctor(fe,cur_mod)); +} + +EXTERN inline Prop +PredPropByAtom(Atom at, SMALLUNSGN cur_mod) +/* get predicate entry for ap/arity; create it if neccessary. */ +{ + Prop p0; + AtomEntry *ae = RepAtom(at); + + WRITE_LOCK(ae->ARWLock); + p0 = ae->PropsOfAE; + while (p0) { + PredEntry *pe = RepPredProp(p0); + if ( pe->KindOfPE == PEProp && + (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { + WRITE_UNLOCK(ae->ARWLock); + return(p0); + } + p0 = pe->NextOfPE; + } + return(NewPredPropByAtom(ae,cur_mod)); +} + +#if defined(YAPOR) || defined(THREADS) +void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR)); +#else +#define ReleasePreAllocCodeSpace(x) +#endif diff --git a/VC/include/sshift.h b/VC/include/sshift.h index 530621c94..1a85d08a6 100644 --- a/VC/include/sshift.h +++ b/VC/include/sshift.h @@ -228,15 +228,6 @@ inline EXTERN Atom AtomAdjust(Atom at) -inline EXTERN Term AtomTermAdjust(Term); - -inline EXTERN Term AtomTermAdjust(Term at) -{ - return (Term) ((at) ); -} - - - inline EXTERN Prop PropAdjust(Prop); inline EXTERN Prop PropAdjust(Prop p) @@ -251,11 +242,20 @@ inline EXTERN Atom AtomAdjust(Atom); inline EXTERN Atom AtomAdjust(Atom at) { - return (Atom) ((Atom)(CharP(at)+HDiff) ); + return (Atom) ((at == NULL ? (at) : (Atom)(CharP(at)+HDiff) )); } -#if MMAP_ADDR >= 0x40000000 + +inline EXTERN Prop PropAdjust(Prop); + +inline EXTERN Prop PropAdjust(Prop p) +{ + return (Prop) ((p == NULL ? (p) : (Prop)(CharP(p)+HDiff)) ); +} + + +#endif inline EXTERN Term AtomTermAdjust(Term); @@ -265,27 +265,6 @@ inline EXTERN Term AtomTermAdjust(Term at) } -#else - -inline EXTERN Term AtomTermAdjust(Term); - -inline EXTERN Term AtomTermAdjust(Term at) -{ - return (Term) (MkAtomTerm((Atom)(CharP(AtomOfTerm(at)+HDiff))) ); -} - - -#endif - -inline EXTERN Prop PropAdjust(Prop); - -inline EXTERN Prop PropAdjust(Prop p) -{ - return (Prop) ((Prop)(CharP(p)+HDiff) ); -} - - -#endif #if TAGS_FAST_OPS inline EXTERN Term BlobTermAdjust(Term); @@ -393,7 +372,16 @@ inline EXTERN PredEntry * PtoPredAdjust(PredEntry *); inline EXTERN PredEntry * PtoPredAdjust(PredEntry * ptr) { - return (PredEntry *) (((CELL *)(CharP(ptr) + HDiff)) ); + return (PredEntry *) (((PredEntry *)(CharP(ptr) + HDiff)) ); +} + + + +inline EXTERN ArrayEntry * PtoArrayEAdjust(ArrayEntry *); + +inline EXTERN ArrayEntry * PtoArrayEAdjust(ArrayEntry * ptr) +{ + return (ArrayEntry *) (((ArrayEntry *)(CharP(ptr) + HDiff)) ); } diff --git a/distribute b/distribute index 4b33f49e4..0b9c54937 100755 --- a/distribute +++ b/distribute @@ -12,7 +12,13 @@ cd ../OPTYap splat cd ../VC splat -cd include +cd ../LGPL +splat +cd pillow +splat +cd examples +splat +cd ../../../include splat /bin/cp config.h config.h.mine /bin/cp ../../../bins/cyg/*.h . diff --git a/docs/yap.tex b/docs/yap.tex index f45d07b8c..07ffd72a1 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -847,7 +847,7 @@ CC="cc -64" $YAP_SRC_PATH/configure --... @cindex booting We next describe how to invoke Yap in Unix systems. -@node Running Yap Interactively,Running Prolog Files, ,Run +@node Running Yap Interactively, ,Running Prolog Files,Run @section Running Yap Interactively Most often you will want to use Yap in interactive mode. Assuming that @@ -924,7 +924,7 @@ YAP will try to find library files from the YAPSHAREDIR/library directory. @end itemize -@node Running Prolog Files, ,Interactive Mode, Run +@node Running Prolog Files, Running Yap Interactively, , Run @section Running Prolog Files YAP can also be used to run Prolog files as scripts, at least in @@ -2473,9 +2473,9 @@ be @code{unknown}, and the second argument should be either @code{error}, @code{warning}, @code{fail}, or a goal. @item user:unknown_predicate_handler(+G,+M,?NG) -@findex user:unknown_predicate_handler/3 -@syindex user:unknown_predicate_handler/3 -@cnindex user:unknown_predicate_handler/3 +@findex unknown_predicate_handler/3 +@syindex unknown_predicate_handler/3 +@cnindex unknown_predicate_handler/3 The user may also define clauses for @code{user:unknown_predicate_handler/3} hook predicate. This user-defined procedure is called before any system processing for the @@ -5312,9 +5312,9 @@ for DCG rules is applied, together with the arithmetic optimizer whenever the compilation of arithmetic expressions is in progress. @item user:goal_expansion(+@var{G},+@var{M},-@var{NG}) -@findex user:goal_expansion/3 -@snindex user:goal_expansion/3 -@cnindex user:goal_expansion/3 +@findex goal_expansion/3 +@snindex goal_expansion/3 +@cnindex goal_expansion/3 Yap now supports @code{goal_expansion/3}. This is an user-defined procedure that is called after term expansion when compiling or asserting goals for each sub-goal in a clause. The first argument is