fix fflush
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@125 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
3e6060a84f
commit
eade18026c
19
C/iopreds.c
19
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);
|
||||
}
|
||||
|
||||
|
|
|
|||
33
C/save.c
33
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 */
|
||||
|
|
|
|||
11
C/sysbits.c
11
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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0x00000007L */ MKTAG(0x1,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define LowBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define HighTagBits /* 0x0000000cL */ MKTAG(0x1,0)
|
||||
#define NumberTag /* 0x0000000dL */ MKTAG(0x1,2)
|
||||
#define AtomTag /* 0x00000006L */ MKTAG(0x0,2)
|
||||
|
||||
/*
|
||||
subtract the total for tag bits, plus 1 bit for GC, plus another
|
||||
for sign
|
||||
*/
|
||||
#define MAX_ABS_INT ((Int)0x04000000L)
|
||||
|
||||
/*
|
||||
UNIQUE_TAG_FOR_PAIR gives the representation for pair an
|
||||
unique tag
|
||||
|
||||
This allows optimisation of switch_list
|
||||
|
||||
*/
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
|
||||
#define PairBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define ApplBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define PrimiBits /* 0x00000002L */ MKTAG(0x0,2)
|
||||
#define NumberBits /* 0x0000000aL */ MKTAG(0x2,2)
|
||||
#define NumberMask /* 0x0000000bL */ MKTAG(0x2,3)
|
||||
|
||||
#define NonTagPart(V) (Unsigned(V)>>(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_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0x00000007L */ MKTAG(0x1,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define LowBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define HighTagBits /* 0x0000000cL */ MKTAG(0x1,0)
|
||||
#define NumberTag /* 0x0000000dL */ MKTAG(0x1,2)
|
||||
#define AtomTag /* 0x00000006L */ MKTAG(0x0,2)
|
||||
|
||||
/*
|
||||
subtract the total for tag bits, plus 1 bit for GC, plus another
|
||||
for sign
|
||||
*/
|
||||
#define MAX_ABS_INT ((Int)0x04000000L)
|
||||
|
||||
/*
|
||||
UNIQUE_TAG_FOR_PAIR gives the representation for pair an
|
||||
unique tag
|
||||
|
||||
This allows optimisation of switch_list
|
||||
|
||||
*/
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
|
||||
#define PairBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define ApplBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define PrimiBits /* 0x00000002L */ MKTAG(0x0,2)
|
||||
#define NumberBits /* 0x0000000aL */ MKTAG(0x2,2)
|
||||
#define NumberMask /* 0x0000000bL */ MKTAG(0x2,3)
|
||||
|
||||
#define NonTagPart(V) (Unsigned(V)>>(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));
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0xb0000003L */ MKTAG(0x5,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define LowBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define HighTagBits /* 0xf0000000L */ MKTAG(0x7,0)
|
||||
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskAdr /* 0x1ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define MaskPrim /* 0x0ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define NumberTag /* 0xb0000001L */ MKTAG(0x5,2)
|
||||
#define AtomTag /* 0x90000001L */ MKTAG(0x4,2)
|
||||
#define MAX_ABS_INT /* 0xfe00000LL */ ((Int)0x04000000L)
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe0000000L
|
||||
|
||||
#define MaskBits 4
|
||||
|
||||
/*
|
||||
UNIQUE_TAG_FOR_PAIR gives the representation for pair an
|
||||
unique tag
|
||||
|
||||
This allows optimisation of switch_list
|
||||
|
||||
*/
|
||||
#if defined(i386) || defined(sparc) || defined(_POWER)
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
#endif
|
||||
|
||||
#if UNIQUE_TAG_FOR_PAIRS
|
||||
#define PairBit /* 0x00000001L */ 1
|
||||
#define ApplBit /* 0x00000000L */ 0
|
||||
#else
|
||||
#define PairBit /* 0x00000000L */ 0
|
||||
#define ApplBit /* 0x00000001L */ 1
|
||||
#endif
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2))
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<2)
|
||||
#define BitOn(Bit,V) (Bit & Unsigned(V))
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
/* never forget to surround arguments to a macro by brackets */
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
|
||||
#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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0xb0000003L */ MKTAG(0x5,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define LowBit /* 0x00000001L */ MKTAG(0x0,1)
|
||||
#define HighTagBits /* 0xf0000000L */ MKTAG(0x7,0)
|
||||
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskAdr /* 0x1ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define MaskPrim /* 0x0ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define NumberTag /* 0xb0000001L */ MKTAG(0x5,2)
|
||||
#define AtomTag /* 0x90000001L */ MKTAG(0x4,2)
|
||||
#define MAX_ABS_INT /* 0xfe00000LL */ ((Int)0x04000000L)
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe0000000L
|
||||
|
||||
#define MaskBits 4
|
||||
|
||||
/*
|
||||
UNIQUE_TAG_FOR_PAIR gives the representation for pair an
|
||||
unique tag
|
||||
|
||||
This allows optimisation of switch_list
|
||||
|
||||
*/
|
||||
#if defined(i386) || defined(sparc) || defined(_POWER)
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
#endif
|
||||
|
||||
#if UNIQUE_TAG_FOR_PAIRS
|
||||
#define PairBit /* 0x00000001L */ 1
|
||||
#define ApplBit /* 0x00000000L */ 0
|
||||
#else
|
||||
#define PairBit /* 0x00000000L */ 0
|
||||
#define ApplBit /* 0x00000001L */ 1
|
||||
#endif
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2))
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<2)
|
||||
#define BitOn(Bit,V) (Bit & Unsigned(V))
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
/* never forget to surround arguments to a macro by brackets */
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
|
||||
#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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0xe0000003L */ MKTAG(0x7,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define HighTagBits /* 0xe0000000L */ MKTAG(0x7,0)
|
||||
#define AdrHiBit /* 0x10000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskAdr /* 0x1ffffffcL */ ((((UInt)1) << SHIFT_HIGH_TAG)-4)
|
||||
#define MaskPrim /* 0x0ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define NumberTag /* 0xa0000000L */ MKTAG(0x5,0)
|
||||
#define AtomTag /* 0x80000000L */ MKTAG(0x4,0)
|
||||
#define PairTag /* 0x80000001L */ MKTAG(0x4,1)
|
||||
#define ApplTag /* 0x80000002L */ MKTAG(0x4,2)
|
||||
#define MAX_ABS_INT /* 0x04000000L */ (1 << (SHIFT_HIGH_TAG-3))
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe0000000L
|
||||
|
||||
#define MaskBits 4
|
||||
|
||||
#define PairBit /* 0x00000001L */ 1
|
||||
#define ApplBit /* 0x00000002L */ 2
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2))
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<2)
|
||||
#define BitOn(Bit,V) (Bit & Unsigned(V))
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
|
||||
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) & 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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0xe0000003L */ MKTAG(0x7,3)
|
||||
#define LowTagBits /* 0x00000003L */ MKTAG(0x0,3)
|
||||
#define HighTagBits /* 0xe0000000L */ MKTAG(0x7,0)
|
||||
#define AdrHiBit /* 0x10000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskAdr /* 0x1ffffffcL */ ((((UInt)1) << SHIFT_HIGH_TAG)-4)
|
||||
#define MaskPrim /* 0x0ffffffcL */ ((((UInt)1) << (SHIFT_HIGH_TAG))-4)
|
||||
#define NumberTag /* 0xa0000000L */ MKTAG(0x5,0)
|
||||
#define AtomTag /* 0x80000000L */ MKTAG(0x4,0)
|
||||
#define PairTag /* 0x80000001L */ MKTAG(0x4,1)
|
||||
#define ApplTag /* 0x80000002L */ MKTAG(0x4,2)
|
||||
#define MAX_ABS_INT /* 0x04000000L */ (1 << (SHIFT_HIGH_TAG-3))
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe0000000L
|
||||
|
||||
#define MaskBits 4
|
||||
|
||||
#define PairBit /* 0x00000001L */ 1
|
||||
#define ApplBit /* 0x00000002L */ 2
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<2))
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<2)
|
||||
#define BitOn(Bit,V) (Bit & Unsigned(V))
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
|
||||
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) & 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));
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0x30000007L */ MKTAG(0x1,7)
|
||||
#define LowTagBits /* 0x00000007L */ MKTAG(0x0,7)
|
||||
#define HighTagBits /* 0x70000000L */ MKTAG(0x1,0)
|
||||
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8)
|
||||
#define NumberTag /* 0x30000001L */ MKTAG(0x1,1)
|
||||
#define AtomTag /* 0x10000001L */ MKTAG(0x0,1)
|
||||
#define MAX_ABS_INT /* 0xfe00000LL */ (((UInt)1) << (63-(2+4)))
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe000000000000000L
|
||||
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
|
||||
#define PrimiBit /* 0x00000001L */ 1
|
||||
#define PairBits /* 0x00000003L */ 3
|
||||
#define ApplBits /* 0x00000005L */ 5
|
||||
#define PrimiBits /* 0x70000004L */ MKTAG(0x7,7)
|
||||
#define NumberMask /* 0x20000007L */ MKTAG(0x2,7)
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<3) /* SQRT(8) */
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
|
||||
inline EXTERN int IsVarTerm (Term);
|
||||
|
||||
inline EXTERN int
|
||||
IsVarTerm (Term t)
|
||||
{
|
||||
return (int) ((!((t) & 0x1)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN int IsNonVarTerm (Term);
|
||||
|
||||
inline EXTERN int
|
||||
IsNonVarTerm (Term t)
|
||||
{
|
||||
return (int) (((t) & 0x1));
|
||||
}
|
||||
|
||||
|
||||
|
||||
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) (((CELL) (p) + PairBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsPairTerm (Term);
|
||||
|
||||
inline EXTERN Int
|
||||
IsPairTerm (Term t)
|
||||
{
|
||||
return (Int) (((t) & 0x2));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Term *RepAppl (Term);
|
||||
|
||||
inline EXTERN Term *
|
||||
RepAppl (Term t)
|
||||
{
|
||||
return (Term *) (((t) - ApplBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Term AbsAppl (Term *);
|
||||
|
||||
inline EXTERN Term
|
||||
AbsAppl (Term * p)
|
||||
{
|
||||
return (Term) (((CELL) (p) + ApplBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsApplTerm (Term);
|
||||
|
||||
inline EXTERN Int
|
||||
IsApplTerm (Term t)
|
||||
{
|
||||
return (Int) ((((t) & 0x4)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsAtomOrIntTerm (Term);
|
||||
|
||||
inline EXTERN Int
|
||||
IsAtomOrIntTerm (Term t)
|
||||
{
|
||||
return (Int) ((((t) & LowTagBits) == 0x1));
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
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) (Unsigned (t) << 3) >> 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))<<SHIFT_HIGH_TAG)|(LO))
|
||||
|
||||
#define TagBits /* 0x30000007L */ MKTAG(0x1,7)
|
||||
#define LowTagBits /* 0x00000007L */ MKTAG(0x0,7)
|
||||
#define HighTagBits /* 0x70000000L */ MKTAG(0x1,0)
|
||||
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
|
||||
#define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8)
|
||||
#define NumberTag /* 0x30000001L */ MKTAG(0x1,1)
|
||||
#define AtomTag /* 0x10000001L */ MKTAG(0x0,1)
|
||||
#define MAX_ABS_INT /* 0xfe00000LL */ (((Int)1) << (63-(2+4)))
|
||||
|
||||
/* bits that should not be used by anyone but us */
|
||||
#define YAP_PROTECTED_MASK 0xe000000000000000L
|
||||
|
||||
#define UNIQUE_TAG_FOR_PAIRS 1
|
||||
|
||||
#define PrimiBit /* 0x00000001L */ 1
|
||||
#define PairBits /* 0x00000003L */ 3
|
||||
#define ApplBits /* 0x00000005L */ 5
|
||||
#define PrimiBits /* 0x70000004L */ MKTAG(0x7,7)
|
||||
#define NumberMask /* 0x20000007L */ MKTAG(0x2,7)
|
||||
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<3) /* SQRT(8) */
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
|
||||
inline EXTERN int IsVarTerm(Term);
|
||||
|
||||
inline EXTERN int IsVarTerm(Term t)
|
||||
{
|
||||
return (int) ((!((t) & 0x1)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN int IsNonVarTerm(Term);
|
||||
|
||||
inline EXTERN int IsNonVarTerm(Term t)
|
||||
{
|
||||
return (int) (((t) & 0x1));
|
||||
}
|
||||
|
||||
|
||||
|
||||
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) (((CELL)(p)+PairBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsPairTerm(Term);
|
||||
|
||||
inline EXTERN Int IsPairTerm(Term t)
|
||||
{
|
||||
return (Int) (((t) & 0x2));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Term * RepAppl(Term);
|
||||
|
||||
inline EXTERN Term * RepAppl(Term t)
|
||||
{
|
||||
return (Term *) (((t)-ApplBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Term AbsAppl(Term *);
|
||||
|
||||
inline EXTERN Term AbsAppl(Term * p)
|
||||
{
|
||||
return (Term) (((CELL)(p)+ApplBits));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsApplTerm(Term);
|
||||
|
||||
inline EXTERN Int IsApplTerm(Term t)
|
||||
{
|
||||
return (Int) ((((t) & 0x4)));
|
||||
}
|
||||
|
||||
|
||||
|
||||
inline EXTERN Int IsAtomOrIntTerm(Term);
|
||||
|
||||
inline EXTERN Int IsAtomOrIntTerm(Term t)
|
||||
{
|
||||
return (Int) ((((t) & LowTagBits) == 0x1));
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
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)(Unsigned(t) << 3) >> 6);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <stdio.h>
|
||||
#include <gmp.h>
|
||||
|
||||
|
||||
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 <stdio.h>
|
||||
#include <gmp.h>
|
||||
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
|
|
|
|||
427
VC/include/Yap.h
427
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<SIZEOF_INT_P
|
||||
#define SHORT_INTS 1
|
||||
|
|
@ -207,7 +227,7 @@ error Yap requires pointers of size 4 or 8
|
|||
#endif
|
||||
|
||||
#if DEBUG
|
||||
extern char Option[20];
|
||||
extern char Option[20];
|
||||
#endif
|
||||
|
||||
/* #define FORCE_SECOND_QUADRANT 1 */
|
||||
|
|
@ -224,8 +244,10 @@ extern char Option[20];
|
|||
#define MMAP_ADDR 0x40000000
|
||||
#elif mips
|
||||
#define MMAP_ADDR 0x02000000
|
||||
#elif __APPLE__
|
||||
#define MMAP_ADDR 0x01000000
|
||||
#else
|
||||
#define MMAP_ADDR 0x10010000
|
||||
#define MMAP_ADDR 0x10000000
|
||||
#endif
|
||||
#elif __svr4__
|
||||
#define MMAP_ADDR 0x02000000
|
||||
|
|
@ -267,7 +289,7 @@ typedef CELL SFLAGS;
|
|||
typedef BITS16 SFLAGS;
|
||||
#endif
|
||||
|
||||
typedef char *ADDR;
|
||||
typedef char *ADDR;
|
||||
typedef CELL OFFSET;
|
||||
typedef unsigned char *CODEADDR;
|
||||
|
||||
|
|
@ -362,7 +384,7 @@ typedef CELL Term;
|
|||
#define siglongjmp(Env, Arg) longjmp(Env, Arg)
|
||||
#endif
|
||||
|
||||
extern sigjmp_buf RestartEnv; /* used to restart after an abort */
|
||||
extern sigjmp_buf RestartEnv; /* used to restart after an abort */
|
||||
|
||||
/* Support for arrays */
|
||||
#include "arrays.h"
|
||||
|
|
@ -370,8 +392,7 @@ extern sigjmp_buf RestartEnv; /* used to restart after an abort */
|
|||
/************ variables concerned with Error Handling *************/
|
||||
|
||||
/* Types of Errors */
|
||||
typedef enum
|
||||
{
|
||||
typedef enum {
|
||||
NO_ERROR,
|
||||
FATAL_ERROR,
|
||||
INTERNAL_ERROR,
|
||||
|
|
@ -407,6 +428,7 @@ typedef enum
|
|||
EXISTENCE_ERROR_STREAM,
|
||||
INSTANTIATION_ERROR,
|
||||
PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE,
|
||||
PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM,
|
||||
PERMISSION_ERROR_CREATE_ARRAY,
|
||||
PERMISSION_ERROR_CREATE_OPERATOR,
|
||||
PERMISSION_ERROR_INPUT_BINARY_STREAM,
|
||||
|
|
@ -445,15 +467,13 @@ typedef enum
|
|||
TYPE_ERROR_UBYTE,
|
||||
TYPE_ERROR_VARIABLE,
|
||||
UNKNOWN_ERROR
|
||||
}
|
||||
yap_error_number;
|
||||
} yap_error_number;
|
||||
|
||||
extern char *ErrorMessage; /* used to pass error messages */
|
||||
extern Term Error_Term; /* used to pass error terms */
|
||||
extern yap_error_number Error_TYPE; /* used to pass the error */
|
||||
extern char *ErrorMessage; /* used to pass error messages */
|
||||
extern Term Error_Term; /* used to pass error terms */
|
||||
extern yap_error_number Error_TYPE; /* used to pass the error */
|
||||
|
||||
typedef enum
|
||||
{
|
||||
typedef enum {
|
||||
YAP_INT_BOUNDED_FLAG = 0,
|
||||
MAX_ARITY_FLAG = 1,
|
||||
INTEGER_ROUNDING_FLAG = 2,
|
||||
|
|
@ -470,8 +490,7 @@ typedef enum
|
|||
WRITE_QUOTED_STRING_FLAG = 13,
|
||||
ALLOW_ASSERTING_STATIC_FLAG = 14,
|
||||
HALT_AFTER_CONSULT_FLAG = 15
|
||||
}
|
||||
yap_flags;
|
||||
} yap_flags;
|
||||
|
||||
#define STRING_AS_CHARS 0
|
||||
#define STRING_AS_ATOM 2
|
||||
|
|
@ -481,6 +500,7 @@ yap_flags;
|
|||
|
||||
#define CPROLOG_CHARACTER_ESCAPES 0
|
||||
#define ISO_CHARACTER_ESCAPES 1
|
||||
#define SICSTUS_CHARACTER_ESCAPES 2
|
||||
|
||||
#define NUMBER_OF_YAP_FLAGS HALT_AFTER_CONSULT_FLAG+1
|
||||
|
||||
|
|
@ -498,46 +518,46 @@ yap_flags;
|
|||
/***********************************************************************/
|
||||
|
||||
/*
|
||||
absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
|
||||
absrectype Term = Int + Float + Atom + Pair + Appl + Ref + Var
|
||||
|
||||
with AbsAppl(t) : *CELL -> 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
|
||||
|
||||
|
|
|
|||
2329
VC/include/Yatom.h
2329
VC/include/Yatom.h
File diff suppressed because it is too large
Load Diff
1159
VC/include/sshift.h
1159
VC/include/sshift.h
File diff suppressed because it is too large
Load Diff
|
|
@ -16,6 +16,8 @@
|
|||
|
||||
<h2>Yap-4.3.19:</h2>
|
||||
<ul>
|
||||
<li>FIXED: fflush(NULL) broken in some machines (Stasinos).</li>
|
||||
<li>FIXED: don't flush input streams (Stasinos).</li>
|
||||
<li>FIXED: new statistics/0.</li>
|
||||
<li>FIXED: use 15 bits of precision for floats, instead of the
|
||||
default 6..</li>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]).
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
Reference in New Issue