From eade18026c20bb10bbacf4840a24ef07b97ee913 Mon Sep 17 00:00:00 2001 From: vsc Date: Mon, 16 Jul 2001 15:26:14 +0000 Subject: [PATCH] fix fflush git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@125 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/iopreds.c | 19 +- C/save.c | 33 + C/sysbits.c | 11 +- C/tracer.c | 2 +- VC/include/Atoms.h | 222 ++-- VC/include/Tags_24bits.h | 364 +++--- VC/include/Tags_32LowTag.h | 397 +++--- VC/include/Tags_32Ops.h | 609 +++++----- VC/include/Tags_32bits.h | 372 +++--- VC/include/Tags_64bits.h | 375 +++--- VC/include/TermExt.h | 914 +++++++------- VC/include/Yap.h | 427 +++---- VC/include/Yatom.h | 2329 +++++++++++++++++------------------- VC/include/sshift.h | 1159 +++++++++--------- changes4.3.html | 2 + distribute | 4 +- pl/errors.yap | 6 +- pl/init.yap | 2 +- 18 files changed, 3521 insertions(+), 3726 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index 42856e07e..70d35f0c1 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -313,7 +313,15 @@ YP_putc(int ch, int sno) int YP_fflush(int sno) { - if (Stream[sno].status & (Null_Stream_f|InMemory_Stream_f|Socket_Stream_f|Pipe_Stream_f)) + if ( (Stream[sno].status & Output_Stream_f) && + ! (Stream[sno].status & + (Null_Stream_f| + InMemory_Stream_f| + Socket_Stream_f| + Pipe_Stream_f| + Free_Stream_f)) ) + return(fflush(Stream[sno].u.file.file)); + else return(0); return(fflush(Stream[sno].u.file.file)); } @@ -2541,7 +2549,7 @@ p_write (void) static Int p_write2 (void) -{ /* '$write'(+Flags,?Term) */ +{ /* '$write'(+Stream,+Flags,?Term) */ int old_output_stream = c_output_stream; c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2"); if (c_output_stream == -1) { @@ -4338,7 +4346,14 @@ p_flush (void) static Int p_flush_all_streams (void) { /* $flush_all_streams */ +#if BROKEN_FFLUSH_NULL + int i; + for (i = 0; i < MaxStreams; ++i) + YP_fflush (i); +#else fflush (NULL); +#endif + return (TRUE); } diff --git a/C/save.c b/C/save.c index e139831d6..0e8b1025c 100644 --- a/C/save.c +++ b/C/save.c @@ -1595,6 +1595,14 @@ RestoreClause(Clause *Cl) case _getwork: case _getwork_seq: case _sync: +#endif +#ifdef TABLING + case _table_try_me_single: + case _table_try_me: + case _table_retry_me: + case _table_trust_me: + case _table_answer_resolution: + case _table_completion: #endif pc->u.ld.p = CodeAddrAdjust(pc->u.ld.p); pc->u.ld.d = CodeAddrAdjust(pc->u.ld.d); @@ -1646,6 +1654,28 @@ RestoreClause(Clause *Cl) case _p_functor: #ifdef YAPOR case _getwork_first_time: +#endif +#ifdef TABLING + case _trie_do_var: + case _trie_trust_var: + case _trie_try_var: + case _trie_retry_var: + case _trie_do_val: + case _trie_trust_val: + case _trie_try_val: + case _trie_retry_val: + case _trie_do_atom: + case _trie_trust_atom: + case _trie_try_atom: + case _trie_retry_atom: + case _trie_do_list: + case _trie_trust_list: + case _trie_try_list: + case _trie_retry_list: + case _trie_do_struct: + case _trie_trust_struct: + case _trie_try_struct: + case _trie_retry_struct: #endif pc = NEXTOP(pc,e); break; @@ -1891,6 +1921,9 @@ RestoreClause(Clause *Cl) /* instructions type s */ case _write_n_voids: case _pop_n: +#ifdef TABLING + case _table_new_answer: +#endif pc = NEXTOP(pc,s); break; /* instructions type c */ diff --git a/C/sysbits.c b/C/sysbits.c index e16d9be77..76bfd9a78 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1473,7 +1473,8 @@ int TrueFileName (char *source, char *result, int in_lib) #if __simplescalar__ /* does not implement getcwd */ - strncpy(ares1,".",YAP_FILENAME_MAX); + char *yap_pwd = getenv("PWD"); + strncpy(ares1,yap_pwd,YAP_FILENAME_MAX); #elif HAVE_GETCWD if (getcwd (ares1, YAP_FILENAME_MAX) == NULL) return (FALSE); @@ -1562,7 +1563,8 @@ p_getcwd(void) #if __simplescalar__ /* does not implement getcwd */ - strncpy(FileNameBuf,".",YAP_FILENAME_MAX); + char *yap_pwd = getenv("PWD"); + strncpy(FileNameBuf,yap_pwd,YAP_FILENAME_MAX); #elif HAVE_GETCWD if (getcwd (FileNameBuf, YAP_FILENAME_MAX) == NULL) return (FALSE); @@ -1752,6 +1754,11 @@ p_cd (void) return(FALSE); } TrueFileName (FileNameBuf, FileNameBuf2, FALSE); +#if __simplescalar__ + strncpy(FileNameBuf,"PWD=",YAP_FILENAME_MAX); + strncat(FileNameBuf,FileNameBuf2,YAP_FILENAME_MAX); + putenv(FileNameBuf); +#endif return (!chdir (FileNameBuf2)); #else #ifdef MACYAP diff --git a/C/tracer.c b/C/tracer.c index 06b683a96..6fb88b68c 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -129,7 +129,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) extern int gc_calls; vsc_count++; - if (vsc_count < 2518) return; + /* if (vsc_count < 2518) return; */ /* if (vsc_count > 500000) exit(0); */ /* if (gc_calls < 1) return;*/ YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H); diff --git a/VC/include/Atoms.h b/VC/include/Atoms.h index 853a3d60c..ece8b640a 100755 --- a/VC/include/Atoms.h +++ b/VC/include/Atoms.h @@ -1,113 +1,109 @@ - - - - - - - -/************************************************************************* -* * -* 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 PropOfAE; /* 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 */ -} -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 PropOfAE; /* 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 */ +} FunctorEntry; + +typedef FunctorEntry *Functor; + diff --git a/VC/include/Tags_24bits.h b/VC/include/Tags_24bits.h index b0937cbe8..1ccd3c4bf 100644 --- a/VC/include/Tags_24bits.h +++ b/VC/include/Tags_24bits.h @@ -1,187 +1,177 @@ - - - - - - - -/************************************************************************* -* * -* 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: Tags_24bits.h.m4 * -* Last rev: December 90 * -* mods: * -* comments: Tag Scheme for machines with 24 bits adresses (m68000) * -* version: $Id: Tags_24bits.h,v 1.1.1.1 2001-04-09 19:53:40 vsc Exp $ * -*************************************************************************/ - - /* Version for 24 bit addresses (68000) - Each term is represented internally as an unsigned 32 bit integer as - follows: - tag value - ints 1m1000 numeric value - floats 1m1001 floating point value - pairs 1mr10. ptr to pair - aplied functor 1mr01. ptr to functor followed by args - ref 0mr000 address of cell - undefined 0mr000 pointing to itself - - */ - -#define AllTagBits 0xfc000000L -#define TagBits 0xbc000000L -#define MaskAdr 0x03ffffffL -#define AdrHiBit 0x02000000L -#define NumberTag 0xa0000000L -#define FloatTag 0xa4000000L -#define AtomTag 0x84000000L -#define PairTag 0x90000000L -#define ApplTag 0x88000000L -#define RefTag 0x80000000L - -#define MaskBits 6 - -#define PairBit 0x10000000L -#define ApplBit 0x08000000L -#define CompBits 0x18000000L -#define NumberMask 0xb8000000L -#define MAX_ABS_INT /* 0xfe00000LL */ ((((UInt)(1<<7))-1) << SHIFT_HIGH_TAG) - -#define NonTagPart(X) (Signed(X) & MaskAdr) -#define TAGGEDA(TAG,V) (TAG | Unsigned(V)) -#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V))) -#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)) -#define BitOn(Bit,V) (Bit & Unsigned(V)) -#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) - -/* bits that should not be used by anyone but us */ -#define YAP_PROTECTED_MASK 0x00000000L - - -inline EXTERN int IsVarTerm (Term); - -inline EXTERN int -IsVarTerm (Term t) -{ - return (int) (Signed (t) >= 0); -} - - - -inline EXTERN int IsNonVarTerm (Term); - -inline EXTERN int -IsNonVarTerm (Term t) -{ - return (int) (Signed (t) < 0); -} - - - -inline EXTERN Term *RepPair (Term); - -inline EXTERN Term * -RepPair (Term t) -{ - return (Term *) (NonTagPart (t)); -} - - - -inline EXTERN Term AbsPair (Term *); - -inline EXTERN Term -AbsPair (Term * p) -{ - return (Term) (TAGGEDA (PairTag, (p))); -} - - - -inline EXTERN Int IsPairTerm (Term); - -inline EXTERN Int -IsPairTerm (Term t) -{ - return (Int) (BitOn (PairBit, (t))); -} - - - -inline EXTERN Term *RepAppl (Term); - -inline EXTERN Term * -RepAppl (Term t) -{ - return (Term *) (NonTagPart (t)); -} - - - -inline EXTERN Term AbsAppl (Term *); - -inline EXTERN Term -AbsAppl (Term * p) -{ - return (Term) (TAGGEDA (ApplTag, (p))); -} - - - -inline EXTERN Int IsApplTerm (Term); - -inline EXTERN Int -IsApplTerm (Term t) -{ - return (Int) (BitOn (ApplBit, (t))); -} - - - -inline EXTERN Int IsAtomOrIntTerm (Term); - -inline EXTERN Int -IsAtomOrIntTerm (Term t) -{ - return (Int) (!(Unsigned (t) & CompBits)); -} - - - - -inline EXTERN Term AdjustPtr (Term t, Term off); - -inline EXTERN Term -AdjustPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - -inline EXTERN Term AdjustIDBPtr (Term t, Term off); - -inline EXTERN Term -AdjustIDBPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - -static inline Int -IntOfTerm (Term t) -{ - Int n; - n = (Unsigned (t) & MaskPrim) >> 2; - - if (Unsigned (t) & AdrHiBit) - n |= 0xfc000000; - return (n); -} + + + + + + + +/************************************************************************* +* * +* 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: Tags_24bits.h.m4 * +* Last rev: December 90 * +* mods: * +* comments: Tag Scheme for machines with 24 bits adresses (m68000) * +* version: $Id: Tags_24bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + + /* Version for 24 bit addresses (68000) + Each term is represented internally as an unsigned 32 bit integer as + follows: + tag value + ints 1m1000 numeric value + floats 1m1001 floating point value + pairs 1mr10. ptr to pair + aplied functor 1mr01. ptr to functor followed by args + ref 0mr000 address of cell + undefined 0mr000 pointing to itself + +*/ + +#define AllTagBits 0xfc000000L +#define TagBits 0xbc000000L +#define MaskAdr 0x03ffffffL +#define AdrHiBit 0x02000000L +#define NumberTag 0xa0000000L +#define FloatTag 0xa4000000L +#define AtomTag 0x84000000L +#define PairTag 0x90000000L +#define ApplTag 0x88000000L +#define RefTag 0x80000000L + +#define MaskBits 6 + +#define PairBit 0x10000000L +#define ApplBit 0x08000000L +#define CompBits 0x18000000L +#define NumberMask 0xb8000000L +#define MAX_ABS_INT /* 0xfe00000LL */ ((((UInt)(1<<7))-1) << SHIFT_HIGH_TAG) + +#define NonTagPart(X) (Signed(X) & MaskAdr) +#define TAGGEDA(TAG,V) (TAG | Unsigned(V)) +#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V))) +#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)) +#define BitOn(Bit,V) (Bit & Unsigned(V)) +#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) + +/* bits that should not be used by anyone but us */ +#define YAP_PROTECTED_MASK 0x00000000L + + +inline EXTERN int IsVarTerm(Term); + +inline EXTERN int IsVarTerm(Term t) +{ + return (int) (Signed(t) >= 0); +} + + + +inline EXTERN int IsNonVarTerm(Term); + +inline EXTERN int IsNonVarTerm(Term t) +{ + return (int) (Signed(t) < 0); +} + + + +inline EXTERN Term * RepPair(Term); + +inline EXTERN Term * RepPair(Term t) +{ + return (Term *) (NonTagPart(t)); +} + + + +inline EXTERN Term AbsPair(Term *); + +inline EXTERN Term AbsPair(Term * p) +{ + return (Term) (TAGGEDA(PairTag, (p))); +} + + + +inline EXTERN Int IsPairTerm(Term); + +inline EXTERN Int IsPairTerm(Term t) +{ + return (Int) (BitOn(PairBit, (t))); +} + + + +inline EXTERN Term * RepAppl(Term); + +inline EXTERN Term * RepAppl(Term t) +{ + return (Term *) (NonTagPart(t)); +} + + + +inline EXTERN Term AbsAppl(Term *); + +inline EXTERN Term AbsAppl(Term * p) +{ + return (Term) (TAGGEDA(ApplTag, (p))); +} + + + +inline EXTERN Int IsApplTerm(Term); + +inline EXTERN Int IsApplTerm(Term t) +{ + return (Int) (BitOn(ApplBit, (t))); +} + + + +inline EXTERN Int IsAtomOrIntTerm(Term); + +inline EXTERN Int IsAtomOrIntTerm(Term t) +{ + return (Int) (!(Unsigned(t) & CompBits)); +} + + + + +inline EXTERN Term AdjustPtr(Term t, Term off); + +inline EXTERN Term AdjustPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + +inline EXTERN Term AdjustIDBPtr(Term t, Term off); + +inline EXTERN Term AdjustIDBPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + +static inline Int +IntOfTerm(Term t) +{ + Int n; + n = (Unsigned(t) & MaskPrim) >> 2; + + if (Unsigned(t) & AdrHiBit) + n |= 0xfc000000; + return (n); +} + diff --git a/VC/include/Tags_32LowTag.h b/VC/include/Tags_32LowTag.h index cc64cc5cd..7bba339e2 100644 --- a/VC/include/Tags_32LowTag.h +++ b/VC/include/Tags_32LowTag.h @@ -1,203 +1,194 @@ - - - - - - - -/************************************************************************* -* * -* 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: Tags_32LowTag.h.m4 * -* Last rev: December 90 * -* mods: * -* comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32LowTag.h,v 1.1.1.1 2001-04-09 19:53:40 vsc Exp $ * -*************************************************************************/ - -#define TAG_LOW_BITS_32 1 - - /* Version for 32 bit addresses machines, - Each term is represented internally as an unsigned 32 bit integer as - follows: - tag value - ints m.....110 numeric value - atoms m.....010 offset of atom entry - pairs mr.....11 ptr to pair - aplied functor mr.....01 ptr to functor followed by args - ref mr.....00 address of cell - undefined mr.....00 address of cell pointing to itself - - functors are represented as ptrs to the functor entry in the atom - property list - - */ - -#define SHIFT_LOW_TAG 2 -#define SHIFT_HIGH_TAG 2 - -#define MKTAG(HI,LO) ((((UInt) (HI))<>(SHIFT_LOW_TAG+SHIFT_HIGH_TAG)) -#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 CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) - -/* bits that should not be used by anyone but us */ -#define YAP_PROTECTED_MASK 0xc0000000L - - -inline EXTERN int IsVarTerm (Term); - -inline EXTERN int -IsVarTerm (Term t) -{ - return (int) (!((t) & LowTagBits)); -} - - - -inline EXTERN int IsNonVarTerm (Term); - -inline EXTERN int -IsNonVarTerm (Term t) -{ - return (int) (((t) & LowTagBits)); -} - - - -inline EXTERN Term *RepPair (Term); - -inline EXTERN Term * -RepPair (Term t) -{ - return (Term *) ((t) - PairBits); -} - - - -inline EXTERN Term AbsPair (Term *); - -inline EXTERN Term -AbsPair (Term * p) -{ - return (Term) (Unsigned (p) + PairBits); -} - - - -inline EXTERN Int IsPairTerm (Term); - -inline EXTERN Int -IsPairTerm (Term t) -{ - return (Int) ((((t) & LowTagBits) == PairBits)); -} - - - -inline EXTERN Term *RepAppl (Term); - -inline EXTERN Term * -RepAppl (Term t) -{ - return (Term *) (((t) - ApplBit)); -} - - - -inline EXTERN Term AbsAppl (Term *); - -inline EXTERN Term -AbsAppl (Term * p) -{ - return (Term) (Unsigned (p) + ApplBit); -} - - - -inline EXTERN Int IsApplTerm (Term); - -inline EXTERN Int -IsApplTerm (Term t) -{ - return (Int) ((((t) & LowTagBits) == ApplBit)); -} - - - -inline EXTERN Int IsAtomOrIntTerm (Term); - -inline EXTERN Int -IsAtomOrIntTerm (Term t) -{ - return (Int) ((((t) & LowTagBits) == 2)); -} - - - - -inline EXTERN Term AdjustPtr (Term t, Term off); - -inline EXTERN Term -AdjustPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - -inline EXTERN Term AdjustIDBPtr (Term t, Term off); - -inline EXTERN Term -AdjustIDBPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - - -inline EXTERN Int IntOfTerm (Term); - -inline EXTERN Int -IntOfTerm (Term t) -{ - return (Int) (((Int) (t << 1)) >> (SHIFT_LOW_TAG + SHIFT_HIGH_TAG + 1)); -} + + + + + + + +/************************************************************************* +* * +* 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: Tags_32LowTag.h.m4 * +* Last rev: December 90 * +* mods: * +* comments: Original Tag Scheme for machines with 32 bits adresses * +* version: $Id: Tags_32LowTag.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + +#define TAG_LOW_BITS_32 1 + + /* Version for 32 bit addresses machines, + Each term is represented internally as an unsigned 32 bit integer as + follows: + tag value + ints m.....110 numeric value + atoms m.....010 offset of atom entry + pairs mr.....11 ptr to pair + aplied functor mr.....01 ptr to functor followed by args + ref mr.....00 address of cell + undefined mr.....00 address of cell pointing to itself + + functors are represented as ptrs to the functor entry in the atom +property list + +*/ + +#define SHIFT_LOW_TAG 2 +#define SHIFT_HIGH_TAG 2 + +#define MKTAG(HI,LO) ((((UInt) (HI))<>(SHIFT_LOW_TAG+SHIFT_HIGH_TAG)) +#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 CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) + +/* bits that should not be used by anyone but us */ +#define YAP_PROTECTED_MASK 0xc0000000L + + +inline EXTERN int IsVarTerm(Term); + +inline EXTERN int IsVarTerm(Term t) +{ + return (int) (!((t) & LowTagBits)); +} + + + +inline EXTERN int IsNonVarTerm(Term); + +inline EXTERN int IsNonVarTerm(Term t) +{ + return (int) (((t) & LowTagBits)); +} + + + +inline EXTERN Term * RepPair(Term); + +inline EXTERN Term * RepPair(Term t) +{ + return (Term *) ((t)-PairBits); +} + + + +inline EXTERN Term AbsPair(Term *); + +inline EXTERN Term AbsPair(Term * p) +{ + return (Term) (Unsigned(p)+PairBits); +} + + + +inline EXTERN Int IsPairTerm(Term); + +inline EXTERN Int IsPairTerm(Term t) +{ + return (Int) ((((t) & LowTagBits) == PairBits)); +} + + + +inline EXTERN Term * RepAppl(Term); + +inline EXTERN Term * RepAppl(Term t) +{ + return (Term *) (((t)-ApplBit)); +} + + + +inline EXTERN Term AbsAppl(Term *); + +inline EXTERN Term AbsAppl(Term * p) +{ + return (Term) (Unsigned(p)+ApplBit); +} + + + +inline EXTERN Int IsApplTerm(Term); + +inline EXTERN Int IsApplTerm(Term t) +{ + return (Int) ((((t) & LowTagBits) == ApplBit)); +} + + + +inline EXTERN Int IsAtomOrIntTerm(Term); + +inline EXTERN Int IsAtomOrIntTerm(Term t) +{ + return (Int) ((((t) & LowTagBits) == 2)); +} + + + + +inline EXTERN Term AdjustPtr(Term t, Term off); + +inline EXTERN Term AdjustPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + +inline EXTERN Term AdjustIDBPtr(Term t, Term off); + +inline EXTERN Term AdjustIDBPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + + +inline EXTERN Int IntOfTerm(Term); + +inline EXTERN Int IntOfTerm(Term t) +{ + return (Int) (((Int)(t << 1))>>(SHIFT_LOW_TAG+SHIFT_HIGH_TAG+1)); +} + + + diff --git a/VC/include/Tags_32Ops.h b/VC/include/Tags_32Ops.h index 172fd974e..401cf783e 100644 --- a/VC/include/Tags_32Ops.h +++ b/VC/include/Tags_32Ops.h @@ -1,319 +1,290 @@ - - - - - - - -/************************************************************************* -* * -* 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: Tags_32Ops.h.m4 * -* Last rev: December 90 * -* mods: * -* comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32Ops.h,v 1.1.1.1 2001-04-09 19:53:40 vsc Exp $ * -*************************************************************************/ - -/* - - Version for 32 bit addresses machines, - Each term is represented internally as an unsigned 32 bit integer as - follows: - tag value - ints 1m1....01 numeric value - atoms 1m0....01 offset of atom entry - pairs 1mr....11 ptr to pair - aplied functor 1mr....00 ptr to functor followed by args - undefined 0mr....00 address of cell pointing to itself - - functors are represented as ptrs to the functor entry in the atom -property list - - This version speeds up access to lists and to compound -terms by using the XOR and NOT operations to build their tags. This -saves operations on RISC machines. - - As a further optimisation, only pairs or compound terms have -the second lowest bit set. This allows one to recognise lists or -compound terms with a single operation. - - The main problem is that the default value of the M and R bits for GC -are now 1 in compound terms and structures. - -*/ - -#define TAGS_FAST_OPS 1 - -#define SHIFT_HIGH_TAG 29 - -#define MKTAG(HI,LO) ((((UInt) (HI))<= 0); -} - - - -inline EXTERN int IsNonVarTerm (Term); - -inline EXTERN int -IsNonVarTerm (Term t) -{ - return (int) (Signed (t) < 0); -} - - -#if UNIQUE_TAG_FOR_PAIRS - -inline EXTERN Term *RepPair (Term); - -inline EXTERN Term * -RepPair (Term t) -{ - return (Term *) ((~(t))); -} - - - -inline EXTERN Term AbsPair (Term *); - -inline EXTERN Term -AbsPair (Term * p) -{ - return (Term) ((~Unsigned (p))); -} - - - -inline EXTERN Int IsPairTerm (Term); - -inline EXTERN Int -IsPairTerm (Term t) -{ - return (Int) (((t) & PairBit)); -} - - - -inline EXTERN Term *RepAppl (Term); - -inline EXTERN Term * -RepAppl (Term t) -{ - return (Term *) ((-Signed (t))); -} - - - -inline EXTERN Term AbsAppl (Term *); - -inline EXTERN Term -AbsAppl (Term * p) -{ - return (Term) ((-Signed (p))); -} - - - -inline EXTERN Int IsApplTerm (Term); - -inline EXTERN Int -IsApplTerm (Term t) -{ - return (Int) ((!((t) & LowTagBits))); -} - - -#else - -inline EXTERN Term *RepPair (Term); - -inline EXTERN Term * -RepPair (Term t) -{ - return (Term *) ((-Signed (t))); -} - - - -inline EXTERN Term AbsPair (Term *); - -inline EXTERN Term -AbsPair (Term * p) -{ - return (Term) (((CELL) (-Signed (p)))); -} - - - -inline EXTERN Int IsPairTerm (Term); - -inline EXTERN Int -IsPairTerm (Term t) -{ - return (Int) ((!((t) & LowTagBits))); -} - - - -inline EXTERN Term *RepAppl (Term); - -inline EXTERN Term * -RepAppl (Term t) -{ - return (Term *) ((~(t))); -} - - - -inline EXTERN Term AbsAppl (Term *); - -inline EXTERN Term -AbsAppl (Term * p) -{ - return (Term) ((~Unsigned (p))); -} - - - -inline EXTERN Int IsApplTerm (Term); - -inline EXTERN Int -IsApplTerm (Term t) -{ - return (Int) (((t) & ApplBit)); -} - - -#endif - -inline EXTERN Int IsAtomOrIntTerm (Term); - -inline EXTERN Int -IsAtomOrIntTerm (Term t) -{ - return (Int) (((Unsigned (t) & LowTagBits) == 0x2)); -} - - - - -inline EXTERN Int IntOfTerm (Term); - -inline EXTERN Int -IntOfTerm (Term t) -{ - return (Int) ((Int) (Unsigned (t) << 3) >> 5); -} - - - -#if UNIQUE_TAG_FOR_PAIRS - -inline EXTERN Term AdjustPtr (Term t, Term off); - -inline EXTERN Term -AdjustPtr (Term t, Term off) -{ - return (Term) (((IsVarTerm (t) - || IsAtomOrIntTerm (t)) ? (t) + - (off) : (IsPairTerm (t) ? (CELL) - AbsPair ((CELL *) ((CELL) RepPair (t) + - (off))) : (t) - (off)))); -} - - - -inline EXTERN Term AdjustIDBPtr (Term t, Term off); - -inline EXTERN Term -AdjustIDBPtr (Term t, Term off) -{ - return (Term) (IsVarTerm (t) ? (t) + (off) : (t) - (off)); -} - - -#else - -inline EXTERN Term AdjustPtr (Term t, Term off); - -inline EXTERN Term -AdjustPtr (Term t, Term off) -{ - return (Term) (((IsVarTerm (t) - || IsAtomOrIntTerm (t)) ? (t) + - (off) : (IsApplTerm (t) ? (CELL) - AbsAppl ((CELL *) ((CELL) RepAppl (t) + - (off))) : (t) - (off)))); -} - - - -inline EXTERN Term AdjustIDBPtr (Term t, Term off); - -inline EXTERN Term -AdjustIDBPtr (Term t, Term off) -{ - return (Term) (IsVarTerm (t) ? (t) + - (off) : (IsApplTerm (t) ? (CELL) - AbsAppl ((CELL *) ((CELL) RepAppl (t) + - (off))) : (t) - (off))); -} - - -#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: Tags_32Ops.h.m4 * +* Last rev: December 90 * +* mods: * +* comments: Original Tag Scheme for machines with 32 bits adresses * +* version: $Id: Tags_32Ops.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + +/* + + Version for 32 bit addresses machines, + Each term is represented internally as an unsigned 32 bit integer as + follows: + tag value + ints 1m1....01 numeric value + atoms 1m0....01 offset of atom entry + pairs 1mr....11 ptr to pair + aplied functor 1mr....00 ptr to functor followed by args + undefined 0mr....00 address of cell pointing to itself + + functors are represented as ptrs to the functor entry in the atom +property list + + This version speeds up access to lists and to compound +terms by using the XOR and NOT operations to build their tags. This +saves operations on RISC machines. + + As a further optimisation, only pairs or compound terms have +the second lowest bit set. This allows one to recognise lists or +compound terms with a single operation. + + The main problem is that the default value of the M and R bits for GC +are now 1 in compound terms and structures. + +*/ + +#define TAGS_FAST_OPS 1 + +#define SHIFT_HIGH_TAG 29 + +#define MKTAG(HI,LO) ((((UInt) (HI))<= 0); +} + + + +inline EXTERN int IsNonVarTerm(Term); + +inline EXTERN int IsNonVarTerm(Term t) +{ + return (int) (Signed(t) < 0); +} + + +#if UNIQUE_TAG_FOR_PAIRS + +inline EXTERN Term * RepPair(Term); + +inline EXTERN Term * RepPair(Term t) +{ + return (Term *) ((~(t))); +} + + + +inline EXTERN Term AbsPair(Term *); + +inline EXTERN Term AbsPair(Term * p) +{ + return (Term) ((~Unsigned(p))); +} + + + +inline EXTERN Int IsPairTerm(Term); + +inline EXTERN Int IsPairTerm(Term t) +{ + return (Int) (((t) & PairBit)); +} + + + +inline EXTERN Term * RepAppl(Term); + +inline EXTERN Term * RepAppl(Term t) +{ + return (Term *) ((-Signed(t))); +} + + + +inline EXTERN Term AbsAppl(Term *); + +inline EXTERN Term AbsAppl(Term * p) +{ + return (Term) ((-Signed(p))); +} + + + +inline EXTERN Int IsApplTerm(Term); + +inline EXTERN Int IsApplTerm(Term t) +{ + return (Int) ((!((t) & LowTagBits))); +} + + +#else + +inline EXTERN Term * RepPair(Term); + +inline EXTERN Term * RepPair(Term t) +{ + return (Term *) ((-Signed(t))); +} + + + +inline EXTERN Term AbsPair(Term *); + +inline EXTERN Term AbsPair(Term * p) +{ + return (Term) (((CELL)(-Signed(p)))); +} + + + +inline EXTERN Int IsPairTerm(Term); + +inline EXTERN Int IsPairTerm(Term t) +{ + return (Int) ((!((t) & LowTagBits))); +} + + + +inline EXTERN Term * RepAppl(Term); + +inline EXTERN Term * RepAppl(Term t) +{ + return (Term *) ((~(t))); +} + + + +inline EXTERN Term AbsAppl(Term *); + +inline EXTERN Term AbsAppl(Term * p) +{ + return (Term) ((~Unsigned(p))); +} + + + +inline EXTERN Int IsApplTerm(Term); + +inline EXTERN Int IsApplTerm(Term t) +{ + return (Int) (((t) & ApplBit)); +} + + +#endif + +inline EXTERN Int IsAtomOrIntTerm(Term); + +inline EXTERN Int IsAtomOrIntTerm(Term t) +{ + return (Int) (((Unsigned(t) & LowTagBits) == 0x2)); +} + + + + +inline EXTERN Int IntOfTerm(Term); + +inline EXTERN Int IntOfTerm(Term t) +{ + return (Int) ((Int)(Unsigned(t) << 3) >> 5); +} + + + +#if UNIQUE_TAG_FOR_PAIRS + +inline EXTERN Term AdjustPtr(Term t, Term off); + +inline EXTERN Term AdjustPtr(Term t, Term off) +{ + return (Term) (((IsVarTerm(t) || IsAtomOrIntTerm(t)) ? (t)+(off) : (IsPairTerm(t) ? (CELL)AbsPair((CELL *)((CELL)RepPair(t)+(off))) : (t)-(off)))); +} + + + +inline EXTERN Term AdjustIDBPtr(Term t, Term off); + +inline EXTERN Term AdjustIDBPtr(Term t, Term off) +{ + return (Term) (IsVarTerm(t) ? (t)+(off) : (t)-(off)); +} + + +#else + +inline EXTERN Term AdjustPtr(Term t, Term off); + +inline EXTERN Term AdjustPtr(Term t, Term off) +{ + return (Term) (((IsVarTerm(t) || IsAtomOrIntTerm(t)) ? (t)+(off) : (IsApplTerm(t) ? (CELL)AbsAppl((CELL *)((CELL)RepAppl(t)+(off))) : (t)-(off)))); +} + + + +inline EXTERN Term AdjustIDBPtr(Term t, Term off); + +inline EXTERN Term AdjustIDBPtr(Term t, Term off) +{ + return (Term) (IsVarTerm(t) ? (t)+(off) : (IsApplTerm(t) ? (CELL)AbsAppl((CELL *)((CELL)RepAppl(t)+(off))) : (t)-(off))); +} + + +#endif + + diff --git a/VC/include/Tags_32bits.h b/VC/include/Tags_32bits.h index c08a89758..6d4c76910 100644 --- a/VC/include/Tags_32bits.h +++ b/VC/include/Tags_32bits.h @@ -1,190 +1,182 @@ - - - - - - - -/************************************************************************* -* * -* 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: Tags_32bits.h.m4 * -* Last rev: December 90 * -* mods: * -* comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_32bits.h,v 1.1.1.1 2001-04-09 19:53:41 vsc Exp $ * -*************************************************************************/ - -/* Original version for 32 bit addresses machines, - Each term is represented internally as an unsigned 32 bit integer as - follows: - tag value - ints 1m1....00 numeric value - atoms 1m0....00 offset of atom entry - pairs 1mr....01 ptr to pair - aplied functor 1mr....10 ptr to functor followed by args - ref 0mr....00 address of cell - undefined 0mr....00 address of cell pointing to itself - - functors are represented as ptrs to the functor entry in the atom -property list - -*/ - -#define SHIFT_HIGH_TAG 29 - -#define MKTAG(HI,LO) ((((UInt) (HI))<= 0); -} - - - -inline EXTERN int IsNonVarTerm (Term); - -inline EXTERN int -IsNonVarTerm (Term t) -{ - return (int) (Signed (t) < 0); -} - - - -inline EXTERN Term *RepPair (Term); - -inline EXTERN Term * -RepPair (Term t) -{ - return (Term *) (NonTagPart (t)); -} - - - -inline EXTERN Term AbsPair (Term *); - -inline EXTERN Term -AbsPair (Term * p) -{ - return (Term) (TAGGEDA (PairTag, (p))); -} - - - -inline EXTERN Int IsPairTerm (Term); - -inline EXTERN Int -IsPairTerm (Term t) -{ - return (Int) (BitOn (PairBit, (t))); -} - - - -inline EXTERN Term *RepAppl (Term); - -inline EXTERN Term * -RepAppl (Term t) -{ - return (Term *) (NonTagPart (t)); -} - - - -inline EXTERN Term AbsAppl (Term *); - -inline EXTERN Term -AbsAppl (Term * p) -{ - return (Term) (TAGGEDA (ApplTag, (p))); -} - - - -inline EXTERN Int IsApplTerm (Term); - -inline EXTERN Int -IsApplTerm (Term t) -{ - return (Int) (BitOn (ApplBit, (t))); -} - - - -inline EXTERN int IsAtomOrIntTerm (Term); - -inline EXTERN int -IsAtomOrIntTerm (Term t) -{ - return (int) (((Unsigned (t) & LowTagBits) == 0)); -} - - - - -inline EXTERN Term AdjustPtr (Term t, Term off); - -inline EXTERN Term -AdjustPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - -inline EXTERN Term AdjustIDBPtr (Term t, Term off); - -inline EXTERN Term -AdjustIDBPtr (Term t, Term off) -{ - return (Term) ((t) + off); -} - - - - -inline EXTERN Int IntOfTerm (Term); - -inline EXTERN Int -IntOfTerm (Term t) -{ - return (Int) (((Int) (t << 3)) >> (3 + 2)); -} + + + + + + + +/************************************************************************* +* * +* 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: Tags_32bits.h.m4 * +* Last rev: December 90 * +* mods: * +* comments: Original Tag Scheme for machines with 32 bits adresses * +* version: $Id: Tags_32bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + +/* Original version for 32 bit addresses machines, + Each term is represented internally as an unsigned 32 bit integer as + follows: + tag value + ints 1m1....00 numeric value + atoms 1m0....00 offset of atom entry + pairs 1mr....01 ptr to pair + aplied functor 1mr....10 ptr to functor followed by args + ref 0mr....00 address of cell + undefined 0mr....00 address of cell pointing to itself + + functors are represented as ptrs to the functor entry in the atom +property list + +*/ + +#define SHIFT_HIGH_TAG 29 + +#define MKTAG(HI,LO) ((((UInt) (HI))<= 0); +} + + + +inline EXTERN int IsNonVarTerm(Term); + +inline EXTERN int IsNonVarTerm(Term t) +{ + return (int) (Signed(t) < 0); +} + + + +inline EXTERN Term * RepPair(Term); + +inline EXTERN Term * RepPair(Term t) +{ + return (Term *) (NonTagPart(t)); +} + + + +inline EXTERN Term AbsPair(Term *); + +inline EXTERN Term AbsPair(Term * p) +{ + return (Term) (TAGGEDA(PairTag, (p))); +} + + + +inline EXTERN Int IsPairTerm(Term); + +inline EXTERN Int IsPairTerm(Term t) +{ + return (Int) (BitOn(PairBit, (t))); +} + + + +inline EXTERN Term * RepAppl(Term); + +inline EXTERN Term * RepAppl(Term t) +{ + return (Term *) (NonTagPart(t)); +} + + + +inline EXTERN Term AbsAppl(Term *); + +inline EXTERN Term AbsAppl(Term * p) +{ + return (Term) (TAGGEDA(ApplTag, (p))); +} + + + +inline EXTERN Int IsApplTerm(Term); + +inline EXTERN Int IsApplTerm(Term t) +{ + return (Int) (BitOn(ApplBit, (t))); +} + + + +inline EXTERN int IsAtomOrIntTerm(Term); + +inline EXTERN int IsAtomOrIntTerm(Term t) +{ + return (int) (((Unsigned(t) & LowTagBits) == 0)); +} + + + + +inline EXTERN Term AdjustPtr(Term t, Term off); + +inline EXTERN Term AdjustPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + +inline EXTERN Term AdjustIDBPtr(Term t, Term off); + +inline EXTERN Term AdjustIDBPtr(Term t, Term off) +{ + return (Term) ((t)+off); +} + + + + +inline EXTERN Int IntOfTerm(Term); + +inline EXTERN Int IntOfTerm(Term t) +{ + return (Int) (((Int)(t << 3))>>(3+2)); +} + + + + diff --git a/VC/include/Tags_64bits.h b/VC/include/Tags_64bits.h index c76baf4d5..26583de30 100644 --- a/VC/include/Tags_64bits.h +++ b/VC/include/Tags_64bits.h @@ -1,192 +1,183 @@ - - - - - - - -/************************************************************************* -* * -* 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: Tags_32Ops.h.m4 * -* Last rev: December 90 * -* mods: * -* comments: Original Tag Scheme for machines with 32 bits adresses * -* version: $Id: Tags_64bits.h,v 1.1.1.1 2001-04-09 19:53:41 vsc Exp $ * -*************************************************************************/ - -#define TAG_64BITS 1 - -/* Version for 64 bit addresses machines, - Each term is represented internally as an unsigned 64 bit integer as - follows: - tag value - ints 0m1....001 numeric value - atoms 0m0....001 offset of atom entry - pairs 0mr....011 ptr to pair - aplied functor 0mr....101 ptr to functor followed by args - undefined 0mr....000 address of cell pointing to itself - - functors are represented as ptrs to the functor entry in the atom -property list - - We rely on the fact that addresses are always multiple of 8. - -*/ - -#define SHIFT_HIGH_TAG 61 - -#define MKTAG(HI,LO) ((((UInt) (HI))<> 6); -} + + + + + + + +/************************************************************************* +* * +* 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: Tags_32Ops.h.m4 * +* Last rev: December 90 * +* mods: * +* comments: Original Tag Scheme for machines with 32 bits adresses * +* version: $Id: Tags_64bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + +#define TAG_64BITS 1 + +/* Version for 64 bit addresses machines, + Each term is represented internally as an unsigned 64 bit integer as + follows: + tag value + ints 0m1....001 numeric value + atoms 0m0....001 offset of atom entry + pairs 0mr....011 ptr to pair + aplied functor 0mr....101 ptr to functor followed by args + undefined 0mr....000 address of cell pointing to itself + + functors are represented as ptrs to the functor entry in the atom +property list + + We rely on the fact that addresses are always multiple of 8. + +*/ + +#define SHIFT_HIGH_TAG 61 + +#define MKTAG(HI,LO) ((((UInt) (HI))<> 6); +} + + + diff --git a/VC/include/TermExt.h b/VC/include/TermExt.h index b975d4c4b..a747ae74b 100644 --- a/VC/include/TermExt.h +++ b/VC/include/TermExt.h @@ -1,482 +1,432 @@ - - - - - - - -/************************************************************************* -* * -* 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: TermExt.h * -* mods: * -* comments: Extensions to standard terms for YAP * -* version: $Id: TermExt.h,v 1.1.1.1 2001-04-09 19:53:41 vsc Exp $ * -*************************************************************************/ - -#if USE_OFFSETS -#define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar))) -#define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil))) -#define AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot))) -#else -#define AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar)) -#define AtomNil AbsAtom(&(SF_STORE->AtNil)) -#define AtomDot AbsAtom(&(SF_STORE->AtDot)) -#endif - -#define TermFoundVar MkAtomTerm(AtomFoundVar) -#define TermNil MkAtomTerm(AtomNil) -#define TermDot MkAtomTerm(AtomDot) - -#ifdef IN_SECOND_QUADRANT -typedef enum -{ - db_ref_e = sizeof (Functor *) | RBIT, - long_int_e = 2 * sizeof (Functor *) | RBIT, -#ifdef USE_GMP - big_int_e = 3 * sizeof (Functor *) | RBIT, - double_e = 4 * sizeof (Functor *) | RBIT -#else - double_e = 3 * sizeof (Functor *) | RBIT -#endif -} -blob_type; -#else -typedef enum -{ - db_ref_e = sizeof (Functor *), - long_int_e = 2 * sizeof (Functor *), -#ifdef USE_GMP - big_int_e = 3 * sizeof (Functor *), - double_e = 4 * sizeof (Functor *) -#else - double_e = 3 * sizeof (Functor *) -#endif -} -blob_type; -#endif - -#define FunctorDBRef ((Functor)(db_ref_e)) -#define FunctorLongInt ((Functor)(long_int_e)) -#ifdef USE_GMP -#define FunctorBigInt ((Functor)(big_int_e)) -#endif -#define FunctorDouble ((Functor)(double_e)) -#define EndSpecials (double_e) - - -inline EXTERN blob_type BlobOfFunctor (Functor f); - -inline EXTERN blob_type -BlobOfFunctor (Functor f) -{ - return (blob_type) ((CELL) f); -} - - - -#define SF_STORE ((special_functors *)HEAP_INIT_BASE) - -#ifdef COROUTINING - -typedef struct -{ - /* what to do when someone tries to bind our term to someone else - in some predefined context */ - void (*bind_op) (Term *, Term); - /* what to do if someone wants to copy our constraint */ - int (*copy_term_op) (Term, CELL ***); - /* op called to do marking in GC */ - void (*mark_op) (CELL *); -} -ext_op; - -/* known delays */ -typedef enum -{ - empty_ext = 0 * sizeof (ext_op), /* default op, this should never be called */ - susp_ext = 1 * sizeof (ext_op), /* support for delayable goals */ - attvars_ext = 2 * sizeof (ext_op), /* support for attributed variables */ - /* add your own extensions here */ - /* keep this one */ -} -exts; - - -/* array with the ops for your favourite extensions */ -extern ext_op attas[attvars_ext + 1]; - -#endif - -/* make sure that these data structures are the first thing to be allocated - in the heap when we start the system */ -typedef struct special_functors_struct -{ - AtomEntry AtFoundVar; - char AtFoundVarChars[8]; - AtomEntry AtNil; - char AtNilChars[8]; - AtomEntry AtDot; - char AtDotChars[8]; -} -special_functors; - -#if SIZEOF_DOUBLE == SIZEOF_LONG_INT - -inline EXTERN Term MkFloatTerm (Float); - -inline EXTERN Term -MkFloatTerm (Float dbl) -{ - return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) = - dbl, H[2] = ((2 * sizeof (CELL) + EndSpecials) | MBIT), H += - 3, AbsAppl (H - 3))); -} - - - - -inline EXTERN Float FloatOfTerm (Term t); - -inline EXTERN Float -FloatOfTerm (Term t) -{ - return (Float) (*(Float *) (RepAppl (t) + 1)); -} - - - -#define InitUnalignedFloat() - -#else - -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - -#ifdef i386X -#define DOUBLE_ALIGNED(ADDR) TRUE -#else -/* first, need to address the alignment problem */ -#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4) -#endif - -inline EXTERN Float STD_PROTO (CpFloatUnaligned, (CELL *)); - - -inline EXTERN void STD_PROTO (AlignGlobalForDouble, (void)); - -inline EXTERN Float -CpFloatUnaligned (CELL * ptr) -{ - union - { - Float f; - CELL d[2]; - } - u; - u.d[0] = ptr[1]; - u.d[1] = ptr[2]; - return (u.f); -} - - -inline EXTERN Term MkFloatTerm (Float); - -inline EXTERN Term -MkFloatTerm (Float dbl) -{ - return (Term) ((AlignGlobalForDouble (), H[0] = - (CELL) FunctorDouble, *(Float *) (H + 1) = dbl, H[3] = - ((3 * sizeof (CELL) + EndSpecials) | MBIT), H += - 4, AbsAppl (H - 4))); -} - - - - -inline EXTERN Float FloatOfTerm (Term t); - -inline EXTERN Float -FloatOfTerm (Term t) -{ - return (Float) ((DOUBLE_ALIGNED (RepAppl (t)) ? *(Float *) (RepAppl (t) + 1) - : CpFloatUnaligned (RepAppl (t)))); -} - - -/* no alignment problems for 64 bit machines */ -#else - /* OOPS, YAP only understands Floats that are as large as cells or that - take two cells!!! */ -#endif -#endif - - -inline EXTERN int IsFloatTerm (Term); - -inline EXTERN int -IsFloatTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDouble); -} - - - - -/* extern Functor FunctorLongInt; */ - -inline EXTERN Term MkLongIntTerm (Int); - -inline EXTERN Term -MkLongIntTerm (Int i) -{ - return (Term) ((H[0] = (CELL) FunctorLongInt, H[1] = (CELL) i, H[2] = - ((2 * sizeof (CELL) + EndSpecials) | MBIT), H += - 3, AbsAppl (H - 3))); -} - - - -inline EXTERN Int LongIntOfTerm (Term t); - -inline EXTERN Int -LongIntOfTerm (Term t) -{ - return (Int) (RepAppl (t)[1]); -} - - - -inline EXTERN int IsLongIntTerm (Term); - -inline EXTERN int -IsLongIntTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorLongInt); -} - - - - -#ifdef USE_GMP -#include -#include - - -MP_INT *STD_PROTO (PreAllocBigNum, (void)); -void STD_PROTO (ClearAllocBigNum, (void)); -MP_INT *STD_PROTO (InitBigNum, (Int)); -Term STD_PROTO (MkBigIntTerm, (MP_INT *)); -MP_INT *STD_PROTO (BigIntOfTerm, (Term)); - - -inline EXTERN int IsBigIntTerm (Term); - -inline EXTERN int -IsBigIntTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorBigInt); -} - - - - -inline EXTERN int IsLargeIntTerm (Term); - -inline EXTERN int -IsLargeIntTerm (Term t) -{ - return (int) (IsApplTerm (t) - && ((FunctorOfTerm (t) <= FunctorBigInt) - && (FunctorOfTerm (t) >= FunctorLongInt))); -} - - - -#else - - -inline EXTERN int IsBigIntTerm (Term); - -inline EXTERN int -IsBigIntTerm (Term t) -{ - return (int) (FALSE); -} - - - - -inline EXTERN int IsLargeIntTerm (Term); - -inline EXTERN int -IsLargeIntTerm (Term t) -{ - return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorLongInt); -} - - - -#endif - -/* extern Functor FunctorLongInt; */ - -inline EXTERN int IsLargeNumTerm (Term); - -inline EXTERN int -IsLargeNumTerm (Term t) -{ - return (int) (IsApplTerm (t) - && ((FunctorOfTerm (t) <= FunctorDouble) - && (FunctorOfTerm (t) >= FunctorLongInt))); -} - - - - -inline EXTERN int IsNumTerm (Term); - -inline EXTERN int -IsNumTerm (Term t) -{ - return (int) ((IsIntTerm (t) || IsLargeNumTerm (t))); -} - - - - -inline EXTERN Int IsAtomicTerm (Term); - -inline EXTERN Int -IsAtomicTerm (Term t) -{ - return (Int) (IsAtomOrIntTerm (t) || IsLargeNumTerm (t)); -} - - - - -inline EXTERN Int IsExtensionFunctor (Functor); - -inline EXTERN Int -IsExtensionFunctor (Functor f) -{ - return (Int) (f <= FunctorDouble); -} - - - -inline EXTERN Int IsBlobFunctor (Functor); - -inline EXTERN Int -IsBlobFunctor (Functor f) -{ - return (Int) ((f <= FunctorDouble && f >= FunctorDBRef)); -} - - - -inline EXTERN Int IsPrimitiveTerm (Term); - -inline EXTERN Int -IsPrimitiveTerm (Term t) -{ - return (Int) ((IsAtomOrIntTerm (t) - || (IsApplTerm (t) && IsBlobFunctor (FunctorOfTerm (t))))); -} - - - -#ifdef TERM_EXTENSIONS - - -inline EXTERN Int IsAttachFunc (Functor); - -inline EXTERN Int -IsAttachFunc (Functor f) -{ - return (Int) (FALSE); -} - - - - -inline EXTERN Int IsAttachedTerm (Term); - -inline EXTERN Int -IsAttachedTerm (Term t) -{ - return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0)); -} - - - - -inline EXTERN exts ExtFromCell (CELL *); - -inline EXTERN exts -ExtFromCell (CELL * pt) -{ - return (exts) (pt[1]); -} - - - -#else - - -inline EXTERN Int IsAttachFunc (Functor); - -inline EXTERN Int -IsAttachFunc (Functor f) -{ - return (Int) (FALSE); -} - - - - -inline EXTERN Int IsAttachedTerm (Term); - -inline EXTERN Int -IsAttachedTerm (Term t) -{ - return (Int) (FALSE); -} - - - -#endif - -EXTERN int STD_PROTO (unify_extension, (Functor, CELL, CELL *, CELL)); - -inline EXTERN int -unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1) -{ - switch (BlobOfFunctor (f)) - { - case db_ref_e: - return (d0 == d1); - case long_int_e: - return (pt0[1] == RepAppl (d1)[1]); -#ifdef USE_GMP - case big_int_e: - return (mpz_cmp (BigIntOfTerm (d0), BigIntOfTerm (d1)) == 0); -#endif /* USE_GMP */ - case double_e: - { - CELL *pt1 = RepAppl (d1); - return (pt0[1] == pt1[1] -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - && pt0[2] == pt1[2] -#endif - ); - } - } - return (FALSE); -} + + + + + + + +/************************************************************************* +* * +* 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: TermExt.h * +* mods: * +* comments: Extensions to standard terms for YAP * +* version: $Id: TermExt.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * +*************************************************************************/ + +#if USE_OFFSETS +#define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar))) +#define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil))) +#define AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot))) +#else +#define AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar)) +#define AtomNil AbsAtom(&(SF_STORE->AtNil)) +#define AtomDot AbsAtom(&(SF_STORE->AtDot)) +#endif + +#define TermFoundVar MkAtomTerm(AtomFoundVar) +#define TermNil MkAtomTerm(AtomNil) +#define TermDot MkAtomTerm(AtomDot) + +#ifdef IN_SECOND_QUADRANT +typedef enum { + db_ref_e = sizeof(Functor *)|RBIT, + long_int_e = 2*sizeof(Functor *)|RBIT, +#ifdef USE_GMP + big_int_e = 3*sizeof(Functor *)|RBIT, + double_e = 4*sizeof(Functor *)|RBIT +#else + double_e = 3*sizeof(Functor *)|RBIT +#endif +} blob_type; +#else +typedef enum { + db_ref_e = sizeof(Functor *), + long_int_e = 2*sizeof(Functor *), +#ifdef USE_GMP + big_int_e = 3*sizeof(Functor *), + double_e = 4*sizeof(Functor *) +#else + double_e = 3*sizeof(Functor *) +#endif +} blob_type; +#endif + +#define FunctorDBRef ((Functor)(db_ref_e)) +#define FunctorLongInt ((Functor)(long_int_e)) +#ifdef USE_GMP +#define FunctorBigInt ((Functor)(big_int_e)) +#endif +#define FunctorDouble ((Functor)(double_e)) +#define EndSpecials (double_e) + + +inline EXTERN blob_type BlobOfFunctor(Functor f); + +inline EXTERN blob_type BlobOfFunctor(Functor f) +{ + return (blob_type) ((CELL)f); +} + + + +#define SF_STORE ((special_functors *)HEAP_INIT_BASE) + +#ifdef COROUTINING + +typedef struct { + /* what to do when someone tries to bind our term to someone else + in some predefined context */ + void (*bind_op)(Term *, Term); + /* what to do if someone wants to copy our constraint */ + int (*copy_term_op)(Term, CELL ***); + /* op called to do marking in GC */ + void (*mark_op)(CELL *); +} ext_op; + +/* known delays */ +typedef enum { + empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */ + susp_ext = 1*sizeof(ext_op), /* support for delayable goals */ + attvars_ext = 2*sizeof(ext_op), /* support for attributed variables */ + /* add your own extensions here */ + /* keep this one */ +} exts; + + +/* array with the ops for your favourite extensions */ +extern ext_op attas[attvars_ext+1]; + +#endif + +/* make sure that these data structures are the first thing to be allocated + in the heap when we start the system */ +typedef struct special_functors_struct +{ + AtomEntry AtFoundVar; + char AtFoundVarChars[8]; + AtomEntry AtNil; + char AtNilChars[8]; + AtomEntry AtDot; + char AtDotChars[8]; +} +special_functors; + +#if SIZEOF_DOUBLE == SIZEOF_LONG_INT + +inline EXTERN Term MkFloatTerm(Float); + +inline EXTERN Term MkFloatTerm(Float dbl) +{ + return (Term) ((H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3))); +} + + + + +inline EXTERN Float FloatOfTerm(Term t); + +inline EXTERN Float FloatOfTerm(Term t) +{ + return (Float) (*(Float *)(RepAppl(t)+1)); +} + + + +#define InitUnalignedFloat() + +#else + +#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT + +#ifdef i386X +#define DOUBLE_ALIGNED(ADDR) TRUE +#else +/* first, need to address the alignment problem */ +#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4) +#endif + +inline EXTERN Float STD_PROTO(CpFloatUnaligned,(CELL *)); + + +inline EXTERN void STD_PROTO(AlignGlobalForDouble,(void)); + +inline EXTERN Float +CpFloatUnaligned(CELL *ptr) +{ + union { Float f; CELL d[2]; } u; + u.d[0] = ptr[1]; + u.d[1] = ptr[2]; + return(u.f); +} + + +inline EXTERN Term MkFloatTerm(Float); + +inline EXTERN Term MkFloatTerm(Float dbl) +{ + return (Term) ((AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4))); +} + + + + +inline EXTERN Float FloatOfTerm(Term t); + +inline EXTERN Float FloatOfTerm(Term t) +{ + return (Float) ((DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t)))); +} + + +/* no alignment problems for 64 bit machines */ +#else + /* OOPS, YAP only understands Floats that are as large as cells or that + take two cells!!! */ +#endif +#endif + + +inline EXTERN int IsFloatTerm(Term); + +inline EXTERN int IsFloatTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorDouble); +} + + + + +/* extern Functor FunctorLongInt; */ + +inline EXTERN Term MkLongIntTerm(Int); + +inline EXTERN Term MkLongIntTerm(Int i) +{ + return (Term) ((H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3))); +} + + + +inline EXTERN Int LongIntOfTerm(Term t); + +inline EXTERN Int LongIntOfTerm(Term t) +{ + return (Int) (RepAppl(t)[1]); +} + + + +inline EXTERN int IsLongIntTerm(Term); + +inline EXTERN int IsLongIntTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt); +} + + + + +#ifdef USE_GMP +#include +#include + + +MP_INT *STD_PROTO(PreAllocBigNum,(void)); +void STD_PROTO(ClearAllocBigNum,(void)); +MP_INT *STD_PROTO(InitBigNum,(Int)); +Term STD_PROTO(MkBigIntTerm, (MP_INT *)); +MP_INT *STD_PROTO(BigIntOfTerm, (Term)); + + +inline EXTERN int IsBigIntTerm(Term); + +inline EXTERN int IsBigIntTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt); +} + + + + +inline EXTERN int IsLargeIntTerm(Term); + +inline EXTERN int IsLargeIntTerm(Term t) +{ + return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorBigInt) && (FunctorOfTerm(t) >= FunctorLongInt))); +} + + + +#else + + +inline EXTERN int IsBigIntTerm(Term); + +inline EXTERN int IsBigIntTerm(Term t) +{ + return (int) (FALSE); +} + + + + +inline EXTERN int IsLargeIntTerm(Term); + +inline EXTERN int IsLargeIntTerm(Term t) +{ + return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt); +} + + + +#endif + +/* extern Functor FunctorLongInt; */ + +inline EXTERN int IsLargeNumTerm(Term); + +inline EXTERN int IsLargeNumTerm(Term t) +{ + return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorDouble) && (FunctorOfTerm(t) >= FunctorLongInt))); +} + + + + +inline EXTERN int IsNumTerm(Term); + +inline EXTERN int IsNumTerm(Term t) +{ + return (int) ((IsIntTerm(t) || IsLargeNumTerm(t))); +} + + + + +inline EXTERN Int IsAtomicTerm(Term); + +inline EXTERN Int IsAtomicTerm(Term t) +{ + return (Int) (IsAtomOrIntTerm(t) || IsLargeNumTerm(t)); +} + + + + +inline EXTERN Int IsExtensionFunctor(Functor); + +inline EXTERN Int IsExtensionFunctor(Functor f) +{ + return (Int) (f <= FunctorDouble); +} + + + +inline EXTERN Int IsBlobFunctor(Functor); + +inline EXTERN Int IsBlobFunctor(Functor f) +{ + return (Int) ((f <= FunctorDouble && f >= FunctorDBRef)); +} + + + +inline EXTERN Int IsPrimitiveTerm(Term); + +inline EXTERN Int IsPrimitiveTerm(Term t) +{ + return (Int) ((IsAtomOrIntTerm(t) || (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))))); +} + + + +#ifdef TERM_EXTENSIONS + + +inline EXTERN Int IsAttachFunc(Functor); + +inline EXTERN Int IsAttachFunc(Functor f) +{ + return (Int) (FALSE); +} + + + + +inline EXTERN Int IsAttachedTerm(Term); + +inline EXTERN Int IsAttachedTerm(Term t) +{ + return (Int) ((IsVarTerm(t) && VarOfTerm(t) < H0) ); +} + + + + +inline EXTERN exts ExtFromCell(CELL *); + +inline EXTERN exts ExtFromCell(CELL * pt) +{ + return (exts) (pt[1]); +} + + + +#else + + +inline EXTERN Int IsAttachFunc(Functor); + +inline EXTERN Int IsAttachFunc(Functor f) +{ + return (Int) (FALSE); +} + + + + +inline EXTERN Int IsAttachedTerm(Term); + +inline EXTERN Int IsAttachedTerm(Term t) +{ + return (Int) (FALSE); +} + + + +#endif + +EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL)); + +inline EXTERN int +unify_extension(Functor f, CELL d0, CELL *pt0, CELL d1) +{ + switch(BlobOfFunctor(f)) { + case db_ref_e: + return (d0 == d1); + case long_int_e: + return(pt0[1] == RepAppl(d1)[1]); +#ifdef USE_GMP + case big_int_e: + return (mpz_cmp(BigIntOfTerm(d0),BigIntOfTerm(d1)) == 0); +#endif /* USE_GMP */ + case double_e: + { + CELL *pt1 = RepAppl(d1); + return (pt0[1] == pt1[1] +#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT + && pt0[2] == pt1[2] +#endif + ); + } + } + return(FALSE); +} + diff --git a/VC/include/Yap.h b/VC/include/Yap.h index 9e84d90e9..efcc66b28 100644 --- a/VC/include/Yap.h +++ b/VC/include/Yap.h @@ -17,7 +17,7 @@ * File: Yap.h.m4 * * mods: * * comments: main header file for YAP * -* version: $Id: Yap.h,v 1.1.1.1 2001-04-09 19:53:41 vsc Exp $ * +* version: $Id: Yap.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ * *************************************************************************/ #include "config.h" @@ -71,7 +71,7 @@ #endif /* YAPOR */ #if defined(YAPOR) || defined(TABLING) -#undef TRAILING_REQUIRES_BRANCH +#undef TRAILING_REQUIRES_BRANCH #endif /* YAPOR || TABLING */ #if ANALYST @@ -86,7 +86,21 @@ #endif #endif -#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ +#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 @@ -121,7 +135,7 @@ #if HAVE_GCC #define MIN_ARRAY 0 -#define DUMMY_FILLER_FOR_ABS_TYPE +#define DUMMY_FILLER_FOR_ABS_TYPE #else #define MIN_ARRAY 1 #define DUMMY_FILLER_FOR_ABS_TYPE int dummy; @@ -157,15 +171,17 @@ /* */ typedef unsigned long int UInt; #else -error Yap require integer types of the same size as a pointer + 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 + error Yap requires integer types half the size of a pointer #endif + #elif SIZEOF_INT_P==8 # if SIZEOF_INT==8 @@ -181,8 +197,9 @@ error Yap require integer types of the same size as a pointer /* */ typedef unsigned long long int UInt; # else -error Yap requires integer types of the same size as a pointer + 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; @@ -192,13 +209,16 @@ error Yap requires integer types of the same size as a pointer /* */ typedef short int UShort; # else - error Yap requires integer types half the size of a pointer + error Yap requires integer types half the size of a pointer # endif + #else -error Yap requires pointers of size 4 or 8 + error Yap requires pointers of size 4 or 8 + #endif -/* */ typedef double Float; + +/* */ typedef double Float; #if SIZEOF_INT Term - and RepAppl(t) : Term -> *CELL +with AbsAppl(t) : *CELL -> Term +and RepAppl(t) : Term -> *CELL - and AbsPair(t) : *CELL -> Term - and RepPair(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 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 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 = ... +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 @@ -587,7 +607,7 @@ yap_flags; #define RBIT 0x40000000 #if IN_SECOND_QUADRANT -#define INVERT_RBIT 1 /* RBIT is 1 by default */ +#define INVERT_RBIT 1 /* RBIT is 1 by default */ #endif #else @@ -595,7 +615,7 @@ yap_flags; #if defined(SBA) && defined(__linux__) #define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */ #else -#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */ +#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */ #define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */ #endif #endif @@ -604,140 +624,127 @@ yap_flags; /* applies to unbound variables */ -inline EXTERN Term *VarOfTerm (Term t); +inline EXTERN Term * VarOfTerm(Term t); -inline EXTERN Term * -VarOfTerm (Term t) +inline EXTERN Term * VarOfTerm(Term t) { - return (Term *) (t); + return (Term *) (t); } #if SBA -inline EXTERN Term MkVarTerm (void); +inline EXTERN Term MkVarTerm(void); -inline EXTERN Term -MkVarTerm () +inline EXTERN Term MkVarTerm() { - return (Term) ((*H = 0, H++)); + return (Term) ((*H = 0, H++)); } -inline EXTERN int IsUnboundVar (Term); +inline EXTERN int IsUnboundVar(Term); -inline EXTERN int -IsUnboundVar (Term t) +inline EXTERN int IsUnboundVar(Term t) { - return (int) (t == 0); + return (int) (t == 0); } #else -inline EXTERN Term MkVarTerm (void); +inline EXTERN Term MkVarTerm(void); -inline EXTERN Term -MkVarTerm () +inline EXTERN Term MkVarTerm() { - return (Term) ((*H = (CELL) H, H++)); + return (Term) ((*H = (CELL) H, H++)); } -inline EXTERN int IsUnboundVar (Term); +inline EXTERN int IsUnboundVar(Term); -inline EXTERN int -IsUnboundVar (Term t) +inline EXTERN int IsUnboundVar(Term t) { - return (int) (*VarOfTerm (t) == (t)); + return (int) (*VarOfTerm(t) == (t)); } #endif -inline EXTERN CELL *PtrOfTerm (Term); +inline EXTERN CELL * PtrOfTerm(Term); -inline EXTERN CELL * -PtrOfTerm (Term t) +inline EXTERN CELL * PtrOfTerm(Term t) { - return (CELL *) (*(CELL *) (t)); + return (CELL *) (*(CELL *)(t)); } -inline EXTERN Functor FunctorOfTerm (Term); +inline EXTERN Functor FunctorOfTerm(Term); -inline EXTERN Functor -FunctorOfTerm (Term t) +inline EXTERN Functor FunctorOfTerm(Term t) { - return (Functor) (*RepAppl (t)); + return (Functor) (*RepAppl(t)); } #if IN_SECOND_QUADRANT -inline EXTERN Term MkAtomTerm (Atom); +inline EXTERN Term MkAtomTerm(Atom); -inline EXTERN Term -MkAtomTerm (Atom a) +inline EXTERN Term MkAtomTerm(Atom a) { - return (Term) (TAGGEDA (AtomTag, (CELL *) (a) - (CELL *) HEAP_INIT_BASE)); + return (Term) (TAGGEDA(AtomTag, (CELL *)(a)-(CELL *)HEAP_INIT_BASE)); } -inline EXTERN Atom AtomOfTerm (Term t); +inline EXTERN Atom AtomOfTerm(Term t); -inline EXTERN Atom -AtomOfTerm (Term t) +inline EXTERN Atom AtomOfTerm(Term t) { - return (Atom) ((CELL *) HEAP_INIT_BASE + NonTagPart (t)); + return (Atom) ((CELL *)HEAP_INIT_BASE+NonTagPart(t)); } #else -inline EXTERN Term MkAtomTerm (Atom); +inline EXTERN Term MkAtomTerm(Atom); -inline EXTERN Term -MkAtomTerm (Atom a) +inline EXTERN Term MkAtomTerm(Atom a) { - return (Term) (TAGGEDA (AtomTag, (a))); + return (Term) (TAGGEDA(AtomTag, (a))); } -inline EXTERN Atom AtomOfTerm (Term t); +inline EXTERN Atom AtomOfTerm(Term t); -inline EXTERN Atom -AtomOfTerm (Term t) +inline EXTERN Atom AtomOfTerm(Term t) { - return (Atom) (NonTagPart (t)); + return (Atom) (NonTagPart(t)); } #endif -inline EXTERN int IsAtomTerm (Term); +inline EXTERN int IsAtomTerm(Term); -inline EXTERN int -IsAtomTerm (Term t) +inline EXTERN int IsAtomTerm(Term t) { - return (int) (CHKTAG ((t), AtomTag)); + return (int) (CHKTAG((t), AtomTag)); } -inline EXTERN Term MkIntTerm (Int); +inline EXTERN Term MkIntTerm(Int); -inline EXTERN Term -MkIntTerm (Int n) +inline EXTERN Term MkIntTerm(Int n) { - return (Term) (TAGGED (NumberTag, (n))); + return (Term) (TAGGED(NumberTag, (n))); } @@ -746,22 +753,20 @@ MkIntTerm (Int n) overflow problems are possible */ -inline EXTERN Term MkIntConstant (Int); +inline EXTERN Term MkIntConstant(Int); -inline EXTERN Term -MkIntConstant (Int n) +inline EXTERN Term MkIntConstant(Int n) { - return (Term) (NONTAGGED (NumberTag, (n))); + return (Term) (NONTAGGED(NumberTag, (n))); } -inline EXTERN int IsIntTerm (Term); +inline EXTERN int IsIntTerm(Term); -inline EXTERN int -IsIntTerm (Term t) +inline EXTERN int IsIntTerm(Term t) { - return (int) (CHKTAG ((t), NumberTag)); + return (int) (CHKTAG((t), NumberTag)); } @@ -775,8 +780,8 @@ IsIntTerm (Term t) #ifdef TAGS_FAST_OPS #define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1) #else -#define IntInBnd(X) ( (X) < (Int)MAX_ABS_INT && \ - (X) > -(Int)MAX_ABS_INT-1 ) +#define IntInBnd(X) ( (X) < MAX_ABS_INT && \ + (X) > -MAX_ABS_INT-1L ) #endif #endif #ifdef C_PROLOG @@ -788,10 +793,11 @@ IsIntTerm (Term t) /************* variables related to memory allocation *******************/ /* must be before TermExt.h */ -extern ADDR HeapBase, - LocalBase, - GlobalBase, - TrailBase, TrailTop, ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; +extern ADDR HeapBase, + LocalBase, + GlobalBase, + TrailBase, TrailTop, + ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; /* @@ -809,32 +815,29 @@ extern ADDR HeapBase, #define IsAccessFunc(func) ((func) == FunctorAccess) -inline EXTERN Term MkIntegerTerm (Int); +inline EXTERN Term MkIntegerTerm(Int); -inline EXTERN Term -MkIntegerTerm (Int n) +inline EXTERN Term MkIntegerTerm(Int n) { - return (Term) (IntInBnd (n) ? MkIntTerm (n) : MkLongIntTerm (n)); + return (Term) (IntInBnd(n) ? MkIntTerm(n) : MkLongIntTerm(n)); } -inline EXTERN int IsIntegerTerm (Term); +inline EXTERN int IsIntegerTerm(Term); -inline EXTERN int -IsIntegerTerm (Term t) +inline EXTERN int IsIntegerTerm(Term t) { - return (int) (IsIntTerm (t) || IsLongIntTerm (t)); + return (int) (IsIntTerm(t) || IsLongIntTerm(t)); } -inline EXTERN Int IntegerOfTerm (Term); +inline EXTERN Int IntegerOfTerm(Term); -inline EXTERN Int -IntegerOfTerm (Term t) +inline EXTERN Int IntegerOfTerm(Term t) { - return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t)); + return (Int) (IsIntTerm(t) ? IntOfTerm(t) : LongIntOfTerm(t)); } @@ -851,63 +854,57 @@ IntegerOfTerm (Term t) /*************** High level macros to access arguments ******************/ -inline EXTERN Term ArgOfTerm (int i, Term t); +inline EXTERN Term ArgOfTerm(int i, Term t); -inline EXTERN Term -ArgOfTerm (int i, Term t) +inline EXTERN Term ArgOfTerm(int i, Term t) { - return (Term) (Derefa (RepAppl (t) + (i))); + return (Term) (Derefa(RepAppl(t) + (i))); } -inline EXTERN Term HeadOfTerm (Term); +inline EXTERN Term HeadOfTerm(Term); -inline EXTERN Term -HeadOfTerm (Term t) +inline EXTERN Term HeadOfTerm(Term t) { - return (Term) (Derefa (RepPair (t))); + return (Term) (Derefa(RepPair(t))); } -inline EXTERN Term TailOfTerm (Term); +inline EXTERN Term TailOfTerm(Term); -inline EXTERN Term -TailOfTerm (Term t) +inline EXTERN Term TailOfTerm(Term t) { - return (Term) (Derefa (RepPair (t) + 1)); + return (Term) (Derefa(RepPair(t) + 1)); } -inline EXTERN Term ArgOfTermCell (int i, Term t); +inline EXTERN Term ArgOfTermCell(int i, Term t); -inline EXTERN Term -ArgOfTermCell (int i, Term t) +inline EXTERN Term ArgOfTermCell(int i, Term t) { - return (Term) ((CELL) (RepAppl (t) + (i))); + return (Term) ((CELL)(RepAppl(t) + (i))); } -inline EXTERN Term HeadOfTermCell (Term); +inline EXTERN Term HeadOfTermCell(Term); -inline EXTERN Term -HeadOfTermCell (Term t) +inline EXTERN Term HeadOfTermCell(Term t) { - return (Term) ((CELL) (RepPair (t))); + return (Term) ((CELL)(RepPair(t))); } -inline EXTERN Term TailOfTermCell (Term); +inline EXTERN Term TailOfTermCell(Term); -inline EXTERN Term -TailOfTermCell (Term t) +inline EXTERN Term TailOfTermCell(Term t) { - return (Term) ((CELL) (RepPair (t) + 1)); + return (Term) ((CELL)(RepPair(t) + 1)); } @@ -916,7 +913,7 @@ TailOfTermCell (Term t) #define MaxHash 1001 /************ variables concerned with save and restore *************/ -extern int splfild; +extern int splfild; #define FAIL_RESTORE 0 #define DO_EVERYTHING 1 @@ -927,24 +924,22 @@ extern int splfild; /******************** using Emacs mode ********************************/ -extern int emacs_mode; +extern int emacs_mode; #endif /************ variable concerned with version number *****************/ -extern char version_number[]; +extern char version_number[]; /* consult stack management */ -typedef union CONSULT_OBJ -{ +typedef union CONSULT_OBJ { char *filename; int mode; - Prop p; + Prop p; union CONSULT_OBJ *c; -} -consult_obj; +} consult_obj; /********* common instructions codes*************************/ @@ -953,35 +948,35 @@ consult_obj; #if USE_THREADED_CODE /************ reverse lookup of instructions *****************/ -typedef struct opcode_tab_entry -{ +typedef struct opcode_tab_entry { OPCODE opc; op_numbers opnum; -} -opentry; +} opentry; #endif /******************* controlling the compiler ****************************/ -extern int optimizer_on; +extern int optimizer_on; /******************* the line for the current parse **********************/ -extern int StartLine; -extern int StartCh; -extern int CurFileNo; +extern int StartLine; +extern int StartCh; +extern int CurFileNo; /********************* how to write a Prolog term ***********************/ /********* Prolog may be in several modes *******************************/ -#define BootMode 1 /* if booting or restoring */ -#define UserMode 2 /* Normal mode */ -#define CritMode 4 /* If we are meddling with the heap */ -#define FullLMode 8 /* to access the hidden atoms chain */ -#define AbortMode 16 /* expecting to abort */ -#define InterruptMode 32 /* under an interrupt */ +typedef enum { + BootMode = 1, /* if booting or restoring */ + UserMode = 2, /* Normal mode */ + CritMode = 4, /* If we are meddling with the heap */ + AbortMode = 8, /* expecting to abort */ + InterruptMode = 16 /* under an interrupt */ +} prolog_exec_mode; -extern int PrologMode; +extern prolog_exec_mode PrologMode; +extern int CritLocks; #if SIZEOF_INT_P==4 #if defined(YAPOR) || defined(TABLING) @@ -1011,8 +1006,8 @@ extern int PrologMode; /************** Access to yap initial arguments ***************************/ -extern char **yap_args; -extern int yap_argc; +extern char **yap_args; +extern int yap_argc; #ifdef YAPOR #define YAPEnterCriticalSection() \ @@ -1022,17 +1017,46 @@ extern int yap_argc; GLOBAL_LOCKS_who_locked_heap = worker_id; \ } \ PrologMode |= CritMode; \ + CritLocks++; \ } #define YAPLeaveCriticalSection() \ { \ - if ((PrologMode ^= CritMode) & AbortMode) Abort((char *)NIL); \ - GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \ - UNLOCK(GLOBAL_LOCKS_heap_access); \ + CritLocks--; \ + if (!CritLocks) { \ + PrologMode &= ~CritMode; \ + if (PrologMode & InterruptMode) { \ + PrologMode &= ~InterruptMode; \ + ProcessSIGINT(); \ + } \ + if (PrologMode & AbortMode) { \ + PrologMode &= ~AbortMode; \ + Abort(""); \ + } \ + GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \ + UNLOCK(GLOBAL_LOCKS_heap_access); \ + } \ } #else -#define YAPEnterCriticalSection() PrologMode |= CritMode; -#define YAPLeaveCriticalSection() \ - if((PrologMode ^= CritMode) & AbortMode) Abort((char *)NIL); +#define YAPEnterCriticalSection() \ + { \ + PrologMode |= CritMode; \ + CritLocks++; \ + } +#define YAPLeaveCriticalSection() \ + { \ + CritLocks--; \ + if (!CritLocks) { \ + PrologMode &= ~CritMode; \ + if (PrologMode & InterruptMode) { \ + PrologMode &= ~InterruptMode; \ + ProcessSIGINT(); \ + } \ + if (PrologMode & AbortMode) { \ + PrologMode &= ~AbortMode; \ + Abort(""); \ + } \ + } \ + } #endif /* YAPOR */ /* when we are calling the InitStaff procedures */ @@ -1041,31 +1065,29 @@ extern int yap_argc; /********* whether we should try to compile array references ******************/ -extern int compile_arrays; +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 -{ +typedef struct TIMED_MAVAR{ CELL value; CELL clock; -} -timed_var; +} timed_var; /********* while debugging you may need some info ***********************/ #if DEBUG -extern int output_msg; +extern int output_msg; #endif #if EMACS -extern char emacs_tmp[], emacs_tmp2[]; +extern char emacs_tmp[], emacs_tmp2[]; #endif #if HAVE_SIGNAL -extern int snoozing; +extern int snoozing; #endif #if defined(YAPOR) || defined(TABLING) @@ -1077,3 +1099,4 @@ extern int snoozing; #if SBA #include "sbaunify.h" #endif + diff --git a/VC/include/Yatom.h b/VC/include/Yatom.h index 4df8002a0..991598ce5 100644 --- a/VC/include/Yatom.h +++ b/VC/include/Yatom.h @@ -1,1223 +1,1106 @@ - - - - - - - -/************************************************************************* -* * -* 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 unsigned int ArityOfFunctor (Functor); - -inline EXTERN unsigned int -ArityOfFunctor (Functor Fun) -{ - return (unsigned 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 -{ - 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 -{ - Prop NextOfPE; /* used to chain properties */ - PropFlags KindOfPE; /* kind of property */ - unsigned int ArityOfPE; /* arity of property */ - SMALLUNSGN StateOfPred; /* actual state of predicate */ - CODEADDR CodeOfPred; /* code address */ - CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ - Functor FunctorOfPred; /* functor for Predicate */ - CODEADDR FirstClause, LastClause; - CELL PredFlags; - Atom OwnerFile; /* File where the predicate was defined */ -#if defined(YAPOR) || defined(THREADS) - rwlock_t PRWLock; /* a simple lock to protect this entry */ -#endif -#ifdef TABLING - tab_ent_ptr TableOfPred; -#endif /* TABLING */ - OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ - profile_data StatisticsForPred; /* enable profiling for predicate */ - SMALLUNSGN ModuleOfPred; /* module for this definition */ -} -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 */ - 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 -extern SMALLUNSGN CurrentModule; - -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)); - -#ifdef XX_ADTDEFS_C -#ifndef inline - -/* look property list of atom a for kind */ -EXTERN inline Prop -GetAProp (a, kind) - Atom a; - PropFlags kind; -{ - register PropEntry *pp = RepProp (RepAtom (a)->PropOfAE); - while (!EndOfPAEntr (pp) && pp->KindOfPE != kind) - pp = RepProp (pp->NextOfPE); - return (AbsProp (pp)); -} - -/* get predicate entry for ap/arity; create it if neccessary. */ -EXTERN inline Prop -PredProp (ap, arity) - Atom ap; - unsigned int arity; -{ - Prop p0; - PredEntry *p = RepPredProp (p0 = RepAtom (ap)->PropOfAE); - while (p0 && (p->KindOfPE != 00 || p->ArityOfPE != arity || - (p->ModuleOfPred && p->ModuleOfPred != CurrentModule))) - p = RepPredProp (p0 = p->NextOfPE); - if (p0) - return (p0); - YAPEnterCriticalSection (); - p = (PredEntry *) AllocAtomSpace (sizeof (*p)); - p->KindOfPE = PEProp; - p->ArityOfPE = arity; - p->FirstClause = p->LastClause = NIL; - p->PredFlags = 0L; - p->StateOfPred = 0; - p->OwnerFile = AtomNil; - p->ModuleOfPred = CurrentModule; - p->OpcodeOfPred = opcode (_undef_p); - p->StatisticsForPred.NOfEntries = 0; - p->StatisticsForPred.NOfHeadSuccesses = 0; - p->StatisticsForPred.NOfRetries = 0; - p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR) (&(p->DefaultCodeOfPred)); - if (arity == 0) - p->FunctorOfPred = (Functor) ap; - else - p->FunctorOfPred = MkFunctor (ap, arity); - p->NextOfPE = RepAtom (ap)->PropOfAE; - RepAtom (ap)->PropOfAE = p0 = AbsPredProp (p); - YAPLeaveCriticalSection (); - return (p0); -} - -EXTERN inline Term -GetValue (a) - Atom a; -{ - Prop p0 = GetAProp (a, ValProperty); - if (p0 == 0) - return (MkAtomTerm (AtomNil)); - return (RepValProp (p0)->ValueOfVE); -} - - -EXTERN inline void -PutValue (a, v) - Atom a; - Term v; -{ - Prop p0 = GetAProp (a, ValProperty); - if (p0) - RepValProp (p0)->ValueOfVE = v; - else - { - ValEntry *p; - YAPEnterCriticalSection (); - p = (ValEntry *) AllocAtomSpace (sizeof (ValEntry)); - p->KindOfPE = ValProperty; - p->ValueOfVE = v; - p->NextOfPE = RepAtom (a)->PropOfAE; - RepAtom (a)->PropOfAE = AbsValProp (p); - YAPLeaveCriticalSection (); - } -} - -#endif /* inline */ -#else -/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */ -Prop STD_PROTO (GetAProp, (Atom, PropFlags)); -Prop STD_PROTO (LockedGetAProp, (AtomEntry *, PropFlags)); -Prop STD_PROTO (PredProp, (Atom, unsigned int)); -#endif /* ADTDEFS_C */ - - -#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 */ +/* 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 { + 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 { + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + unsigned int ArityOfPE; /* arity of property */ + SMALLUNSGN StateOfPred; /* actual state of predicate */ + CODEADDR CodeOfPred; /* code address */ + CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ + Functor FunctorOfPred; /* functor for Predicate */ + CODEADDR FirstClause, LastClause; + CELL PredFlags; + Atom OwnerFile; /* File where the predicate was defined */ +#if defined(YAPOR) || defined(THREADS) + rwlock_t PRWLock; /* a simple lock to protect this entry */ +#endif +#ifdef TABLING + tab_ent_ptr TableOfPred; +#endif /* TABLING */ + OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ + profile_data StatisticsForPred; /* enable profiling for predicate */ + SMALLUNSGN ModuleOfPred; /* module for this definition */ + } 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 */ + 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)); + +#ifdef XX_ADTDEFS_C +#ifndef inline + +/* look property list of atom a for kind */ +EXTERN inline Prop GetAProp(a,kind) +Atom a; +PropFlags kind; +{ register PropEntry *pp = RepProp(RepAtom(a)->PropOfAE); + while( !EndOfPAEntr(pp) && pp->KindOfPE!=kind) pp=RepProp(pp->NextOfPE); + return(AbsProp(pp)); +} + +/* get predicate entry for ap/arity; create it if neccessary. */ +EXTERN inline Prop PredProp(ap,arity) +Atom ap; +unsigned int arity; +{ + Prop p0; + PredEntry *p = RepPredProp(p0=RepAtom(ap)->PropOfAE); + while(p0 && (p->KindOfPE != 00 || p->ArityOfPE != arity || + (p->ModuleOfPred && p->ModuleOfPred != CurrentModule))) + p = RepPredProp(p0=p->NextOfPE); + if(p0) return(p0); + YAPEnterCriticalSection(); + p = (PredEntry *) AllocAtomSpace(sizeof(*p)); + p->KindOfPE = PEProp; + p->ArityOfPE = arity; + p->FirstClause = p->LastClause = NIL; + p->PredFlags = 0L; + p->StateOfPred = 0; + p->OwnerFile = AtomNil; + p->ModuleOfPred = CurrentModule; + p->OpcodeOfPred = opcode(_undef_p); + p->StatisticsForPred.NOfEntries = 0; + p->StatisticsForPred.NOfHeadSuccesses = 0; + p->StatisticsForPred.NOfRetries = 0; + p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->DefaultCodeOfPred)); + if (arity==0) p->FunctorOfPred = (Functor) ap; + else p->FunctorOfPred = MkFunctor(ap,arity); + p->NextOfPE = RepAtom(ap)->PropOfAE; + RepAtom(ap)->PropOfAE = p0 = AbsPredProp(p); + YAPLeaveCriticalSection(); + return(p0); +} + +EXTERN inline Term GetValue(a) +Atom a; +{ + Prop p0 = GetAProp(a,ValProperty); + if(p0==0) return(MkAtomTerm(AtomNil)); + return(RepValProp(p0)->ValueOfVE); +} + + +EXTERN inline void PutValue(a,v) +Atom a; Term v; +{ + Prop p0 = GetAProp(a,ValProperty); + if(p0) RepValProp(p0)->ValueOfVE = v; + else { + ValEntry *p; + YAPEnterCriticalSection(); + p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry)); + p->KindOfPE = ValProperty; + p->ValueOfVE = v; + p->NextOfPE = RepAtom(a)->PropOfAE; + RepAtom(a)->PropOfAE = AbsValProp(p); + YAPLeaveCriticalSection(); + } +} + +#endif /* inline */ +#else +/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */ +Prop STD_PROTO(GetAProp,(Atom,PropFlags)); +Prop STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags)); +Prop STD_PROTO(PredProp,(Atom,unsigned int)); +#endif /* ADTDEFS_C */ + + +#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 9d65cf0ab..8e8429d2f 100644 --- a/VC/include/sshift.h +++ b/VC/include/sshift.h @@ -1,604 +1,555 @@ - - - - - - - -/************************************************************************* -* * -* 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: sshift.h * -* Last rev: 19/2/88 * -* mods: * -* comments: stack shifter functionality for YAP * -* * -*************************************************************************/ - - -/* The difference between the old stack pointers and the new ones */ -extern Int HDiff, GDiff, LDiff, TrDiff, XDiff, DelayDiff; - -/* The old stack pointers */ -extern CELL *OldASP, *OldLCL0; -extern tr_fr_ptr OldTR; -extern CELL *OldGlobalBase, *OldH, *OldH0; -extern ADDR OldTrailBase, OldTrailTop; -extern ADDR OldHeapBase, OldHeapTop; - -#define CharP(ptr) ((char *) (ptr)) - - -inline EXTERN int IsHeapP (CELL *); - -inline EXTERN int -IsHeapP (CELL * ptr) -{ - return (int) ((ptr >= (CELL *) HeapBase && ptr <= (CELL *) HeapTop)); -} - - - -/* Adjusting cells and pointers to cells */ - -inline EXTERN CELL *PtoGloAdjust (CELL *); - -inline EXTERN CELL * -PtoGloAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + GDiff))); -} - - - -inline EXTERN CELL *PtoDelayAdjust (CELL *); - -inline EXTERN CELL * -PtoDelayAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + DelayDiff))); -} - - - -inline EXTERN tr_fr_ptr PtoTRAdjust (tr_fr_ptr); - -inline EXTERN tr_fr_ptr -PtoTRAdjust (tr_fr_ptr ptr) -{ - return (tr_fr_ptr) (((tr_fr_ptr) (CharP (ptr) + TrDiff))); -} - - - -inline EXTERN CELL *CellPtoTRAdjust (CELL *); - -inline EXTERN CELL * -CellPtoTRAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + TrDiff))); -} - - - -inline EXTERN CELL *PtoLocAdjust (CELL *); - -inline EXTERN CELL * -PtoLocAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + LDiff))); -} - - - -inline EXTERN choiceptr ChoicePtrAdjust (choiceptr); - -inline EXTERN choiceptr -ChoicePtrAdjust (choiceptr ptr) -{ - return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); -} - - -#ifdef TABLING - -inline EXTERN choiceptr ConsumerChoicePtrAdjust (choiceptr); - -inline EXTERN choiceptr -ConsumerChoicePtrAdjust (choiceptr ptr) -{ - return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); -} - - - -inline EXTERN choiceptr GeneratorChoicePtrAdjust (choiceptr); - -inline EXTERN choiceptr -GeneratorChoicePtrAdjust (choiceptr ptr) -{ - return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); -} - - -#endif /* TABLING */ - - -inline EXTERN CELL GlobalAdjust (CELL); - -inline EXTERN CELL -GlobalAdjust (CELL val) -{ - return (CELL) ((val + GDiff)); -} - - - -inline EXTERN CELL DelayAdjust (CELL); - -inline EXTERN CELL -DelayAdjust (CELL val) -{ - return (CELL) ((val + DelayDiff)); -} - - - -inline EXTERN ADDR GlobalAddrAdjust (ADDR); - -inline EXTERN ADDR -GlobalAddrAdjust (ADDR ptr) -{ - return (ADDR) ((ptr + GDiff)); -} - - - -inline EXTERN ADDR DelayAddrAdjust (ADDR); - -inline EXTERN ADDR -DelayAddrAdjust (ADDR ptr) -{ - return (ADDR) ((ptr + DelayDiff)); -} - - - -inline EXTERN CELL LocalAdjust (CELL); - -inline EXTERN CELL -LocalAdjust (CELL val) -{ - return (CELL) ((val + LDiff)); -} - - - -inline EXTERN ADDR LocalAddrAdjust (ADDR); - -inline EXTERN ADDR -LocalAddrAdjust (ADDR ptr) -{ - return (ADDR) ((ptr + LDiff)); -} - - - -inline EXTERN CELL TrailAdjust (CELL); - -inline EXTERN CELL -TrailAdjust (CELL val) -{ - return (CELL) ((val + TrDiff)); -} - - - -inline EXTERN ADDR TrailAddrAdjust (ADDR); - -inline EXTERN ADDR -TrailAddrAdjust (ADDR ptr) -{ - return (ADDR) ((ptr + TrDiff)); -} - - -/* heap data structures */ - -inline EXTERN Functor FuncAdjust (Functor); - -inline EXTERN Functor -FuncAdjust (Functor f) -{ - return (Functor) ((Functor) (CharP (f) + HDiff)); -} - - - -inline EXTERN CELL *CellPtoHeapAdjust (CELL *); - -inline EXTERN CELL * -CellPtoHeapAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + HDiff))); -} - - -#if USE_OFFSETS - -inline EXTERN Atom AtomAdjust (Atom); - -inline EXTERN Atom -AtomAdjust (Atom at) -{ - return (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) -{ - return (Prop) ((p)); -} - - -#else - -inline EXTERN Atom AtomAdjust (Atom); - -inline EXTERN Atom -AtomAdjust (Atom at) -{ - return (Atom) ((Atom) (CharP (at) + HDiff)); -} - - -#if MMAP_ADDR >= 0x40000000 - -inline EXTERN Term AtomTermAdjust (Term); - -inline EXTERN Term -AtomTermAdjust (Term at) -{ - return (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); - -inline EXTERN Term -BlobTermAdjust (Term t) -{ - return (Term) ((t - HDiff)); -} - - -#else - -inline EXTERN Term BlobTermAdjust (Term); - -inline EXTERN Term -BlobTermAdjust (Term t) -{ - return (Term) ((t + HDiff)); -} - - -#endif - -inline EXTERN AtomEntry *AtomEntryAdjust (AtomEntry *); - -inline EXTERN AtomEntry * -AtomEntryAdjust (AtomEntry * at) -{ - return (AtomEntry *) ((AtomEntry *) (CharP (at) + HDiff)); -} - - - -inline EXTERN consult_obj *ConsultObjAdjust (consult_obj *); - -inline EXTERN consult_obj * -ConsultObjAdjust (consult_obj * co) -{ - return (consult_obj *) ((consult_obj *) (CharP (co) + HDiff)); -} - - - -inline EXTERN DBRef DBRefAdjust (DBRef); - -inline EXTERN DBRef -DBRefAdjust (DBRef dbr) -{ - return (DBRef) ((DBRef) (CharP (dbr) + HDiff)); -} - - - -inline EXTERN Term CodeAdjust (Term); - -inline EXTERN Term -CodeAdjust (Term dbr) -{ - return (Term) (((Term) (dbr) + HDiff)); -} - - - -inline EXTERN ADDR AddrAdjust (ADDR); - -inline EXTERN ADDR -AddrAdjust (ADDR addr) -{ - return (ADDR) ((ADDR) (CharP (addr) + HDiff)); -} - - - -inline EXTERN CODEADDR CodeAddrAdjust (CODEADDR); - -inline EXTERN CODEADDR -CodeAddrAdjust (CODEADDR addr) -{ - return (CODEADDR) ((CODEADDR) (CharP (addr) + HDiff)); -} - - - -inline EXTERN BlockHeader *BlockAdjust (BlockHeader *); - -inline EXTERN BlockHeader * -BlockAdjust (BlockHeader * addr) -{ - return (BlockHeader *) ((BlockHeader *) (CharP (addr) + HDiff)); -} - - - -inline EXTERN yamop *PtoOpAdjust (yamop *); - -inline EXTERN yamop * -PtoOpAdjust (yamop * ptr) -{ - return (yamop *) (((yamop *) (CharP (ptr) + HDiff))); -} - - - -inline EXTERN CELL *PtoHeapCellAdjust (CELL *); - -inline EXTERN CELL * -PtoHeapCellAdjust (CELL * ptr) -{ - return (CELL *) (((CELL *) (CharP (ptr) + HDiff))); -} - - - -inline EXTERN PredEntry *PtoPredAdjust (PredEntry *); - -inline EXTERN PredEntry * -PtoPredAdjust (PredEntry * ptr) -{ - return (PredEntry *) (((CELL *) (CharP (ptr) + HDiff))); -} - - -#if PRECOMPUTE_REGADDRESS - -inline EXTERN AREG XAdjust (AREG); - -inline EXTERN AREG -XAdjust (AREG reg) -{ - return (AREG) ((AREG) ((reg) + XDiff)); -} - - -#else - -inline EXTERN AREG XAdjust (AREG); - -inline EXTERN AREG -XAdjust (AREG reg) -{ - return (AREG) ((reg)); -} - - -#endif - -inline EXTERN YREG YAdjust (YREG); - -inline EXTERN YREG -YAdjust (YREG reg) -{ - return (YREG) ((reg)); -} - - - - -inline EXTERN int IsOldLocal (CELL); - -inline EXTERN int -IsOldLocal (CELL reg) -{ - return (int) (IN_BETWEEN (OldASP, reg, OldLCL0)); -} - - - -/* require because the trail might contain dangling pointers */ - -inline EXTERN int IsOldLocalInTR (CELL); - -inline EXTERN int -IsOldLocalInTR (CELL reg) -{ - return (int) (IN_BETWEEN (OldH, reg, OldLCL0)); -} - - - -inline EXTERN int IsOldLocalInTRPtr (CELL *); - -inline EXTERN int -IsOldLocalInTRPtr (CELL * ptr) -{ - return (int) (IN_BETWEEN (OldH, ptr, OldLCL0)); -} - - - - -inline EXTERN int IsOldH (CELL); - -inline EXTERN int -IsOldH (CELL reg) -{ - return (int) ((CharP (reg) == CharP (OldH))); -} - - - - - -inline EXTERN int IsOldGlobal (CELL); - -inline EXTERN int -IsOldGlobal (CELL reg) -{ - return (int) (IN_BETWEEN (OldH0, reg, OldH)); -} - - - -inline EXTERN int IsOldGlobalPtr (CELL *); - -inline EXTERN int -IsOldGlobalPtr (CELL * ptr) -{ - return (int) (IN_BETWEEN (OldH0, ptr, OldH)); -} - - - -inline EXTERN int IsOldDelay (CELL); - -inline EXTERN int -IsOldDelay (CELL reg) -{ - return (int) (IN_BETWEEN (OldGlobalBase, reg, OldH0)); -} - - - -inline EXTERN int IsOldDelayPtr (CELL *); - -inline EXTERN int -IsOldDelayPtr (CELL * ptr) -{ - return (int) (IN_BETWEEN (OldGlobalBase, ptr, OldH0)); -} - - - -inline EXTERN int IsOldTrail (CELL); - -inline EXTERN int -IsOldTrail (CELL reg) -{ - return (int) (IN_BETWEEN (OldTrailBase, reg, OldTR)); -} - - - -inline EXTERN int IsOldTrailPtr (CELL *); - -inline EXTERN int -IsOldTrailPtr (CELL * ptr) -{ - return (int) (IN_BETWEEN (OldTrailBase, ptr, OldTR)); -} - - - -inline EXTERN int IsOldCode (CELL); - -inline EXTERN int -IsOldCode (CELL reg) -{ - return (int) (IN_BETWEEN (OldHeapBase, reg, OldHeapTop)); -} - - - -inline EXTERN int IsOldCodeCellPtr (CELL *); - -inline EXTERN int -IsOldCodeCellPtr (CELL * ptr) -{ - return (int) (IN_BETWEEN (OldHeapBase, ptr, OldHeapTop)); -} - - - -inline EXTERN int IsGlobal (CELL); - -inline EXTERN int -IsGlobal (CELL reg) -{ - return (int) (IN_BETWEEN (GlobalBase, reg, H)); -} - - - -void STD_PROTO (AdjustStacksAndTrail, (void)); -void STD_PROTO (AdjustRegs, (int)); + + + + + + + +/************************************************************************* +* * +* 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: sshift.h * +* Last rev: 19/2/88 * +* mods: * +* comments: stack shifter functionality for YAP * +* * +*************************************************************************/ + + +/* The difference between the old stack pointers and the new ones */ +extern Int HDiff, + GDiff, + LDiff, + TrDiff, + XDiff, + DelayDiff; + +/* The old stack pointers */ +extern CELL *OldASP, *OldLCL0; +extern tr_fr_ptr OldTR; +extern CELL *OldGlobalBase, *OldH, *OldH0; +extern ADDR OldTrailBase, OldTrailTop; +extern ADDR OldHeapBase, OldHeapTop; + +#define CharP(ptr) ((char *) (ptr)) + + +inline EXTERN int IsHeapP(CELL *); + +inline EXTERN int IsHeapP(CELL * ptr) +{ + return (int) ((ptr >= (CELL *)HeapBase && ptr <= (CELL *)HeapTop) ); +} + + + +/* Adjusting cells and pointers to cells */ + +inline EXTERN CELL * PtoGloAdjust(CELL *); + +inline EXTERN CELL * PtoGloAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + GDiff)) ); +} + + + +inline EXTERN CELL * PtoDelayAdjust(CELL *); + +inline EXTERN CELL * PtoDelayAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + DelayDiff)) ); +} + + + +inline EXTERN tr_fr_ptr PtoTRAdjust(tr_fr_ptr); + +inline EXTERN tr_fr_ptr PtoTRAdjust(tr_fr_ptr ptr) +{ + return (tr_fr_ptr) (((tr_fr_ptr)(CharP(ptr) + TrDiff)) ); +} + + + +inline EXTERN CELL * CellPtoTRAdjust(CELL *); + +inline EXTERN CELL * CellPtoTRAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + TrDiff)) ); +} + + + +inline EXTERN CELL * PtoLocAdjust(CELL *); + +inline EXTERN CELL * PtoLocAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + LDiff)) ); +} + + + +inline EXTERN choiceptr ChoicePtrAdjust(choiceptr); + +inline EXTERN choiceptr ChoicePtrAdjust(choiceptr ptr) +{ + return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) ); +} + + +#ifdef TABLING + +inline EXTERN choiceptr ConsumerChoicePtrAdjust(choiceptr); + +inline EXTERN choiceptr ConsumerChoicePtrAdjust(choiceptr ptr) +{ + return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) ); +} + + + +inline EXTERN choiceptr GeneratorChoicePtrAdjust(choiceptr); + +inline EXTERN choiceptr GeneratorChoicePtrAdjust(choiceptr ptr) +{ + return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) ); +} + + +#endif /* TABLING */ + + +inline EXTERN CELL GlobalAdjust(CELL); + +inline EXTERN CELL GlobalAdjust(CELL val) +{ + return (CELL) ((val+GDiff) ); +} + + + +inline EXTERN CELL DelayAdjust(CELL); + +inline EXTERN CELL DelayAdjust(CELL val) +{ + return (CELL) ((val+DelayDiff) ); +} + + + +inline EXTERN ADDR GlobalAddrAdjust(ADDR); + +inline EXTERN ADDR GlobalAddrAdjust(ADDR ptr) +{ + return (ADDR) ((ptr+GDiff) ); +} + + + +inline EXTERN ADDR DelayAddrAdjust(ADDR); + +inline EXTERN ADDR DelayAddrAdjust(ADDR ptr) +{ + return (ADDR) ((ptr+DelayDiff) ); +} + + + +inline EXTERN CELL LocalAdjust(CELL); + +inline EXTERN CELL LocalAdjust(CELL val) +{ + return (CELL) ((val+LDiff) ); +} + + + +inline EXTERN ADDR LocalAddrAdjust(ADDR); + +inline EXTERN ADDR LocalAddrAdjust(ADDR ptr) +{ + return (ADDR) ((ptr+LDiff) ); +} + + + +inline EXTERN CELL TrailAdjust(CELL); + +inline EXTERN CELL TrailAdjust(CELL val) +{ + return (CELL) ((val+TrDiff) ); +} + + + +inline EXTERN ADDR TrailAddrAdjust(ADDR); + +inline EXTERN ADDR TrailAddrAdjust(ADDR ptr) +{ + return (ADDR) ((ptr+TrDiff) ); +} + + +/* heap data structures */ + +inline EXTERN Functor FuncAdjust(Functor); + +inline EXTERN Functor FuncAdjust(Functor f) +{ + return (Functor) ((Functor)(CharP(f)+HDiff) ); +} + + + +inline EXTERN CELL * CellPtoHeapAdjust(CELL *); + +inline EXTERN CELL * CellPtoHeapAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + HDiff)) ); +} + + +#if USE_OFFSETS + +inline EXTERN Atom AtomAdjust(Atom); + +inline EXTERN Atom AtomAdjust(Atom at) +{ + return (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) +{ + return (Prop) ((p) ); +} + + +#else + +inline EXTERN Atom AtomAdjust(Atom); + +inline EXTERN Atom AtomAdjust(Atom at) +{ + return (Atom) ((Atom)(CharP(at)+HDiff) ); +} + + +#if MMAP_ADDR >= 0x40000000 + +inline EXTERN Term AtomTermAdjust(Term); + +inline EXTERN Term AtomTermAdjust(Term at) +{ + return (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); + +inline EXTERN Term BlobTermAdjust(Term t) +{ + return (Term) ((t-HDiff) ); +} + + +#else + +inline EXTERN Term BlobTermAdjust(Term); + +inline EXTERN Term BlobTermAdjust(Term t) +{ + return (Term) ((t+HDiff) ); +} + + +#endif + +inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry *); + +inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry * at) +{ + return (AtomEntry *) ((AtomEntry *)(CharP(at)+HDiff) ); +} + + + +inline EXTERN consult_obj * ConsultObjAdjust(consult_obj *); + +inline EXTERN consult_obj * ConsultObjAdjust(consult_obj * co) +{ + return (consult_obj *) ((consult_obj *)(CharP(co)+HDiff) ); +} + + + +inline EXTERN DBRef DBRefAdjust(DBRef); + +inline EXTERN DBRef DBRefAdjust(DBRef dbr) +{ + return (DBRef) ((DBRef)(CharP(dbr)+HDiff) ); +} + + + +inline EXTERN Term CodeAdjust(Term); + +inline EXTERN Term CodeAdjust(Term dbr) +{ + return (Term) (((Term)(dbr)+HDiff) ); +} + + + +inline EXTERN ADDR AddrAdjust(ADDR); + +inline EXTERN ADDR AddrAdjust(ADDR addr) +{ + return (ADDR) ((ADDR)(CharP(addr)+HDiff) ); +} + + + +inline EXTERN CODEADDR CodeAddrAdjust(CODEADDR); + +inline EXTERN CODEADDR CodeAddrAdjust(CODEADDR addr) +{ + return (CODEADDR) ((CODEADDR)(CharP(addr)+HDiff) ); +} + + + +inline EXTERN BlockHeader * BlockAdjust(BlockHeader *); + +inline EXTERN BlockHeader * BlockAdjust(BlockHeader * addr) +{ + return (BlockHeader *) ((BlockHeader *)(CharP(addr)+HDiff) ); +} + + + +inline EXTERN yamop * PtoOpAdjust(yamop *); + +inline EXTERN yamop * PtoOpAdjust(yamop * ptr) +{ + return (yamop *) (((yamop *)(CharP(ptr) + HDiff)) ); +} + + + +inline EXTERN CELL * PtoHeapCellAdjust(CELL *); + +inline EXTERN CELL * PtoHeapCellAdjust(CELL * ptr) +{ + return (CELL *) (((CELL *)(CharP(ptr) + HDiff)) ); +} + + + +inline EXTERN PredEntry * PtoPredAdjust(PredEntry *); + +inline EXTERN PredEntry * PtoPredAdjust(PredEntry * ptr) +{ + return (PredEntry *) (((CELL *)(CharP(ptr) + HDiff)) ); +} + + +#if PRECOMPUTE_REGADDRESS + +inline EXTERN AREG XAdjust(AREG); + +inline EXTERN AREG XAdjust(AREG reg) +{ + return (AREG) ((AREG)((reg)+XDiff) ); +} + + +#else + +inline EXTERN AREG XAdjust(AREG); + +inline EXTERN AREG XAdjust(AREG reg) +{ + return (AREG) ((reg) ); +} + + +#endif + +inline EXTERN YREG YAdjust(YREG); + +inline EXTERN YREG YAdjust(YREG reg) +{ + return (YREG) ((reg) ); +} + + + + +inline EXTERN int IsOldLocal(CELL); + +inline EXTERN int IsOldLocal(CELL reg) +{ + return (int) (IN_BETWEEN(OldASP, reg, OldLCL0)); +} + + + +/* require because the trail might contain dangling pointers */ + +inline EXTERN int IsOldLocalInTR(CELL); + +inline EXTERN int IsOldLocalInTR(CELL reg) +{ + return (int) (IN_BETWEEN(OldH, reg, OldLCL0) ); +} + + + +inline EXTERN int IsOldLocalInTRPtr(CELL *); + +inline EXTERN int IsOldLocalInTRPtr(CELL * ptr) +{ + return (int) (IN_BETWEEN(OldH, ptr, OldLCL0) ); +} + + + + +inline EXTERN int IsOldH(CELL); + +inline EXTERN int IsOldH(CELL reg) +{ + return (int) (( CharP(reg) == CharP(OldH) ) ); +} + + + + + +inline EXTERN int IsOldGlobal(CELL); + +inline EXTERN int IsOldGlobal(CELL reg) +{ + return (int) (IN_BETWEEN(OldH0, reg, OldH) ); +} + + + +inline EXTERN int IsOldGlobalPtr(CELL *); + +inline EXTERN int IsOldGlobalPtr(CELL * ptr) +{ + return (int) (IN_BETWEEN( OldH0, ptr, OldH) ); +} + + + +inline EXTERN int IsOldDelay(CELL); + +inline EXTERN int IsOldDelay(CELL reg) +{ + return (int) (IN_BETWEEN(OldGlobalBase, reg, OldH0) ); +} + + + +inline EXTERN int IsOldDelayPtr(CELL *); + +inline EXTERN int IsOldDelayPtr(CELL * ptr) +{ + return (int) (IN_BETWEEN( OldGlobalBase, ptr, OldH0) ); +} + + + +inline EXTERN int IsOldTrail(CELL); + +inline EXTERN int IsOldTrail(CELL reg) +{ + return (int) (IN_BETWEEN(OldTrailBase, reg, OldTR) ); +} + + + +inline EXTERN int IsOldTrailPtr(CELL *); + +inline EXTERN int IsOldTrailPtr(CELL * ptr) +{ + return (int) (IN_BETWEEN(OldTrailBase, ptr, OldTR) ); +} + + + +inline EXTERN int IsOldCode(CELL); + +inline EXTERN int IsOldCode(CELL reg) +{ + return (int) (IN_BETWEEN(OldHeapBase, reg, OldHeapTop) ); +} + + + +inline EXTERN int IsOldCodeCellPtr(CELL *); + +inline EXTERN int IsOldCodeCellPtr(CELL * ptr) +{ + return (int) (IN_BETWEEN(OldHeapBase, ptr, OldHeapTop) ); +} + + + +inline EXTERN int IsGlobal(CELL); + +inline EXTERN int IsGlobal(CELL reg) +{ + return (int) (IN_BETWEEN(GlobalBase, reg, H) ); +} + + + +void STD_PROTO(AdjustStacksAndTrail, (void)); +void STD_PROTO(AdjustRegs, (int)); diff --git a/changes4.3.html b/changes4.3.html index b241437e2..89d74da7f 100644 --- a/changes4.3.html +++ b/changes4.3.html @@ -16,6 +16,8 @@

Yap-4.3.19:

    +
  • FIXED: fflush(NULL) broken in some machines (Stasinos).
    • +
  • FIXED: don't flush input streams (Stasinos).
  • FIXED: new statistics/0.
  • FIXED: use 15 bits of precision for floats, instead of the default 6..
    • diff --git a/distribute b/distribute index f0c429670..46c1ebf61 100755 --- a/distribute +++ b/distribute @@ -15,7 +15,7 @@ splat cd include splat /bin/cp config.h config.h.mine -/bin/cp ../../linux/*.h . +/bin/cp ../../../bins/cyg/*.h . /bin/mv config.h.mine config.h cd ../../console splat @@ -45,7 +45,7 @@ cd ../CHR splat cd ../.. if test "$1" = "--small"; then - tar cvzf "$version".tar.gz "$version"/{INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/*.pl,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,build-distr,OPTYap,CLPQR,CHR} + tar cvzf "$version".tar.gz "$version"/{INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL/README,LGPL/CVS,LGPL/pillow/[C-Z]*,LGPL/pillow/*.pl,LGPL/pillow/doc/*info*,build-distr,OPTYap,CLPQR,CHR} else tar cvzf "$version".tar.gz "$version"/{INSTALL,README*,changes*,config*,install-sh,Makefile.in,.depend.in,distribute,C,H,VC,console,docs,include,library,m4,misc,pl,LGPL,build-distr,OPTYap,CLPQR,CHR} fi diff --git a/pl/errors.yap b/pl/errors.yap index 4ec5548cf..0b2fcd058 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -188,9 +188,9 @@ print_message(help,M) :- '$output_error_message'(existence_error(source_sink,F), W) :- format(user_error,"[ EXISTENCE ERROR- ~w could not find file ~w ]~n", [W,F]). -'$output_error_message'(existence_error(stream,_), Where) :- - format(user_error,"[ EXISTENCE ERROR- ~w: not an open stream ]~n", - [Where]). +'$output_error_message'(existence_error(stream,Stream), Where) :- + format(user_error,"[ EXISTENCE ERROR- ~w: ~w not an open stream ]~n", + [Where,Stream]). '$output_error_message'(evaluation_error(int_overflow), Where) :- format(user_error,"[ INTEGER OVERFLOW ERROR- ~w ]~n", [Where]). diff --git a/pl/init.yap b/pl/init.yap index 5cde42a9a..a64e41553 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -33,7 +33,7 @@ not(G) :- not(G). (:- G) :- '$execute'(G), !. '$$!'(CP) :- '$cut_by'(CP). -:- '$set_value'($doindex,true). +:- '$set_value'('$doindex',true). :- ['errors.yap', 'utils.yap',