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
Show Stats 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 int
YP_fflush(int sno) 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(0);
return(fflush(Stream[sno].u.file.file)); return(fflush(Stream[sno].u.file.file));
} }
@ -2541,7 +2549,7 @@ p_write (void)
static Int static Int
p_write2 (void) p_write2 (void)
{ /* '$write'(+Flags,?Term) */ { /* '$write'(+Stream,+Flags,?Term) */
int old_output_stream = c_output_stream; int old_output_stream = c_output_stream;
c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2"); c_output_stream = CheckStream (ARG1, Output_Stream_f, "write/2");
if (c_output_stream == -1) { if (c_output_stream == -1) {
@ -4338,7 +4346,14 @@ p_flush (void)
static Int static Int
p_flush_all_streams (void) p_flush_all_streams (void)
{ /* $flush_all_streams */ { /* $flush_all_streams */
#if BROKEN_FFLUSH_NULL
int i;
for (i = 0; i < MaxStreams; ++i)
YP_fflush (i);
#else
fflush (NULL); fflush (NULL);
#endif
return (TRUE); return (TRUE);
} }

33
C/save.c
View File

@ -1595,6 +1595,14 @@ RestoreClause(Clause *Cl)
case _getwork: case _getwork:
case _getwork_seq: case _getwork_seq:
case _sync: 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 #endif
pc->u.ld.p = CodeAddrAdjust(pc->u.ld.p); pc->u.ld.p = CodeAddrAdjust(pc->u.ld.p);
pc->u.ld.d = CodeAddrAdjust(pc->u.ld.d); pc->u.ld.d = CodeAddrAdjust(pc->u.ld.d);
@ -1646,6 +1654,28 @@ RestoreClause(Clause *Cl)
case _p_functor: case _p_functor:
#ifdef YAPOR #ifdef YAPOR
case _getwork_first_time: 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 #endif
pc = NEXTOP(pc,e); pc = NEXTOP(pc,e);
break; break;
@ -1891,6 +1921,9 @@ RestoreClause(Clause *Cl)
/* instructions type s */ /* instructions type s */
case _write_n_voids: case _write_n_voids:
case _pop_n: case _pop_n:
#ifdef TABLING
case _table_new_answer:
#endif
pc = NEXTOP(pc,s); pc = NEXTOP(pc,s);
break; break;
/* instructions type c */ /* instructions type c */

11
C/sysbits.c
View File

@ -1473,7 +1473,8 @@ int TrueFileName (char *source, char *result, int in_lib)
#if __simplescalar__ #if __simplescalar__
/* does not implement getcwd */ /* does not implement getcwd */
strncpy(ares1,".",YAP_FILENAME_MAX); char *yap_pwd = getenv("PWD");
strncpy(ares1,yap_pwd,YAP_FILENAME_MAX);
#elif HAVE_GETCWD #elif HAVE_GETCWD
if (getcwd (ares1, YAP_FILENAME_MAX) == NULL) if (getcwd (ares1, YAP_FILENAME_MAX) == NULL)
return (FALSE); return (FALSE);
@ -1562,7 +1563,8 @@ p_getcwd(void)
#if __simplescalar__ #if __simplescalar__
/* does not implement getcwd */ /* does not implement getcwd */
strncpy(FileNameBuf,".",YAP_FILENAME_MAX); char *yap_pwd = getenv("PWD");
strncpy(FileNameBuf,yap_pwd,YAP_FILENAME_MAX);
#elif HAVE_GETCWD #elif HAVE_GETCWD
if (getcwd (FileNameBuf, YAP_FILENAME_MAX) == NULL) if (getcwd (FileNameBuf, YAP_FILENAME_MAX) == NULL)
return (FALSE); return (FALSE);
@ -1752,6 +1754,11 @@ p_cd (void)
return(FALSE); return(FALSE);
} }
TrueFileName (FileNameBuf, FileNameBuf2, 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)); return (!chdir (FileNameBuf2));
#else #else
#ifdef MACYAP #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; extern int gc_calls;
vsc_count++; vsc_count++;
if (vsc_count < 2518) return; /* if (vsc_count < 2518) return; */
/* if (vsc_count > 500000) exit(0); */ /* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/ /* if (gc_calls < 1) return;*/
YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H); YP_fprintf(YP_stderr,"%lu (%p)", vsc_count, H);

16
VC/include/Atoms.h
View File

@ -46,8 +46,7 @@ typedef struct PropEntryStruct *Prop;
/* I can only define the structure after I define the actual atoms */ /* I can only define the structure after I define the actual atoms */
/* atom structure */ /* atom structure */
typedef struct AtomEntryStruct typedef struct AtomEntryStruct {
{
Atom NextOfAE; /* used to build hash chains */ Atom NextOfAE; /* used to build hash chains */
Prop PropOfAE; /* property list for this atom */ Prop PropOfAE; /* property list for this atom */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -79,12 +78,10 @@ AtomEntry;
typedef SFLAGS PropFlags; typedef SFLAGS PropFlags;
/* basic property entry structure */ /* basic property entry structure */
typedef struct PropEntryStruct typedef struct PropEntryStruct {
{
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
} } PropEntry;
PropEntry;
/* ************************* Functors **********************************/ /* ************************* Functors **********************************/
@ -100,14 +97,13 @@ PropEntry;
#define FunctorProperty ((PropFlags)(0xbb00)) #define FunctorProperty ((PropFlags)(0xbb00))
/* functor property */ /* functor property */
typedef struct FunctorEntryStruct typedef struct FunctorEntryStruct {
{
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfFE; /* arity of functor */ unsigned int ArityOfFE; /* arity of functor */
Atom NameOfFE; /* back pointer to owner atom */ Atom NameOfFE; /* back pointer to owner atom */
Prop PropsOfFE; /* pointer to list of properties for this functor */ Prop PropsOfFE; /* pointer to list of properties for this functor */
} } FunctorEntry;
FunctorEntry;
typedef FunctorEntry *Functor; typedef FunctorEntry *Functor;

88
VC/include/Tags_24bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Tag Scheme for machines with 24 bits adresses (m68000) * * 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: $Id: Tags_24bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* Version for 24 bit addresses (68000) /* Version for 24 bit addresses (68000)
@ -32,7 +32,7 @@
ref 0mr000 address of cell ref 0mr000 address of cell
undefined 0mr000 pointing to itself undefined 0mr000 pointing to itself
*/ */
#define AllTagBits 0xfc000000L #define AllTagBits 0xfc000000L
#define TagBits 0xbc000000L #define TagBits 0xbc000000L
@ -64,124 +64,114 @@
#define YAP_PROTECTED_MASK 0x00000000L #define YAP_PROTECTED_MASK 0x00000000L
inline EXTERN int IsVarTerm (Term); inline EXTERN int IsVarTerm(Term);
inline EXTERN int inline EXTERN int IsVarTerm(Term t)
IsVarTerm (Term t)
{ {
return (int) (Signed (t) >= 0); return (int) (Signed(t) >= 0);
} }
inline EXTERN int IsNonVarTerm (Term); inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int inline EXTERN int IsNonVarTerm(Term t)
IsNonVarTerm (Term t)
{ {
return (int) (Signed (t) < 0); return (int) (Signed(t) < 0);
} }
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) (NonTagPart (t)); return (Term *) (NonTagPart(t));
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) (TAGGEDA (PairTag, (p))); return (Term) (TAGGEDA(PairTag, (p)));
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) (BitOn (PairBit, (t))); return (Int) (BitOn(PairBit, (t)));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) (NonTagPart (t)); return (Term *) (NonTagPart(t));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) (TAGGEDA (ApplTag, (p))); return (Term) (TAGGEDA(ApplTag, (p)));
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) (BitOn (ApplBit, (t))); return (Int) (BitOn(ApplBit, (t)));
} }
inline EXTERN Int IsAtomOrIntTerm (Term); inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int inline EXTERN Int IsAtomOrIntTerm(Term t)
IsAtomOrIntTerm (Term t)
{ {
return (Int) (!(Unsigned (t) & CompBits)); return (Int) (!(Unsigned(t) & CompBits));
} }
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Term AdjustIDBPtr (Term t, Term off); inline EXTERN Term AdjustIDBPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
static inline Int static inline Int
IntOfTerm (Term t) IntOfTerm(Term t)
{ {
Int n; Int n;
n = (Unsigned (t) & MaskPrim) >> 2; n = (Unsigned(t) & MaskPrim) >> 2;
if (Unsigned (t) & AdrHiBit) if (Unsigned(t) & AdrHiBit)
n |= 0xfc000000; n |= 0xfc000000;
return (n); return (n);
} }

83
VC/include/Tags_32LowTag.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * 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 $ * * version: $Id: Tags_32LowTag.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_LOW_BITS_32 1 #define TAG_LOW_BITS_32 1
@ -35,9 +35,9 @@
undefined mr.....00 address of cell pointing to itself undefined mr.....00 address of cell pointing to itself
functors are represented as ptrs to the functor entry in the atom functors are represented as ptrs to the functor entry in the atom
property list property list
*/ */
#define SHIFT_LOW_TAG 2 #define SHIFT_LOW_TAG 2
#define SHIFT_HIGH_TAG 2 #define SHIFT_HIGH_TAG 2
@ -82,90 +82,81 @@
#define YAP_PROTECTED_MASK 0xc0000000L #define YAP_PROTECTED_MASK 0xc0000000L
inline EXTERN int IsVarTerm (Term); inline EXTERN int IsVarTerm(Term);
inline EXTERN int inline EXTERN int IsVarTerm(Term t)
IsVarTerm (Term t)
{ {
return (int) (!((t) & LowTagBits)); return (int) (!((t) & LowTagBits));
} }
inline EXTERN int IsNonVarTerm (Term); inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int inline EXTERN int IsNonVarTerm(Term t)
IsNonVarTerm (Term t)
{ {
return (int) (((t) & LowTagBits)); return (int) (((t) & LowTagBits));
} }
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) ((t) - PairBits); return (Term *) ((t)-PairBits);
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) (Unsigned (p) + PairBits); return (Term) (Unsigned(p)+PairBits);
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) ((((t) & LowTagBits) == PairBits)); return (Int) ((((t) & LowTagBits) == PairBits));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) (((t) - ApplBit)); return (Term *) (((t)-ApplBit));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) (Unsigned (p) + ApplBit); return (Term) (Unsigned(p)+ApplBit);
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) ((((t) & LowTagBits) == ApplBit)); return (Int) ((((t) & LowTagBits) == ApplBit));
} }
inline EXTERN Int IsAtomOrIntTerm (Term); inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int inline EXTERN Int IsAtomOrIntTerm(Term t)
IsAtomOrIntTerm (Term t)
{ {
return (Int) ((((t) & LowTagBits) == 2)); return (Int) ((((t) & LowTagBits) == 2));
} }
@ -173,31 +164,31 @@ IsAtomOrIntTerm (Term t)
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Term AdjustIDBPtr (Term t, Term off); inline EXTERN Term AdjustIDBPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Int IntOfTerm (Term); inline EXTERN Int IntOfTerm(Term);
inline EXTERN Int inline EXTERN Int IntOfTerm(Term t)
IntOfTerm (Term t)
{ {
return (Int) (((Int) (t << 1)) >> (SHIFT_LOW_TAG + SHIFT_HIGH_TAG + 1)); return (Int) (((Int)(t << 1))>>(SHIFT_LOW_TAG+SHIFT_HIGH_TAG+1));
} }

