diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix fflush

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@125 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2001-07-16 15:26:14 +00:00
parent 3e6060a84f
commit eade18026c
18 changed files with 3521 additions and 3726 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
C/iopreds.c
View File

@@ -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
View File

@@ -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
View File

@@ -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

2
C/tracer.c
View File

@@ -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);

222
VC/include/Atoms.h
View File

@@ -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;

364
VC/include/Tags_24bits.h
View File

@@ -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);
}

397
VC/include/Tags_32LowTag.h
View File

@@ -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));
}

609
VC/include/Tags_32Ops.h
View File

@@ -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

372
VC/include/Tags_32bits.h
View File

@@ -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));
}

375
VC/include/Tags_64bits.h
View File

@@ -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);
}

914
VC/include/TermExt.h
View File

@@ -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
View File

@@ -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
View File

File diff suppressed because it is too large Load Diff

1159
VC/include/sshift.h
View File

File diff suppressed because it is too large Load Diff

2
changes4.3.html
View File

@@ -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>

4
distribute
View File

@@ -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

6
pl/errors.yap
View File

@@ -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]).

2
pl/init.yap
View File

@@ -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',