143
VC/include/Tags_32Ops.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * 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: $Id: Tags_32Ops.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* /*
@ -99,81 +99,73 @@ are now 1 in compound terms and structures.
/* never forget to surround arguments to a macro by brackets */ /* never forget to surround arguments to a macro by brackets */
inline EXTERN int IsVarTerm (Term); inline EXTERN int IsVarTerm(Term);
inline EXTERN int inline EXTERN int IsVarTerm(Term t)
IsVarTerm (Term t)
{ {
return (int) (Signed (t) >= 0); return (int) (Signed(t) >= 0);
} }
inline EXTERN int IsNonVarTerm (Term); inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int inline EXTERN int IsNonVarTerm(Term t)
IsNonVarTerm (Term t)
{ {
return (int) (Signed (t) < 0); return (int) (Signed(t) < 0);
} }
#if UNIQUE_TAG_FOR_PAIRS #if UNIQUE_TAG_FOR_PAIRS
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) ((~(t))); return (Term *) ((~(t)));
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) ((~Unsigned (p))); return (Term) ((~Unsigned(p)));
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) (((t) & PairBit)); return (Int) (((t) & PairBit));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) ((-Signed (t))); return (Term *) ((-Signed(t)));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) ((-Signed (p))); return (Term) ((-Signed(p)));
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) ((!((t) & LowTagBits))); return (Int) ((!((t) & LowTagBits)));
} }
@ -181,60 +173,54 @@ IsApplTerm (Term t)
#else #else
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) ((-Signed (t))); return (Term *) ((-Signed(t)));
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) (((CELL) (-Signed (p)))); return (Term) (((CELL)(-Signed(p))));
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) ((!((t) & LowTagBits))); return (Int) ((!((t) & LowTagBits)));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) ((~(t))); return (Term *) ((~(t)));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) ((~Unsigned (p))); return (Term) ((~Unsigned(p)));
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) (((t) & ApplBit)); return (Int) (((t) & ApplBit));
} }
@ -242,78 +228,63 @@ IsApplTerm (Term t)
#endif #endif
inline EXTERN Int IsAtomOrIntTerm (Term); inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int inline EXTERN Int IsAtomOrIntTerm(Term t)
IsAtomOrIntTerm (Term t)
{ {
return (Int) (((Unsigned (t) & LowTagBits) == 0x2)); return (Int) (((Unsigned(t) & LowTagBits) == 0x2));
} }
inline EXTERN Int IntOfTerm (Term); inline EXTERN Int IntOfTerm(Term);
inline EXTERN Int inline EXTERN Int IntOfTerm(Term t)
IntOfTerm (Term t)
{ {
return (Int) ((Int) (Unsigned (t) << 3) >> 5); return (Int) ((Int)(Unsigned(t) << 3) >> 5);
} }
#if UNIQUE_TAG_FOR_PAIRS #if UNIQUE_TAG_FOR_PAIRS
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) (((IsVarTerm (t) return (Term) (((IsVarTerm(t) || IsAtomOrIntTerm(t)) ? (t)+(off) : (IsPairTerm(t) ? (CELL)AbsPair((CELL *)((CELL)RepPair(t)+(off))) : (t)-(off))));
|| 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);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) (IsVarTerm (t) ? (t) + (off) : (t) - (off)); return (Term) (IsVarTerm(t) ? (t)+(off) : (t)-(off));
} }
#else #else
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) (((IsVarTerm (t) return (Term) (((IsVarTerm(t) || IsAtomOrIntTerm(t)) ? (t)+(off) : (IsApplTerm(t) ? (CELL)AbsAppl((CELL *)((CELL)RepAppl(t)+(off))) : (t)-(off))));
|| 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);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) (IsVarTerm (t) ? (t) + return (Term) (IsVarTerm(t) ? (t)+(off) : (IsApplTerm(t) ? (CELL)AbsAppl((CELL *)((CELL)RepAppl(t)+(off))) : (t)-(off)));
(off) : (IsApplTerm (t) ? (CELL)
AbsAppl ((CELL *) ((CELL) RepAppl (t) +
(off))) : (t) - (off)));
} }
#endif #endif

90
VC/include/Tags_32bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * 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 $ * * version: $Id: Tags_32bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* Original version for 32 bit addresses machines, /* Original version for 32 bit addresses machines,
@ -69,122 +69,114 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) #define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
inline EXTERN int IsVarTerm (Term); inline EXTERN int IsVarTerm(Term);
inline EXTERN int inline EXTERN int IsVarTerm(Term t)
IsVarTerm (Term t)
{ {
return (int) (Signed (t) >= 0); return (int) (Signed(t) >= 0);
} }
inline EXTERN int IsNonVarTerm (Term); inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int inline EXTERN int IsNonVarTerm(Term t)
IsNonVarTerm (Term t)
{ {
return (int) (Signed (t) < 0); return (int) (Signed(t) < 0);
} }
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) (NonTagPart (t)); return (Term *) (NonTagPart(t));
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) (TAGGEDA (PairTag, (p))); return (Term) (TAGGEDA(PairTag, (p)));
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) (BitOn (PairBit, (t))); return (Int) (BitOn(PairBit, (t)));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) (NonTagPart (t)); return (Term *) (NonTagPart(t));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) (TAGGEDA (ApplTag, (p))); return (Term) (TAGGEDA(ApplTag, (p)));
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) (BitOn (ApplBit, (t))); return (Int) (BitOn(ApplBit, (t)));
} }
inline EXTERN int IsAtomOrIntTerm (Term); inline EXTERN int IsAtomOrIntTerm(Term);
inline EXTERN int inline EXTERN int IsAtomOrIntTerm(Term t)
IsAtomOrIntTerm (Term t)
{ {
return (int) (((Unsigned (t) & LowTagBits) == 0)); return (int) (((Unsigned(t) & LowTagBits) == 0));
} }
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Term AdjustIDBPtr (Term t, Term off); inline EXTERN Term AdjustIDBPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Int IntOfTerm (Term); inline EXTERN Int IntOfTerm(Term);
inline EXTERN Int inline EXTERN Int IntOfTerm(Term t)
IntOfTerm (Term t)
{ {
return (Int) (((Int) (t << 3)) >> (3 + 2)); return (Int) (((Int)(t << 3))>>(3+2));
} }

81
VC/include/Tags_64bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 * * Last rev: December 90 *
* mods: * * mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses * * 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 $ * * version: $Id: Tags_64bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#define TAG_64BITS 1 #define TAG_64BITS 1
@ -51,7 +51,7 @@ property list
#define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8) #define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8)
#define NumberTag /* 0x30000001L */ MKTAG(0x1,1) #define NumberTag /* 0x30000001L */ MKTAG(0x1,1)
#define AtomTag /* 0x10000001L */ MKTAG(0x0,1) #define AtomTag /* 0x10000001L */ MKTAG(0x0,1)
#define MAX_ABS_INT /* 0xfe00000LL */ (((UInt)1) << (63-(2+4))) #define MAX_ABS_INT /* 0xfe00000LL */ (((Int)1) << (63-(2+4)))
/* bits that should not be used by anyone but us */ /* bits that should not be used by anyone but us */
#define YAP_PROTECTED_MASK 0xe000000000000000L #define YAP_PROTECTED_MASK 0xe000000000000000L
@ -71,90 +71,81 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag) #define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
inline EXTERN int IsVarTerm (Term); inline EXTERN int IsVarTerm(Term);
inline EXTERN int inline EXTERN int IsVarTerm(Term t)
IsVarTerm (Term t)
{ {
return (int) ((!((t) & 0x1))); return (int) ((!((t) & 0x1)));
} }
inline EXTERN int IsNonVarTerm (Term); inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int inline EXTERN int IsNonVarTerm(Term t)
IsNonVarTerm (Term t)
{ {
return (int) (((t) & 0x1)); return (int) (((t) & 0x1));
} }
inline EXTERN Term *RepPair (Term); inline EXTERN Term * RepPair(Term);
inline EXTERN Term * inline EXTERN Term * RepPair(Term t)
RepPair (Term t)
{ {
return (Term *) (((t) - PairBits)); return (Term *) (((t)-PairBits));
} }
inline EXTERN Term AbsPair (Term *); inline EXTERN Term AbsPair(Term *);
inline EXTERN Term inline EXTERN Term AbsPair(Term * p)
AbsPair (Term * p)
{ {
return (Term) (((CELL) (p) + PairBits)); return (Term) (((CELL)(p)+PairBits));
} }
inline EXTERN Int IsPairTerm (Term); inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int inline EXTERN Int IsPairTerm(Term t)
IsPairTerm (Term t)
{ {
return (Int) (((t) & 0x2)); return (Int) (((t) & 0x2));
} }
inline EXTERN Term *RepAppl (Term); inline EXTERN Term * RepAppl(Term);
inline EXTERN Term * inline EXTERN Term * RepAppl(Term t)
RepAppl (Term t)
{ {
return (Term *) (((t) - ApplBits)); return (Term *) (((t)-ApplBits));
} }
inline EXTERN Term AbsAppl (Term *); inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term inline EXTERN Term AbsAppl(Term * p)
AbsAppl (Term * p)
{ {
return (Term) (((CELL) (p) + ApplBits)); return (Term) (((CELL)(p)+ApplBits));
} }
inline EXTERN Int IsApplTerm (Term); inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int inline EXTERN Int IsApplTerm(Term t)
IsApplTerm (Term t)
{ {
return (Int) ((((t) & 0x4))); return (Int) ((((t) & 0x4)));
} }
inline EXTERN Int IsAtomOrIntTerm (Term); inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int inline EXTERN Int IsAtomOrIntTerm(Term t)
IsAtomOrIntTerm (Term t)
{ {
return (Int) ((((t) & LowTagBits) == 0x1)); return (Int) ((((t) & LowTagBits) == 0x1));
} }
@ -162,31 +153,31 @@ IsAtomOrIntTerm (Term t)
inline EXTERN Term AdjustPtr (Term t, Term off); inline EXTERN Term AdjustPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustPtr(Term t, Term off)
AdjustPtr (Term t, Term off)
{ {
return (Term) (((t) + off)); return (Term) (((t)+off));
} }
inline EXTERN Term AdjustIDBPtr (Term t, Term off); inline EXTERN Term AdjustIDBPtr(Term t, Term off);
inline EXTERN Term inline EXTERN Term AdjustIDBPtr(Term t, Term off)
AdjustIDBPtr (Term t, Term off)
{ {
return (Term) ((t) + off); return (Term) ((t)+off);
} }
inline EXTERN Int IntOfTerm (Term); inline EXTERN Int IntOfTerm(Term);
inline EXTERN Int inline EXTERN Int IntOfTerm(Term t)
IntOfTerm (Term t)
{ {
return (Int) ((Int) (Unsigned (t) << 3) >> 6); return (Int) ((Int)(Unsigned(t) << 3) >> 6);
} }

268
VC/include/TermExt.h
View File

@ -17,7 +17,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.1.1.1 2001-04-09 19:53:41 vsc Exp $ * * version: $Id: TermExt.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#if USE_OFFSETS #if USE_OFFSETS
@ -35,31 +35,27 @@
#define TermDot MkAtomTerm(AtomDot) #define TermDot MkAtomTerm(AtomDot)
#ifdef IN_SECOND_QUADRANT #ifdef IN_SECOND_QUADRANT
typedef enum typedef enum {
{ db_ref_e = sizeof(Functor *)|RBIT,
db_ref_e = sizeof (Functor *) | RBIT, long_int_e = 2*sizeof(Functor *)|RBIT,
long_int_e = 2 * sizeof (Functor *) | RBIT,
#ifdef USE_GMP #ifdef USE_GMP
big_int_e = 3 * sizeof (Functor *) | RBIT, big_int_e = 3*sizeof(Functor *)|RBIT,
double_e = 4 * sizeof (Functor *) | RBIT double_e = 4*sizeof(Functor *)|RBIT
#else #else
double_e = 3 * sizeof (Functor *) | RBIT double_e = 3*sizeof(Functor *)|RBIT
#endif #endif
} } blob_type;
blob_type;
#else #else
typedef enum typedef enum {
{ db_ref_e = sizeof(Functor *),
db_ref_e = sizeof (Functor *), long_int_e = 2*sizeof(Functor *),
long_int_e = 2 * sizeof (Functor *),
#ifdef USE_GMP #ifdef USE_GMP
big_int_e = 3 * sizeof (Functor *), big_int_e = 3*sizeof(Functor *),
double_e = 4 * sizeof (Functor *) double_e = 4*sizeof(Functor *)
#else #else
double_e = 3 * sizeof (Functor *) double_e = 3*sizeof(Functor *)
#endif #endif
} } blob_type;
blob_type;
#endif #endif
#define FunctorDBRef ((Functor)(db_ref_e)) #define FunctorDBRef ((Functor)(db_ref_e))
@ -71,12 +67,11 @@ blob_type;
#define EndSpecials (double_e) #define EndSpecials (double_e)
inline EXTERN blob_type BlobOfFunctor (Functor f); inline EXTERN blob_type BlobOfFunctor(Functor f);
inline EXTERN blob_type inline EXTERN blob_type BlobOfFunctor(Functor f)
BlobOfFunctor (Functor f)
{ {
return (blob_type) ((CELL) f); return (blob_type) ((CELL)f);
} }
@ -85,32 +80,28 @@ BlobOfFunctor (Functor f)
#ifdef COROUTINING #ifdef COROUTINING
typedef struct typedef struct {
{
/* what to do when someone tries to bind our term to someone else /* what to do when someone tries to bind our term to someone else
in some predefined context */ in some predefined context */
void (*bind_op) (Term *, Term); void (*bind_op)(Term *, Term);
/* what to do if someone wants to copy our constraint */ /* what to do if someone wants to copy our constraint */
int (*copy_term_op) (Term, CELL ***); int (*copy_term_op)(Term, CELL ***);
/* op called to do marking in GC */ /* op called to do marking in GC */
void (*mark_op) (CELL *); void (*mark_op)(CELL *);
} } ext_op;
ext_op;
/* known delays */ /* known delays */
typedef enum typedef enum {
{ empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */
empty_ext = 0 * sizeof (ext_op), /* default op, this should never be called */ susp_ext = 1*sizeof(ext_op), /* support for delayable goals */
susp_ext = 1 * sizeof (ext_op), /* support for delayable goals */ attvars_ext = 2*sizeof(ext_op), /* support for attributed variables */
attvars_ext = 2 * sizeof (ext_op), /* support for attributed variables */
/* add your own extensions here */ /* add your own extensions here */
/* keep this one */ /* keep this one */
} } exts;
exts;
/* array with the ops for your favourite extensions */ /* array with the ops for your favourite extensions */
extern ext_op attas[attvars_ext + 1]; extern ext_op attas[attvars_ext+1];
#endif #endif
@ -129,25 +120,21 @@ special_functors;
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT #if SIZEOF_DOUBLE == SIZEOF_LONG_INT
inline EXTERN Term MkFloatTerm (Float); inline EXTERN Term MkFloatTerm(Float);
inline EXTERN Term inline EXTERN Term MkFloatTerm(Float dbl)
MkFloatTerm (Float dbl)
{ {
return (Term) ((H[0] = (CELL) FunctorDouble, *(Float *) (H + 1) = return (Term) ((H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)));
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);
inline EXTERN Float inline EXTERN Float FloatOfTerm(Term t)
FloatOfTerm (Term t)
{ {
return (Float) (*(Float *) (RepAppl (t) + 1)); return (Float) (*(Float *)(RepAppl(t)+1));
} }
@ -165,47 +152,36 @@ FloatOfTerm (Term t)
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4) #define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
#endif #endif
inline EXTERN Float STD_PROTO (CpFloatUnaligned, (CELL *)); inline EXTERN Float STD_PROTO(CpFloatUnaligned,(CELL *));
inline EXTERN void STD_PROTO (AlignGlobalForDouble, (void)); inline EXTERN void STD_PROTO(AlignGlobalForDouble,(void));
inline EXTERN Float inline EXTERN Float
CpFloatUnaligned (CELL * ptr) CpFloatUnaligned(CELL *ptr)
{ {
union union { Float f; CELL d[2]; } u;
{
Float f;
CELL d[2];
}
u;
u.d[0] = ptr[1]; u.d[0] = ptr[1];
u.d[1] = ptr[2]; u.d[1] = ptr[2];
return (u.f); return(u.f);
} }
inline EXTERN Term MkFloatTerm (Float); inline EXTERN Term MkFloatTerm(Float);
inline EXTERN Term inline EXTERN Term MkFloatTerm(Float dbl)
MkFloatTerm (Float dbl)
{ {
return (Term) ((AlignGlobalForDouble (), H[0] = return (Term) ((AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4)));
(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);
inline EXTERN Float inline EXTERN Float FloatOfTerm(Term t)
FloatOfTerm (Term t)
{ {
return (Float) ((DOUBLE_ALIGNED (RepAppl (t)) ? *(Float *) (RepAppl (t) + 1) return (Float) ((DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))));
: CpFloatUnaligned (RepAppl (t))));
} }
@ -217,12 +193,11 @@ FloatOfTerm (Term t)
#endif #endif
inline EXTERN int IsFloatTerm (Term); inline EXTERN int IsFloatTerm(Term);
inline EXTERN int inline EXTERN int IsFloatTerm(Term t)
IsFloatTerm (Term t)
{ {
return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorDouble); return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorDouble);
} }
@ -230,34 +205,29 @@ IsFloatTerm (Term t)
/* extern Functor FunctorLongInt; */ /* extern Functor FunctorLongInt; */
inline EXTERN Term MkLongIntTerm (Int); inline EXTERN Term MkLongIntTerm(Int);
inline EXTERN Term inline EXTERN Term MkLongIntTerm(Int i)
MkLongIntTerm (Int i)
{ {
return (Term) ((H[0] = (CELL) FunctorLongInt, H[1] = (CELL) i, H[2] = return (Term) ((H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)));
((2 * sizeof (CELL) + EndSpecials) | MBIT), H +=
3, AbsAppl (H - 3)));
} }
inline EXTERN Int LongIntOfTerm (Term t); inline EXTERN Int LongIntOfTerm(Term t);
inline EXTERN Int inline EXTERN Int LongIntOfTerm(Term t)
LongIntOfTerm (Term t)
{ {
return (Int) (RepAppl (t)[1]); return (Int) (RepAppl(t)[1]);
} }
inline EXTERN int IsLongIntTerm (Term); inline EXTERN int IsLongIntTerm(Term);
inline EXTERN int inline EXTERN int IsLongIntTerm(Term t)
IsLongIntTerm (Term t)
{ {
return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorLongInt); return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt);
} }
@ -268,32 +238,28 @@ IsLongIntTerm (Term t)
#include <gmp.h> #include <gmp.h>
MP_INT *STD_PROTO (PreAllocBigNum, (void)); MP_INT *STD_PROTO(PreAllocBigNum,(void));
void STD_PROTO (ClearAllocBigNum, (void)); void STD_PROTO(ClearAllocBigNum,(void));
MP_INT *STD_PROTO (InitBigNum, (Int)); MP_INT *STD_PROTO(InitBigNum,(Int));
Term STD_PROTO (MkBigIntTerm, (MP_INT *)); Term STD_PROTO(MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO (BigIntOfTerm, (Term)); MP_INT *STD_PROTO(BigIntOfTerm, (Term));
inline EXTERN int IsBigIntTerm (Term); inline EXTERN int IsBigIntTerm(Term);
inline EXTERN int inline EXTERN int IsBigIntTerm(Term t)
IsBigIntTerm (Term t)
{ {
return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorBigInt); return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt);
} }
inline EXTERN int IsLargeIntTerm (Term); inline EXTERN int IsLargeIntTerm(Term);
inline EXTERN int inline EXTERN int IsLargeIntTerm(Term t)
IsLargeIntTerm (Term t)
{ {
return (int) (IsApplTerm (t) return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorBigInt) && (FunctorOfTerm(t) >= FunctorLongInt)));
&& ((FunctorOfTerm (t) <= FunctorBigInt)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
} }
@ -301,10 +267,9 @@ IsLargeIntTerm (Term t)
#else #else
inline EXTERN int IsBigIntTerm (Term); inline EXTERN int IsBigIntTerm(Term);
inline EXTERN int inline EXTERN int IsBigIntTerm(Term t)
IsBigIntTerm (Term t)
{ {
return (int) (FALSE); return (int) (FALSE);
} }
@ -312,12 +277,11 @@ IsBigIntTerm (Term t)
inline EXTERN int IsLargeIntTerm (Term); inline EXTERN int IsLargeIntTerm(Term);
inline EXTERN int inline EXTERN int IsLargeIntTerm(Term t)
IsLargeIntTerm (Term t)
{ {
return (int) (IsApplTerm (t) && FunctorOfTerm (t) == FunctorLongInt); return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt);
} }
@ -326,68 +290,59 @@ IsLargeIntTerm (Term t)
/* extern Functor FunctorLongInt; */ /* extern Functor FunctorLongInt; */
inline EXTERN int IsLargeNumTerm (Term); inline EXTERN int IsLargeNumTerm(Term);
inline EXTERN int inline EXTERN int IsLargeNumTerm(Term t)
IsLargeNumTerm (Term t)
{ {
return (int) (IsApplTerm (t) return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorDouble) && (FunctorOfTerm(t) >= FunctorLongInt)));
&& ((FunctorOfTerm (t) <= FunctorDouble)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
} }
inline EXTERN int IsNumTerm (Term); inline EXTERN int IsNumTerm(Term);
inline EXTERN int inline EXTERN int IsNumTerm(Term t)
IsNumTerm (Term t)
{ {
return (int) ((IsIntTerm (t) || IsLargeNumTerm (t))); return (int) ((IsIntTerm(t) || IsLargeNumTerm(t)));
} }
inline EXTERN Int IsAtomicTerm (Term); inline EXTERN Int IsAtomicTerm(Term);
inline EXTERN Int inline EXTERN Int IsAtomicTerm(Term t)
IsAtomicTerm (Term t)
{ {
return (Int) (IsAtomOrIntTerm (t) || IsLargeNumTerm (t)); return (Int) (IsAtomOrIntTerm(t) || IsLargeNumTerm(t));
} }
inline EXTERN Int IsExtensionFunctor (Functor); inline EXTERN Int IsExtensionFunctor(Functor);
inline EXTERN Int inline EXTERN Int IsExtensionFunctor(Functor f)
IsExtensionFunctor (Functor f)
{ {
return (Int) (f <= FunctorDouble); return (Int) (f <= FunctorDouble);
} }
inline EXTERN Int IsBlobFunctor (Functor); inline EXTERN Int IsBlobFunctor(Functor);
inline EXTERN Int inline EXTERN Int IsBlobFunctor(Functor f)
IsBlobFunctor (Functor f)
{ {
return (Int) ((f <= FunctorDouble && f >= FunctorDBRef)); return (Int) ((f <= FunctorDouble && f >= FunctorDBRef));
} }
inline EXTERN Int IsPrimitiveTerm (Term); inline EXTERN Int IsPrimitiveTerm(Term);
inline EXTERN Int inline EXTERN Int IsPrimitiveTerm(Term t)
IsPrimitiveTerm (Term t)
{ {
return (Int) ((IsAtomOrIntTerm (t) return (Int) ((IsAtomOrIntTerm(t) || (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t)))));
|| (IsApplTerm (t) && IsBlobFunctor (FunctorOfTerm (t)))));
} }
@ -395,10 +350,9 @@ IsPrimitiveTerm (Term t)
#ifdef TERM_EXTENSIONS #ifdef TERM_EXTENSIONS
inline EXTERN Int IsAttachFunc (Functor); inline EXTERN Int IsAttachFunc(Functor);
inline EXTERN Int inline EXTERN Int IsAttachFunc(Functor f)
IsAttachFunc (Functor f)
{ {
return (Int) (FALSE); return (Int) (FALSE);
} }
@ -406,21 +360,19 @@ IsAttachFunc (Functor f)
inline EXTERN Int IsAttachedTerm (Term); inline EXTERN Int IsAttachedTerm(Term);
inline EXTERN Int inline EXTERN Int IsAttachedTerm(Term t)
IsAttachedTerm (Term t)
{ {
return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0)); return (Int) ((IsVarTerm(t) && VarOfTerm(t) < H0) );
} }
inline EXTERN exts ExtFromCell (CELL *); inline EXTERN exts ExtFromCell(CELL *);
inline EXTERN exts inline EXTERN exts ExtFromCell(CELL * pt)
ExtFromCell (CELL * pt)
{ {
return (exts) (pt[1]); return (exts) (pt[1]);
} }
@ -430,10 +382,9 @@ ExtFromCell (CELL * pt)
#else #else
inline EXTERN Int IsAttachFunc (Functor); inline EXTERN Int IsAttachFunc(Functor);
inline EXTERN Int inline EXTERN Int IsAttachFunc(Functor f)
IsAttachFunc (Functor f)
{ {
return (Int) (FALSE); return (Int) (FALSE);
} }
@ -441,10 +392,9 @@ IsAttachFunc (Functor f)
inline EXTERN Int IsAttachedTerm (Term); inline EXTERN Int IsAttachedTerm(Term);
inline EXTERN Int inline EXTERN Int IsAttachedTerm(Term t)
IsAttachedTerm (Term t)
{ {
return (Int) (FALSE); return (Int) (FALSE);
} }
@ -453,24 +403,23 @@ IsAttachedTerm (Term t)
#endif #endif
EXTERN int STD_PROTO (unify_extension, (Functor, CELL, CELL *, CELL)); EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL));
inline EXTERN int inline EXTERN int
unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1) unify_extension(Functor f, CELL d0, CELL *pt0, CELL d1)
{ {
switch (BlobOfFunctor (f)) switch(BlobOfFunctor(f)) {
{
case db_ref_e: case db_ref_e:
return (d0 == d1); return (d0 == d1);
case long_int_e: case long_int_e:
return (pt0[1] == RepAppl (d1)[1]); return(pt0[1] == RepAppl(d1)[1]);
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
return (mpz_cmp (BigIntOfTerm (d0), BigIntOfTerm (d1)) == 0); return (mpz_cmp(BigIntOfTerm(d0),BigIntOfTerm(d1)) == 0);
#endif /* USE_GMP */ #endif /* USE_GMP */
case double_e: case double_e:
{ {
CELL *pt1 = RepAppl (d1); CELL *pt1 = RepAppl(d1);
return (pt0[1] == pt1[1] return (pt0[1] == pt1[1]
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
&& pt0[2] == pt1[2] && pt0[2] == pt1[2]
@ -478,5 +427,6 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1)
); );
} }
} }
return (FALSE); return(FALSE);
} }

351
VC/include/Yap.h
View File

@ -17,7 +17,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * 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" #include "config.h"
@ -86,6 +86,20 @@
#endif #endif
#endif #endif
#ifdef SBA
#ifdef YAPOR
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#endif
#ifdef TABLING
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
/* adjust a config.h from mingw32 to work with vc++ */ /* adjust a config.h from mingw32 to work with vc++ */
#ifdef HAVE_GCC #ifdef HAVE_GCC
@ -157,8 +171,9 @@
/* */ typedef unsigned long int UInt; /* */ typedef unsigned long int UInt;
#else #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 #endif
#if SIZEOF_SHORT_INT==2 #if SIZEOF_SHORT_INT==2
/* */ typedef short int Short; /* */ typedef short int Short;
/* */ typedef unsigned short int UShort; /* */ typedef unsigned short int UShort;
@ -166,6 +181,7 @@ error Yap require integer types of the same size as a pointer
#else #else
error Yap requires integer types half the size of a pointer error Yap requires integer types half the size of a pointer
#endif #endif
#elif SIZEOF_INT_P==8 #elif SIZEOF_INT_P==8
# if SIZEOF_INT==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; /* */ typedef unsigned long long int UInt;
# else # 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 # endif
# if SIZEOF_SHORT_INT==4 # if SIZEOF_SHORT_INT==4
/* */ typedef short int Short; /* */ typedef short int Short;
/* */ typedef unsigned short int UShort; /* */ typedef unsigned short int UShort;
@ -194,10 +211,13 @@ error Yap requires integer types of the same size as a pointer
# else # else
error Yap requires integer types half the size of a pointer error Yap requires integer types half the size of a pointer
# endif # endif
#else #else
error Yap requires pointers of size 4 or 8 error Yap requires pointers of size 4 or 8
#endif #endif
/* */ typedef double Float; /* */ typedef double Float;
#if SIZEOF_INT<SIZEOF_INT_P #if SIZEOF_INT<SIZEOF_INT_P
@ -224,8 +244,10 @@ extern char Option[20];
#define MMAP_ADDR 0x40000000 #define MMAP_ADDR 0x40000000
#elif mips #elif mips
#define MMAP_ADDR 0x02000000 #define MMAP_ADDR 0x02000000
#elif __APPLE__
#define MMAP_ADDR 0x01000000
#else #else
#define MMAP_ADDR 0x10010000 #define MMAP_ADDR 0x10000000
#endif #endif
#elif __svr4__ #elif __svr4__
#define MMAP_ADDR 0x02000000 #define MMAP_ADDR 0x02000000
@ -370,8 +392,7 @@ extern sigjmp_buf RestartEnv; /* used to restart after an abort */
/************ variables concerned with Error Handling *************/ /************ variables concerned with Error Handling *************/
/* Types of Errors */ /* Types of Errors */
typedef enum typedef enum {
{
NO_ERROR, NO_ERROR,
FATAL_ERROR, FATAL_ERROR,
INTERNAL_ERROR, INTERNAL_ERROR,
@ -407,6 +428,7 @@ typedef enum
EXISTENCE_ERROR_STREAM, EXISTENCE_ERROR_STREAM,
INSTANTIATION_ERROR, INSTANTIATION_ERROR,
PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE,
PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM,
PERMISSION_ERROR_CREATE_ARRAY, PERMISSION_ERROR_CREATE_ARRAY,
PERMISSION_ERROR_CREATE_OPERATOR, PERMISSION_ERROR_CREATE_OPERATOR,
PERMISSION_ERROR_INPUT_BINARY_STREAM, PERMISSION_ERROR_INPUT_BINARY_STREAM,
@ -445,15 +467,13 @@ typedef enum
TYPE_ERROR_UBYTE, TYPE_ERROR_UBYTE,
TYPE_ERROR_VARIABLE, TYPE_ERROR_VARIABLE,
UNKNOWN_ERROR UNKNOWN_ERROR
} } yap_error_number;
yap_error_number;
extern char *ErrorMessage; /* used to pass error messages */ extern char *ErrorMessage; /* used to pass error messages */
extern Term Error_Term; /* used to pass error terms */ extern Term Error_Term; /* used to pass error terms */
extern yap_error_number Error_TYPE; /* used to pass the error */ extern yap_error_number Error_TYPE; /* used to pass the error */
typedef enum typedef enum {
{
YAP_INT_BOUNDED_FLAG = 0, YAP_INT_BOUNDED_FLAG = 0,
MAX_ARITY_FLAG = 1, MAX_ARITY_FLAG = 1,
INTEGER_ROUNDING_FLAG = 2, INTEGER_ROUNDING_FLAG = 2,
@ -470,8 +490,7 @@ typedef enum
WRITE_QUOTED_STRING_FLAG = 13, WRITE_QUOTED_STRING_FLAG = 13,
ALLOW_ASSERTING_STATIC_FLAG = 14, ALLOW_ASSERTING_STATIC_FLAG = 14,
HALT_AFTER_CONSULT_FLAG = 15 HALT_AFTER_CONSULT_FLAG = 15
} } yap_flags;
yap_flags;
#define STRING_AS_CHARS 0 #define STRING_AS_CHARS 0
#define STRING_AS_ATOM 2 #define STRING_AS_ATOM 2
@ -481,6 +500,7 @@ yap_flags;
#define CPROLOG_CHARACTER_ESCAPES 0 #define CPROLOG_CHARACTER_ESCAPES 0
#define ISO_CHARACTER_ESCAPES 1 #define ISO_CHARACTER_ESCAPES 1
#define SICSTUS_CHARACTER_ESCAPES 2
#define NUMBER_OF_YAP_FLAGS HALT_AFTER_CONSULT_FLAG+1 #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 with AbsAppl(t) : *CELL -> Term
and RepAppl(t) : Term -> *CELL and RepAppl(t) : Term -> *CELL
and AbsPair(t) : *CELL -> Term and AbsPair(t) : *CELL -> Term
and RepPair(t) : Term -> *CELL and RepPair(t) : Term -> *CELL
and IsIntTerm(t) = ... and IsIntTerm(t) = ...
and IsAtomTerm(t) = ... and IsAtomTerm(t) = ...
and IsVarTerm(t) = ... and IsVarTerm(t) = ...
and IsPairTerm(t) = ... and IsPairTerm(t) = ...
and IsApplTerm(t) = ... and IsApplTerm(t) = ...
and IsFloatTerm(t) = ... and IsFloatTerm(t) = ...
and IsRefTerm(t) = ... and IsRefTerm(t) = ...
and IsNonVarTerm(t) = ! IsVar(t) and IsNonVarTerm(t) = ! IsVar(t)
and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t) and IsNumterm(t) = IsIntTerm(t) || IsFloatTerm(t)
and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t) and IsAtomicTerm(t) = IsNumTerm(t) || IsAtomTerm(t)
and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t) and IsPrimitiveTerm(t) = IsAtomicTerm(t) || IsRefTerm(t)
and MkIntTerm(n) = ... and MkIntTerm(n) = ...
and MkFloatTerm(f) = ... and MkFloatTerm(f) = ...
and MkAtomTerm(a) = ... and MkAtomTerm(a) = ...
and MkVarTerm(r) = ... and MkVarTerm(r) = ...
and MkApplTerm(f,n,args) = ... and MkApplTerm(f,n,args) = ...
and MkPairTerm(hd,tl) = ... and MkPairTerm(hd,tl) = ...
and MkRefTerm(R) = ... and MkRefTerm(R) = ...
and PtrOfTerm(t) : Term -> CELL * = ... and PtrOfTerm(t) : Term -> CELL * = ...
and IntOfTerm(t) : Term -> int = ... and IntOfTerm(t) : Term -> int = ...
and FloatOfTerm(t) : Term -> flt = ... and FloatOfTerm(t) : Term -> flt = ...
and AtomOfTerm(t) : Term -> Atom = ... and AtomOfTerm(t) : Term -> Atom = ...
and VarOfTerm(t) : Term -> *Term = .... and VarOfTerm(t) : Term -> *Term = ....
and HeadOfTerm(t) : Term -> Term = ... and HeadOfTerm(t) : Term -> Term = ...
and TailOfTerm(t) : Term -> Term = ... and TailOfTerm(t) : Term -> Term = ...
and FunctorOfTerm(t) : Term -> Functor = ... and FunctorOfTerm(t) : Term -> Functor = ...
and ArgOfTerm(i,t) : Term -> Term= ... and ArgOfTerm(i,t) : Term -> Term= ...
and RefOfTerm(t) : Term -> DBRef = ... and RefOfTerm(t) : Term -> DBRef = ...
*/ */
/* /*
YAP can use several different tag schemes, according to the kind of YAP can use several different tag schemes, according to the kind of
@ -604,10 +624,9 @@ yap_flags;
/* applies to unbound variables */ /* applies to unbound variables */
inline EXTERN Term *VarOfTerm (Term t); inline EXTERN Term * VarOfTerm(Term t);
inline EXTERN Term * inline EXTERN Term * VarOfTerm(Term t)
VarOfTerm (Term t)
{ {
return (Term *) (t); return (Term *) (t);
} }
@ -615,20 +634,18 @@ VarOfTerm (Term t)
#if SBA #if SBA
inline EXTERN Term MkVarTerm (void); inline EXTERN Term MkVarTerm(void);
inline EXTERN Term inline EXTERN Term MkVarTerm()
MkVarTerm ()
{ {
return (Term) ((*H = 0, H++)); return (Term) ((*H = 0, H++));
} }
inline EXTERN int IsUnboundVar (Term); inline EXTERN int IsUnboundVar(Term);
inline EXTERN int inline EXTERN int IsUnboundVar(Term t)
IsUnboundVar (Term t)
{ {
return (int) (t == 0); return (int) (t == 0);
} }
@ -636,108 +653,98 @@ IsUnboundVar (Term t)
#else #else
inline EXTERN Term MkVarTerm (void); inline EXTERN Term MkVarTerm(void);
inline EXTERN Term inline EXTERN Term MkVarTerm()
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 inline EXTERN int IsUnboundVar(Term t)
IsUnboundVar (Term t)
{ {
return (int) (*VarOfTerm (t) == (t)); return (int) (*VarOfTerm(t) == (t));
} }
#endif #endif
inline EXTERN CELL *PtrOfTerm (Term); inline EXTERN CELL * PtrOfTerm(Term);
inline EXTERN CELL * inline EXTERN CELL * PtrOfTerm(Term t)
PtrOfTerm (Term t)
{ {
return (CELL *) (*(CELL *) (t)); return (CELL *) (*(CELL *)(t));
} }
inline EXTERN Functor FunctorOfTerm (Term); inline EXTERN Functor FunctorOfTerm(Term);
inline EXTERN Functor inline EXTERN Functor FunctorOfTerm(Term t)
FunctorOfTerm (Term t)
{ {
return (Functor) (*RepAppl (t)); return (Functor) (*RepAppl(t));
} }
#if IN_SECOND_QUADRANT #if IN_SECOND_QUADRANT
inline EXTERN Term MkAtomTerm (Atom); inline EXTERN Term MkAtomTerm(Atom);
inline EXTERN Term inline EXTERN Term MkAtomTerm(Atom a)
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 inline EXTERN Atom AtomOfTerm(Term t)
AtomOfTerm (Term t)
{ {
return (Atom) ((CELL *) HEAP_INIT_BASE + NonTagPart (t)); return (Atom) ((CELL *)HEAP_INIT_BASE+NonTagPart(t));
} }
#else #else
inline EXTERN Term MkAtomTerm (Atom); inline EXTERN Term MkAtomTerm(Atom);
inline EXTERN Term inline EXTERN Term MkAtomTerm(Atom a)
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 inline EXTERN Atom AtomOfTerm(Term t)
AtomOfTerm (Term t)
{ {
return (Atom) (NonTagPart (t)); return (Atom) (NonTagPart(t));
} }
#endif #endif
inline EXTERN int IsAtomTerm (Term); inline EXTERN int IsAtomTerm(Term);
inline EXTERN int inline EXTERN int IsAtomTerm(Term t)
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 inline EXTERN Term MkIntTerm(Int n)
MkIntTerm (Int n)
{ {
return (Term) (TAGGED (NumberTag, (n))); return (Term) (TAGGED(NumberTag, (n)));
} }
@ -746,22 +753,20 @@ MkIntTerm (Int n)
overflow problems are possible overflow problems are possible
*/ */
inline EXTERN Term MkIntConstant (Int); inline EXTERN Term MkIntConstant(Int);
inline EXTERN Term inline EXTERN Term MkIntConstant(Int n)
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 inline EXTERN int IsIntTerm(Term t)
IsIntTerm (Term t)
{ {
return (int) (CHKTAG ((t), NumberTag)); return (int) (CHKTAG((t), NumberTag));
} }
@ -775,8 +780,8 @@ IsIntTerm (Term t)
#ifdef TAGS_FAST_OPS #ifdef TAGS_FAST_OPS
#define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1) #define IntInBnd(X) (Unsigned( ( (Int)(X) >> (32-7) ) + 1) <= 1)
#else #else
#define IntInBnd(X) ( (X) < (Int)MAX_ABS_INT && \ #define IntInBnd(X) ( (X) < MAX_ABS_INT && \
(X) > -(Int)MAX_ABS_INT-1 ) (X) > -MAX_ABS_INT-1L )
#endif #endif
#endif #endif
#ifdef C_PROLOG #ifdef C_PROLOG
@ -791,7 +796,8 @@ IsIntTerm (Term t)
extern ADDR HeapBase, extern ADDR HeapBase,
LocalBase, LocalBase,
GlobalBase, GlobalBase,
TrailBase, TrailTop, ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; TrailBase, TrailTop,
ForeignCodeBase, ForeignCodeTop, ForeignCodeMax;
/* /*
@ -809,32 +815,29 @@ extern ADDR HeapBase,
#define IsAccessFunc(func) ((func) == FunctorAccess) #define IsAccessFunc(func) ((func) == FunctorAccess)
inline EXTERN Term MkIntegerTerm (Int); inline EXTERN Term MkIntegerTerm(Int);
inline EXTERN Term inline EXTERN Term MkIntegerTerm(Int n)
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 inline EXTERN int IsIntegerTerm(Term t)
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 inline EXTERN Int IntegerOfTerm(Term t)
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 ******************/ /*************** 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 inline EXTERN Term ArgOfTerm(int i, Term t)
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 inline EXTERN Term HeadOfTerm(Term t)
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 inline EXTERN Term TailOfTerm(Term t)
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 inline EXTERN Term ArgOfTermCell(int i, Term t)
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 inline EXTERN Term HeadOfTermCell(Term t)
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 inline EXTERN Term TailOfTermCell(Term t)
TailOfTermCell (Term t)
{ {
return (Term) ((CELL) (RepPair (t) + 1)); return (Term) ((CELL)(RepPair(t) + 1));
} }
@ -937,14 +934,12 @@ extern char version_number[];
/* consult stack management */ /* consult stack management */
typedef union CONSULT_OBJ typedef union CONSULT_OBJ {
{
char *filename; char *filename;
int mode; int mode;
Prop p; Prop p;
union CONSULT_OBJ *c; union CONSULT_OBJ *c;
} } consult_obj;
consult_obj;
/********* common instructions codes*************************/ /********* common instructions codes*************************/
@ -953,12 +948,10 @@ consult_obj;
#if USE_THREADED_CODE #if USE_THREADED_CODE
/************ reverse lookup of instructions *****************/ /************ reverse lookup of instructions *****************/
typedef struct opcode_tab_entry typedef struct opcode_tab_entry {
{
OPCODE opc; OPCODE opc;
op_numbers opnum; op_numbers opnum;
} } opentry;
opentry;
#endif #endif
@ -974,14 +967,16 @@ extern int CurFileNo;
/********* Prolog may be in several modes *******************************/ /********* Prolog may be in several modes *******************************/
#define BootMode 1 /* if booting or restoring */ typedef enum {
#define UserMode 2 /* Normal mode */ BootMode = 1, /* if booting or restoring */
#define CritMode 4 /* If we are meddling with the heap */ UserMode = 2, /* Normal mode */
#define FullLMode 8 /* to access the hidden atoms chain */ CritMode = 4, /* If we are meddling with the heap */
#define AbortMode 16 /* expecting to abort */ AbortMode = 8, /* expecting to abort */
#define InterruptMode 32 /* under an interrupt */ 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 SIZEOF_INT_P==4
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
@ -1022,17 +1017,46 @@ extern int yap_argc;
GLOBAL_LOCKS_who_locked_heap = worker_id; \ GLOBAL_LOCKS_who_locked_heap = worker_id; \
} \ } \
PrologMode |= CritMode; \ PrologMode |= CritMode; \
CritLocks++; \
} }
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
{ \ { \
if ((PrologMode ^= CritMode) & AbortMode) Abort((char *)NIL); \ CritLocks--; \
if (!CritLocks) { \
PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \
} \
if (PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \
Abort(""); \
} \
GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \ GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \
UNLOCK(GLOBAL_LOCKS_heap_access); \ UNLOCK(GLOBAL_LOCKS_heap_access); \
} \
} }
#else #else
#define YAPEnterCriticalSection() PrologMode |= CritMode; #define YAPEnterCriticalSection() \
{ \
PrologMode |= CritMode; \
CritLocks++; \
}
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
if((PrologMode ^= CritMode) & AbortMode) Abort((char *)NIL); { \
CritLocks--; \
if (!CritLocks) { \
PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \
} \
if (PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \
Abort(""); \
} \
} \
}
#endif /* YAPOR */ #endif /* YAPOR */
/* when we are calling the InitStaff procedures */ /* when we are calling the InitStaff procedures */
@ -1047,12 +1071,10 @@ extern int compile_arrays;
/* I assume that the size of this structure is a multiple of the size /* I assume that the size of this structure is a multiple of the size
of CELL!!! */ of CELL!!! */
typedef struct TIMED_MAVAR typedef struct TIMED_MAVAR{
{
CELL value; CELL value;
CELL clock; CELL clock;
} } timed_var;
timed_var;
/********* while debugging you may need some info ***********************/ /********* while debugging you may need some info ***********************/
@ -1077,3 +1099,4 @@ extern int snoozing;
#if SBA #if SBA
#include "sbaunify.h" #include "sbaunify.h"
#endif #endif

657
VC/include/Yatom.h
View File

File diff suppressed because it is too large Load Diff

389
VC/include/sshift.h
View File

@ -24,7 +24,12 @@
/* The difference between the old stack pointers and the new ones */ /* The difference between the old stack pointers and the new ones */
extern Int HDiff, GDiff, LDiff, TrDiff, XDiff, DelayDiff; extern Int HDiff,
GDiff,
LDiff,
TrDiff,
XDiff,
DelayDiff;
/* The old stack pointers */ /* The old stack pointers */
extern CELL *OldASP, *OldLCL0; extern CELL *OldASP, *OldLCL0;
@ -36,569 +41,515 @@ extern ADDR OldHeapBase, OldHeapTop;
#define CharP(ptr) ((char *) (ptr)) #define CharP(ptr) ((char *) (ptr))
inline EXTERN int IsHeapP (CELL *); inline EXTERN int IsHeapP(CELL *);
inline EXTERN int inline EXTERN int IsHeapP(CELL * ptr)
IsHeapP (CELL * ptr)
{ {
return (int) ((ptr >= (CELL *) HeapBase && ptr <= (CELL *) HeapTop)); return (int) ((ptr >= (CELL *)HeapBase && ptr <= (CELL *)HeapTop) );
} }
/* Adjusting cells and pointers to cells */ /* Adjusting cells and pointers to cells */
inline EXTERN CELL *PtoGloAdjust (CELL *); inline EXTERN CELL * PtoGloAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * PtoGloAdjust(CELL * ptr)
PtoGloAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + GDiff))); return (CELL *) (((CELL *)(CharP(ptr) + GDiff)) );
} }
inline EXTERN CELL *PtoDelayAdjust (CELL *); inline EXTERN CELL * PtoDelayAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * PtoDelayAdjust(CELL * ptr)
PtoDelayAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + DelayDiff))); return (CELL *) (((CELL *)(CharP(ptr) + DelayDiff)) );
} }
inline EXTERN tr_fr_ptr PtoTRAdjust (tr_fr_ptr); inline EXTERN tr_fr_ptr PtoTRAdjust(tr_fr_ptr);
inline EXTERN tr_fr_ptr inline EXTERN tr_fr_ptr PtoTRAdjust(tr_fr_ptr ptr)
PtoTRAdjust (tr_fr_ptr ptr)
{ {
return (tr_fr_ptr) (((tr_fr_ptr) (CharP (ptr) + TrDiff))); return (tr_fr_ptr) (((tr_fr_ptr)(CharP(ptr) + TrDiff)) );
} }
inline EXTERN CELL *CellPtoTRAdjust (CELL *); inline EXTERN CELL * CellPtoTRAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * CellPtoTRAdjust(CELL * ptr)
CellPtoTRAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + TrDiff))); return (CELL *) (((CELL *)(CharP(ptr) + TrDiff)) );
} }
inline EXTERN CELL *PtoLocAdjust (CELL *); inline EXTERN CELL * PtoLocAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * PtoLocAdjust(CELL * ptr)
PtoLocAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + LDiff))); return (CELL *) (((CELL *)(CharP(ptr) + LDiff)) );
} }
inline EXTERN choiceptr ChoicePtrAdjust (choiceptr); inline EXTERN choiceptr ChoicePtrAdjust(choiceptr);
inline EXTERN choiceptr inline EXTERN choiceptr ChoicePtrAdjust(choiceptr ptr)
ChoicePtrAdjust (choiceptr ptr)
{ {
return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) );
} }
#ifdef TABLING #ifdef TABLING
inline EXTERN choiceptr ConsumerChoicePtrAdjust (choiceptr); inline EXTERN choiceptr ConsumerChoicePtrAdjust(choiceptr);
inline EXTERN choiceptr inline EXTERN choiceptr ConsumerChoicePtrAdjust(choiceptr ptr)
ConsumerChoicePtrAdjust (choiceptr ptr)
{ {
return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) );
} }
inline EXTERN choiceptr GeneratorChoicePtrAdjust (choiceptr); inline EXTERN choiceptr GeneratorChoicePtrAdjust(choiceptr);
inline EXTERN choiceptr inline EXTERN choiceptr GeneratorChoicePtrAdjust(choiceptr ptr)
GeneratorChoicePtrAdjust (choiceptr ptr)
{ {
return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff))); return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) );
} }
#endif /* TABLING */ #endif /* TABLING */
inline EXTERN CELL GlobalAdjust (CELL); inline EXTERN CELL GlobalAdjust(CELL);
inline EXTERN CELL inline EXTERN CELL GlobalAdjust(CELL val)
GlobalAdjust (CELL val)
{ {
return (CELL) ((val + GDiff)); return (CELL) ((val+GDiff) );
} }
inline EXTERN CELL DelayAdjust (CELL); inline EXTERN CELL DelayAdjust(CELL);
inline EXTERN CELL inline EXTERN CELL DelayAdjust(CELL val)
DelayAdjust (CELL val)
{ {
return (CELL) ((val + DelayDiff)); return (CELL) ((val+DelayDiff) );
} }
inline EXTERN ADDR GlobalAddrAdjust (ADDR); inline EXTERN ADDR GlobalAddrAdjust(ADDR);
inline EXTERN ADDR inline EXTERN ADDR GlobalAddrAdjust(ADDR ptr)
GlobalAddrAdjust (ADDR ptr)
{ {
return (ADDR) ((ptr + GDiff)); return (ADDR) ((ptr+GDiff) );
} }
inline EXTERN ADDR DelayAddrAdjust (ADDR); inline EXTERN ADDR DelayAddrAdjust(ADDR);
inline EXTERN ADDR inline EXTERN ADDR DelayAddrAdjust(ADDR ptr)
DelayAddrAdjust (ADDR ptr)
{ {
return (ADDR) ((ptr + DelayDiff)); return (ADDR) ((ptr+DelayDiff) );
} }
inline EXTERN CELL LocalAdjust (CELL); inline EXTERN CELL LocalAdjust(CELL);
inline EXTERN CELL inline EXTERN CELL LocalAdjust(CELL val)
LocalAdjust (CELL val)
{ {
return (CELL) ((val + LDiff)); return (CELL) ((val+LDiff) );
} }
inline EXTERN ADDR LocalAddrAdjust (ADDR); inline EXTERN ADDR LocalAddrAdjust(ADDR);
inline EXTERN ADDR inline EXTERN ADDR LocalAddrAdjust(ADDR ptr)
LocalAddrAdjust (ADDR ptr)
{ {
return (ADDR) ((ptr + LDiff)); return (ADDR) ((ptr+LDiff) );
} }
inline EXTERN CELL TrailAdjust (CELL); inline EXTERN CELL TrailAdjust(CELL);
inline EXTERN CELL inline EXTERN CELL TrailAdjust(CELL val)
TrailAdjust (CELL val)
{ {
return (CELL) ((val + TrDiff)); return (CELL) ((val+TrDiff) );
} }
inline EXTERN ADDR TrailAddrAdjust (ADDR); inline EXTERN ADDR TrailAddrAdjust(ADDR);
inline EXTERN ADDR inline EXTERN ADDR TrailAddrAdjust(ADDR ptr)
TrailAddrAdjust (ADDR ptr)
{ {
return (ADDR) ((ptr + TrDiff)); return (ADDR) ((ptr+TrDiff) );
} }
/* heap data structures */ /* heap data structures */
inline EXTERN Functor FuncAdjust (Functor); inline EXTERN Functor FuncAdjust(Functor);
inline EXTERN Functor inline EXTERN Functor FuncAdjust(Functor f)
FuncAdjust (Functor f)
{ {
return (Functor) ((Functor) (CharP (f) + HDiff)); return (Functor) ((Functor)(CharP(f)+HDiff) );
} }
inline EXTERN CELL *CellPtoHeapAdjust (CELL *); inline EXTERN CELL * CellPtoHeapAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * CellPtoHeapAdjust(CELL * ptr)
CellPtoHeapAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + HDiff))); return (CELL *) (((CELL *)(CharP(ptr) + HDiff)) );
} }
#if USE_OFFSETS #if USE_OFFSETS
inline EXTERN Atom AtomAdjust (Atom); inline EXTERN Atom AtomAdjust(Atom);
inline EXTERN Atom inline EXTERN Atom AtomAdjust(Atom at)
AtomAdjust (Atom at)
{ {
return (Atom) ((at)); return (Atom) ((at) );
} }
inline EXTERN Term AtomTermAdjust (Term); inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term inline EXTERN Term AtomTermAdjust(Term at)
AtomTermAdjust (Term at)
{ {
return (Term) ((at)); return (Term) ((at) );
} }
inline EXTERN Prop PropAdjust (Prop); inline EXTERN Prop PropAdjust(Prop);
inline EXTERN Prop inline EXTERN Prop PropAdjust(Prop p)
PropAdjust (Prop p)
{ {
return (Prop) ((p)); return (Prop) ((p) );
} }
#else #else
inline EXTERN Atom AtomAdjust (Atom); inline EXTERN Atom AtomAdjust(Atom);
inline EXTERN Atom inline EXTERN Atom AtomAdjust(Atom at)
AtomAdjust (Atom at)
{ {
return (Atom) ((Atom) (CharP (at) + HDiff)); return (Atom) ((Atom)(CharP(at)+HDiff) );
} }
#if MMAP_ADDR >= 0x40000000 #if MMAP_ADDR >= 0x40000000
inline EXTERN Term AtomTermAdjust (Term); inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term inline EXTERN Term AtomTermAdjust(Term at)
AtomTermAdjust (Term at)
{ {
return (Term) ((at)); return (Term) ((at) );
} }
#else #else
inline EXTERN Term AtomTermAdjust (Term); inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term inline EXTERN Term AtomTermAdjust(Term at)
AtomTermAdjust (Term at)
{ {
return (Term) (MkAtomTerm ((Atom) (CharP (AtomOfTerm (at) + HDiff)))); return (Term) (MkAtomTerm((Atom)(CharP(AtomOfTerm(at)+HDiff))) );
} }
#endif #endif
inline EXTERN Prop PropAdjust (Prop); inline EXTERN Prop PropAdjust(Prop);
inline EXTERN Prop inline EXTERN Prop PropAdjust(Prop p)
PropAdjust (Prop p)
{ {
return (Prop) ((Prop) (CharP (p) + HDiff)); return (Prop) ((Prop)(CharP(p)+HDiff) );
} }
#endif #endif
#if TAGS_FAST_OPS #if TAGS_FAST_OPS
inline EXTERN Term BlobTermAdjust (Term); inline EXTERN Term BlobTermAdjust(Term);
inline EXTERN Term inline EXTERN Term BlobTermAdjust(Term t)
BlobTermAdjust (Term t)
{ {
return (Term) ((t - HDiff)); return (Term) ((t-HDiff) );
} }
#else #else
inline EXTERN Term BlobTermAdjust (Term); inline EXTERN Term BlobTermAdjust(Term);
inline EXTERN Term inline EXTERN Term BlobTermAdjust(Term t)
BlobTermAdjust (Term t)
{ {
return (Term) ((t + HDiff)); return (Term) ((t+HDiff) );
} }
#endif #endif
inline EXTERN AtomEntry *AtomEntryAdjust (AtomEntry *); inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry *);
inline EXTERN AtomEntry * inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry * at)
AtomEntryAdjust (AtomEntry * at)
{ {
return (AtomEntry *) ((AtomEntry *) (CharP (at) + HDiff)); return (AtomEntry *) ((AtomEntry *)(CharP(at)+HDiff) );
} }
inline EXTERN consult_obj *ConsultObjAdjust (consult_obj *); inline EXTERN consult_obj * ConsultObjAdjust(consult_obj *);
inline EXTERN consult_obj * inline EXTERN consult_obj * ConsultObjAdjust(consult_obj * co)
ConsultObjAdjust (consult_obj * co)
{ {
return (consult_obj *) ((consult_obj *) (CharP (co) + HDiff)); return (consult_obj *) ((consult_obj *)(CharP(co)+HDiff) );
} }
inline EXTERN DBRef DBRefAdjust (DBRef); inline EXTERN DBRef DBRefAdjust(DBRef);
inline EXTERN DBRef inline EXTERN DBRef DBRefAdjust(DBRef dbr)
DBRefAdjust (DBRef dbr)
{ {
return (DBRef) ((DBRef) (CharP (dbr) + HDiff)); return (DBRef) ((DBRef)(CharP(dbr)+HDiff) );
} }
inline EXTERN Term CodeAdjust (Term); inline EXTERN Term CodeAdjust(Term);
inline EXTERN Term inline EXTERN Term CodeAdjust(Term dbr)
CodeAdjust (Term dbr)
{ {
return (Term) (((Term) (dbr) + HDiff)); return (Term) (((Term)(dbr)+HDiff) );
} }
inline EXTERN ADDR AddrAdjust (ADDR); inline EXTERN ADDR AddrAdjust(ADDR);
inline EXTERN ADDR inline EXTERN ADDR AddrAdjust(ADDR addr)
AddrAdjust (ADDR addr)
{ {
return (ADDR) ((ADDR) (CharP (addr) + HDiff)); return (ADDR) ((ADDR)(CharP(addr)+HDiff) );
} }
inline EXTERN CODEADDR CodeAddrAdjust (CODEADDR); inline EXTERN CODEADDR CodeAddrAdjust(CODEADDR);
inline EXTERN CODEADDR inline EXTERN CODEADDR CodeAddrAdjust(CODEADDR addr)
CodeAddrAdjust (CODEADDR addr)
{ {
return (CODEADDR) ((CODEADDR) (CharP (addr) + HDiff)); return (CODEADDR) ((CODEADDR)(CharP(addr)+HDiff) );
} }
inline EXTERN BlockHeader *BlockAdjust (BlockHeader *); inline EXTERN BlockHeader * BlockAdjust(BlockHeader *);
inline EXTERN BlockHeader * inline EXTERN BlockHeader * BlockAdjust(BlockHeader * addr)
BlockAdjust (BlockHeader * addr)
{ {
return (BlockHeader *) ((BlockHeader *) (CharP (addr) + HDiff)); return (BlockHeader *) ((BlockHeader *)(CharP(addr)+HDiff) );
} }
inline EXTERN yamop *PtoOpAdjust (yamop *); inline EXTERN yamop * PtoOpAdjust(yamop *);
inline EXTERN yamop * inline EXTERN yamop * PtoOpAdjust(yamop * ptr)
PtoOpAdjust (yamop * ptr)
{ {
return (yamop *) (((yamop *) (CharP (ptr) + HDiff))); return (yamop *) (((yamop *)(CharP(ptr) + HDiff)) );
} }
inline EXTERN CELL *PtoHeapCellAdjust (CELL *); inline EXTERN CELL * PtoHeapCellAdjust(CELL *);
inline EXTERN CELL * inline EXTERN CELL * PtoHeapCellAdjust(CELL * ptr)
PtoHeapCellAdjust (CELL * ptr)
{ {
return (CELL *) (((CELL *) (CharP (ptr) + HDiff))); return (CELL *) (((CELL *)(CharP(ptr) + HDiff)) );
} }
inline EXTERN PredEntry *PtoPredAdjust (PredEntry *); inline EXTERN PredEntry * PtoPredAdjust(PredEntry *);
inline EXTERN PredEntry * inline EXTERN PredEntry * PtoPredAdjust(PredEntry * ptr)
PtoPredAdjust (PredEntry * ptr)
{ {
return (PredEntry *) (((CELL *) (CharP (ptr) + HDiff))); return (PredEntry *) (((CELL *)(CharP(ptr) + HDiff)) );
} }
#if PRECOMPUTE_REGADDRESS #if PRECOMPUTE_REGADDRESS
inline EXTERN AREG XAdjust (AREG); inline EXTERN AREG XAdjust(AREG);
inline EXTERN AREG inline EXTERN AREG XAdjust(AREG reg)
XAdjust (AREG reg)
{ {
return (AREG) ((AREG) ((reg) + XDiff)); return (AREG) ((AREG)((reg)+XDiff) );
} }
#else #else
inline EXTERN AREG XAdjust (AREG); inline EXTERN AREG XAdjust(AREG);
inline EXTERN AREG inline EXTERN AREG XAdjust(AREG reg)
XAdjust (AREG reg)
{ {
return (AREG) ((reg)); return (AREG) ((reg) );
} }
#endif #endif
inline EXTERN YREG YAdjust (YREG); inline EXTERN YREG YAdjust(YREG);
inline EXTERN YREG inline EXTERN YREG YAdjust(YREG reg)
YAdjust (YREG reg)
{ {
return (YREG) ((reg)); return (YREG) ((reg) );
} }
inline EXTERN int IsOldLocal (CELL); inline EXTERN int IsOldLocal(CELL);
inline EXTERN int inline EXTERN int IsOldLocal(CELL reg)
IsOldLocal (CELL reg)
{ {
return (int) (IN_BETWEEN (OldASP, reg, OldLCL0)); return (int) (IN_BETWEEN(OldASP, reg, OldLCL0));
} }
/* require because the trail might contain dangling pointers */ /* require because the trail might contain dangling pointers */
inline EXTERN int IsOldLocalInTR (CELL); inline EXTERN int IsOldLocalInTR(CELL);
inline EXTERN int inline EXTERN int IsOldLocalInTR(CELL reg)
IsOldLocalInTR (CELL reg)
{ {
return (int) (IN_BETWEEN (OldH, reg, OldLCL0)); return (int) (IN_BETWEEN(OldH, reg, OldLCL0) );
} }
inline EXTERN int IsOldLocalInTRPtr (CELL *); inline EXTERN int IsOldLocalInTRPtr(CELL *);
inline EXTERN int inline EXTERN int IsOldLocalInTRPtr(CELL * ptr)
IsOldLocalInTRPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldH, ptr, OldLCL0)); return (int) (IN_BETWEEN(OldH, ptr, OldLCL0) );
} }
inline EXTERN int IsOldH (CELL); inline EXTERN int IsOldH(CELL);
inline EXTERN int inline EXTERN int IsOldH(CELL reg)
IsOldH (CELL reg)
{ {
return (int) ((CharP (reg) == CharP (OldH))); return (int) (( CharP(reg) == CharP(OldH) ) );
} }
inline EXTERN int IsOldGlobal (CELL); inline EXTERN int IsOldGlobal(CELL);
inline EXTERN int inline EXTERN int IsOldGlobal(CELL reg)
IsOldGlobal (CELL reg)
{ {
return (int) (IN_BETWEEN (OldH0, reg, OldH)); return (int) (IN_BETWEEN(OldH0, reg, OldH) );
} }
inline EXTERN int IsOldGlobalPtr (CELL *); inline EXTERN int IsOldGlobalPtr(CELL *);
inline EXTERN int inline EXTERN int IsOldGlobalPtr(CELL * ptr)
IsOldGlobalPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldH0, ptr, OldH)); return (int) (IN_BETWEEN( OldH0, ptr, OldH) );
} }
inline EXTERN int IsOldDelay (CELL); inline EXTERN int IsOldDelay(CELL);
inline EXTERN int inline EXTERN int IsOldDelay(CELL reg)
IsOldDelay (CELL reg)
{ {
return (int) (IN_BETWEEN (OldGlobalBase, reg, OldH0)); return (int) (IN_BETWEEN(OldGlobalBase, reg, OldH0) );
} }
inline EXTERN int IsOldDelayPtr (CELL *); inline EXTERN int IsOldDelayPtr(CELL *);
inline EXTERN int inline EXTERN int IsOldDelayPtr(CELL * ptr)
IsOldDelayPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldGlobalBase, ptr, OldH0)); return (int) (IN_BETWEEN( OldGlobalBase, ptr, OldH0) );
} }
inline EXTERN int IsOldTrail (CELL); inline EXTERN int IsOldTrail(CELL);
inline EXTERN int inline EXTERN int IsOldTrail(CELL reg)
IsOldTrail (CELL reg)
{ {
return (int) (IN_BETWEEN (OldTrailBase, reg, OldTR)); return (int) (IN_BETWEEN(OldTrailBase, reg, OldTR) );
} }
inline EXTERN int IsOldTrailPtr (CELL *); inline EXTERN int IsOldTrailPtr(CELL *);
inline EXTERN int inline EXTERN int IsOldTrailPtr(CELL * ptr)
IsOldTrailPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldTrailBase, ptr, OldTR)); return (int) (IN_BETWEEN(OldTrailBase, ptr, OldTR) );
} }
inline EXTERN int IsOldCode (CELL); inline EXTERN int IsOldCode(CELL);
inline EXTERN int inline EXTERN int IsOldCode(CELL reg)
IsOldCode (CELL reg)
{ {
return (int) (IN_BETWEEN (OldHeapBase, reg, OldHeapTop)); return (int) (IN_BETWEEN(OldHeapBase, reg, OldHeapTop) );
} }
inline EXTERN int IsOldCodeCellPtr (CELL *); inline EXTERN int IsOldCodeCellPtr(CELL *);
inline EXTERN int inline EXTERN int IsOldCodeCellPtr(CELL * ptr)
IsOldCodeCellPtr (CELL * ptr)
{ {
return (int) (IN_BETWEEN (OldHeapBase, ptr, OldHeapTop)); return (int) (IN_BETWEEN(OldHeapBase, ptr, OldHeapTop) );
} }
inline EXTERN int IsGlobal (CELL); inline EXTERN int IsGlobal(CELL);
inline EXTERN int inline EXTERN int IsGlobal(CELL reg)
IsGlobal (CELL reg)
{ {
return (int) (IN_BETWEEN (GlobalBase, reg, H)); return (int) (IN_BETWEEN(GlobalBase, reg, H) );
} }
void STD_PROTO (AdjustStacksAndTrail, (void)); void STD_PROTO(AdjustStacksAndTrail, (void));
void STD_PROTO (AdjustRegs, (int)); void STD_PROTO(AdjustRegs, (int));

2
changes4.3.html
View File

@ -16,6 +16,8 @@
<h2>Yap-4.3.19:</h2> <h2>Yap-4.3.19:</h2>
<ul> <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: new statistics/0.</li>
<li>FIXED: use 15 bits of precision for floats, instead of the <li>FIXED: use 15 bits of precision for floats, instead of the
default 6..</li> default 6..</li>

4
distribute
View File

@ -15,7 +15,7 @@ splat
cd include cd include
splat splat
/bin/cp config.h config.h.mine /bin/cp config.h config.h.mine
/bin/cp ../../linux/*.h . /bin/cp ../../../bins/cyg/*.h .
/bin/mv config.h.mine config.h /bin/mv config.h.mine config.h
cd ../../console cd ../../console
splat splat
@ -45,7 +45,7 @@ cd ../CHR
splat splat
cd ../.. cd ../..
if test "$1" = "--small"; then 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 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} 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 fi

6
pl/errors.yap
View File

@ -188,9 +188,9 @@ print_message(help,M) :-
'$output_error_message'(existence_error(source_sink,F), W) :- '$output_error_message'(existence_error(source_sink,F), W) :-
format(user_error,"[ EXISTENCE ERROR- ~w could not find file ~w ]~n", format(user_error,"[ EXISTENCE ERROR- ~w could not find file ~w ]~n",
[W,F]). [W,F]).
'$output_error_message'(existence_error(stream,_), Where) :- '$output_error_message'(existence_error(stream,Stream), Where) :-
format(user_error,"[ EXISTENCE ERROR- ~w: not an open stream ]~n", format(user_error,"[ EXISTENCE ERROR- ~w: ~w not an open stream ]~n",
[Where]). [Where,Stream]).
'$output_error_message'(evaluation_error(int_overflow), Where) :- '$output_error_message'(evaluation_error(int_overflow), Where) :-
format(user_error,"[ INTEGER OVERFLOW ERROR- ~w ]~n", format(user_error,"[ INTEGER OVERFLOW ERROR- ~w ]~n",
[Where]). [Where]).

2
pl/init.yap
View File

@ -33,7 +33,7 @@ not(G) :- not(G).
(:- G) :- '$execute'(G), !. (:- G) :- '$execute'(G), !.
'$$!'(CP) :- '$cut_by'(CP). '$$!'(CP) :- '$cut_by'(CP).
:- '$set_value'($doindex,true). :- '$set_value'('$doindex',true).
:- ['errors.yap', :- ['errors.yap',
'utils.yap', 'utils.yap',