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

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 */
/* atom structure */
typedef struct AtomEntryStruct
{
typedef struct AtomEntryStruct {
Atom NextOfAE; /* used to build hash chains */
Prop PropOfAE; /* property list for this atom */
#if defined(YAPOR) || defined(THREADS)
@ -79,12 +78,10 @@ AtomEntry;
typedef SFLAGS PropFlags;
/* basic property entry structure */
typedef struct PropEntryStruct
{
typedef struct PropEntryStruct {
Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */
}
PropEntry;
} PropEntry;
/* ************************* Functors **********************************/
@ -100,14 +97,13 @@ PropEntry;
#define FunctorProperty ((PropFlags)(0xbb00))
/* functor property */
typedef struct FunctorEntryStruct
{
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;
} FunctorEntry;
typedef FunctorEntry *Functor;

88
VC/include/Tags_24bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Tag Scheme for machines with 24 bits adresses (m68000) *
* version: $Id: Tags_24bits.h,v 1.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)
@ -32,7 +32,7 @@
ref 0mr000 address of cell
undefined 0mr000 pointing to itself
*/
*/
#define AllTagBits 0xfc000000L
#define TagBits 0xbc000000L
@ -64,124 +64,114 @@
#define YAP_PROTECTED_MASK 0x00000000L
inline EXTERN int IsVarTerm (Term);
inline EXTERN int IsVarTerm(Term);
inline EXTERN int
IsVarTerm (Term t)
inline EXTERN int 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
IsNonVarTerm (Term t)
inline EXTERN int 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 *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) (NonTagPart (t));
return (Term *) (NonTagPart(t));
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term 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
IsPairTerm (Term t)
inline EXTERN Int 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 *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) (NonTagPart (t));
return (Term *) (NonTagPart(t));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term 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
IsApplTerm (Term t)
inline EXTERN Int 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
IsAtomOrIntTerm (Term t)
inline EXTERN Int 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
AdjustPtr (Term t, Term off)
inline EXTERN Term 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
AdjustIDBPtr (Term t, Term off)
inline EXTERN Term AdjustIDBPtr(Term t, Term off)
{
return (Term) ((t) + off);
return (Term) ((t)+off);
}
static inline Int
IntOfTerm (Term t)
IntOfTerm(Term t)
{
Int n;
n = (Unsigned (t) & MaskPrim) >> 2;
n = (Unsigned(t) & MaskPrim) >> 2;
if (Unsigned (t) & AdrHiBit)
if (Unsigned(t) & AdrHiBit)
n |= 0xfc000000;
return (n);
}

83
VC/include/Tags_32LowTag.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32LowTag.h,v 1.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
@ -35,9 +35,9 @@
undefined mr.....00 address of cell pointing to itself
functors are represented as ptrs to the functor entry in the atom
property list
property list
*/
*/
#define SHIFT_LOW_TAG 2
#define SHIFT_HIGH_TAG 2
@ -82,90 +82,81 @@
#define YAP_PROTECTED_MASK 0xc0000000L
inline EXTERN int IsVarTerm (Term);
inline EXTERN int IsVarTerm(Term);
inline EXTERN int
IsVarTerm (Term t)
inline EXTERN int IsVarTerm(Term t)
{
return (int) (!((t) & LowTagBits));
}
inline EXTERN int IsNonVarTerm (Term);
inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int
IsNonVarTerm (Term t)
inline EXTERN int IsNonVarTerm(Term t)
{
return (int) (((t) & LowTagBits));
}
inline EXTERN Term *RepPair (Term);
inline EXTERN Term * RepPair(Term);
inline EXTERN Term *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) ((t) - PairBits);
return (Term *) ((t)-PairBits);
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term 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
IsPairTerm (Term t)
inline EXTERN Int IsPairTerm(Term t)
{
return (Int) ((((t) & LowTagBits) == PairBits));
}
inline EXTERN Term *RepAppl (Term);
inline EXTERN Term * RepAppl(Term);
inline EXTERN Term *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) (((t) - ApplBit));
return (Term *) (((t)-ApplBit));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term 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
IsApplTerm (Term t)
inline EXTERN Int IsApplTerm(Term t)
{
return (Int) ((((t) & LowTagBits) == ApplBit));
}
inline EXTERN Int IsAtomOrIntTerm (Term);
inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int
IsAtomOrIntTerm (Term t)
inline EXTERN Int IsAtomOrIntTerm(Term t)
{
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
AdjustPtr (Term t, Term off)
inline EXTERN Term 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
AdjustIDBPtr (Term t, Term off)
inline EXTERN Term 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
IntOfTerm (Term t)
inline EXTERN Int 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 *
* 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: $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 */
inline EXTERN int IsVarTerm (Term);
inline EXTERN int IsVarTerm(Term);
inline EXTERN int
IsVarTerm (Term t)
inline EXTERN int 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
IsNonVarTerm (Term t)
inline EXTERN int IsNonVarTerm(Term t)
{
return (int) (Signed (t) < 0);
return (int) (Signed(t) < 0);
}
#if UNIQUE_TAG_FOR_PAIRS
inline EXTERN Term *RepPair (Term);
inline EXTERN Term * RepPair(Term);
inline EXTERN Term *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) ((~(t)));
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term AbsPair(Term * p)
{
return (Term) ((~Unsigned (p)));
return (Term) ((~Unsigned(p)));
}
inline EXTERN Int IsPairTerm (Term);
inline EXTERN Int IsPairTerm(Term);
inline EXTERN Int
IsPairTerm (Term t)
inline EXTERN Int IsPairTerm(Term t)
{
return (Int) (((t) & PairBit));
}
inline EXTERN Term *RepAppl (Term);
inline EXTERN Term * RepAppl(Term);
inline EXTERN Term *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) ((-Signed (t)));
return (Term *) ((-Signed(t)));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term AbsAppl(Term * p)
{
return (Term) ((-Signed (p)));
return (Term) ((-Signed(p)));
}
inline EXTERN Int IsApplTerm (Term);
inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int
IsApplTerm (Term t)
inline EXTERN Int IsApplTerm(Term t)
{
return (Int) ((!((t) & LowTagBits)));
}
@ -181,60 +173,54 @@ IsApplTerm (Term t)
#else
inline EXTERN Term *RepPair (Term);
inline EXTERN Term * RepPair(Term);
inline EXTERN Term *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) ((-Signed (t)));
return (Term *) ((-Signed(t)));
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term 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
IsPairTerm (Term t)
inline EXTERN Int IsPairTerm(Term t)
{
return (Int) ((!((t) & LowTagBits)));
}
inline EXTERN Term *RepAppl (Term);
inline EXTERN Term * RepAppl(Term);
inline EXTERN Term *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) ((~(t)));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term AbsAppl(Term * p)
{
return (Term) ((~Unsigned (p)));
return (Term) ((~Unsigned(p)));
}
inline EXTERN Int IsApplTerm (Term);
inline EXTERN Int IsApplTerm(Term);
inline EXTERN Int
IsApplTerm (Term t)
inline EXTERN Int IsApplTerm(Term t)
{
return (Int) (((t) & ApplBit));
}
@ -242,78 +228,63 @@ IsApplTerm (Term t)
#endif
inline EXTERN Int IsAtomOrIntTerm (Term);
inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int
IsAtomOrIntTerm (Term t)
inline EXTERN Int 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
IntOfTerm (Term t)
inline EXTERN Int IntOfTerm(Term t)
{
return (Int) ((Int) (Unsigned (t) << 3) >> 5);
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);
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))));
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);
inline EXTERN Term
AdjustIDBPtr (Term t, Term off)
inline EXTERN Term AdjustIDBPtr(Term t, Term off)
{
return (Term) (IsVarTerm (t) ? (t) + (off) : (t) - (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);
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))));
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);
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)));
return (Term) (IsVarTerm(t) ? (t)+(off) : (IsApplTerm(t) ? (CELL)AbsAppl((CELL *)((CELL)RepAppl(t)+(off))) : (t)-(off)));
}
#endif

90
VC/include/Tags_32bits.h
View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32bits.h,v 1.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,
@ -69,122 +69,114 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
inline EXTERN int IsVarTerm (Term);
inline EXTERN int IsVarTerm(Term);
inline EXTERN int
IsVarTerm (Term t)
inline EXTERN int 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
IsNonVarTerm (Term t)
inline EXTERN int 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 *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) (NonTagPart (t));
return (Term *) (NonTagPart(t));
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term 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
IsPairTerm (Term t)
inline EXTERN Int 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 *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) (NonTagPart (t));
return (Term *) (NonTagPart(t));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term 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
IsApplTerm (Term t)
inline EXTERN Int 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
IsAtomOrIntTerm (Term t)
inline EXTERN int 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
AdjustPtr (Term t, Term off)
inline EXTERN Term 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
AdjustIDBPtr (Term t, Term off)
inline EXTERN Term 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
IntOfTerm (Term t)
inline EXTERN Int 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 *
* 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 $ *
* version: $Id: Tags_64bits.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/
#define TAG_64BITS 1
@ -51,7 +51,7 @@ property list
#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)))
#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
@ -71,90 +71,81 @@ property list
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
inline EXTERN int IsVarTerm (Term);
inline EXTERN int IsVarTerm(Term);
inline EXTERN int
IsVarTerm (Term t)
inline EXTERN int IsVarTerm(Term t)
{
return (int) ((!((t) & 0x1)));
}
inline EXTERN int IsNonVarTerm (Term);
inline EXTERN int IsNonVarTerm(Term);
inline EXTERN int
IsNonVarTerm (Term t)
inline EXTERN int IsNonVarTerm(Term t)
{
return (int) (((t) & 0x1));
}
inline EXTERN Term *RepPair (Term);
inline EXTERN Term * RepPair(Term);
inline EXTERN Term *
RepPair (Term t)
inline EXTERN Term * RepPair(Term t)
{
return (Term *) (((t) - PairBits));
return (Term *) (((t)-PairBits));
}
inline EXTERN Term AbsPair (Term *);
inline EXTERN Term AbsPair(Term *);
inline EXTERN Term
AbsPair (Term * p)
inline EXTERN Term 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
IsPairTerm (Term t)
inline EXTERN Int IsPairTerm(Term t)
{
return (Int) (((t) & 0x2));
}
inline EXTERN Term *RepAppl (Term);
inline EXTERN Term * RepAppl(Term);
inline EXTERN Term *
RepAppl (Term t)
inline EXTERN Term * RepAppl(Term t)
{
return (Term *) (((t) - ApplBits));
return (Term *) (((t)-ApplBits));
}
inline EXTERN Term AbsAppl (Term *);
inline EXTERN Term AbsAppl(Term *);
inline EXTERN Term
AbsAppl (Term * p)
inline EXTERN Term 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
IsApplTerm (Term t)
inline EXTERN Int IsApplTerm(Term t)
{
return (Int) ((((t) & 0x4)));
}
inline EXTERN Int IsAtomOrIntTerm (Term);
inline EXTERN Int IsAtomOrIntTerm(Term);
inline EXTERN Int
IsAtomOrIntTerm (Term t)
inline EXTERN Int IsAtomOrIntTerm(Term t)
{
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
AdjustPtr (Term t, Term off)
inline EXTERN Term 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
AdjustIDBPtr (Term t, Term off)
inline EXTERN Term 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
IntOfTerm (Term t)
inline EXTERN Int 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 *
* 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 $ *
* version: $Id: TermExt.h,v 1.2 2001-07-16 15:26:14 vsc Exp $ *
*************************************************************************/
#if USE_OFFSETS
@ -35,31 +35,27 @@
#define TermDot MkAtomTerm(AtomDot)
#ifdef IN_SECOND_QUADRANT
typedef enum
{
db_ref_e = sizeof (Functor *) | RBIT,
long_int_e = 2 * sizeof (Functor *) | RBIT,
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
big_int_e = 3*sizeof(Functor *)|RBIT,
double_e = 4*sizeof(Functor *)|RBIT
#else
double_e = 3 * sizeof (Functor *) | RBIT
double_e = 3*sizeof(Functor *)|RBIT
#endif
}
blob_type;
} blob_type;
#else
typedef enum
{
db_ref_e = sizeof (Functor *),
long_int_e = 2 * sizeof (Functor *),
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 *)
big_int_e = 3*sizeof(Functor *),
double_e = 4*sizeof(Functor *)
#else
double_e = 3 * sizeof (Functor *)
double_e = 3*sizeof(Functor *)
#endif
}
blob_type;
} blob_type;
#endif
#define FunctorDBRef ((Functor)(db_ref_e))
@ -71,12 +67,11 @@ blob_type;
#define EndSpecials (double_e)
inline EXTERN blob_type BlobOfFunctor (Functor f);
inline EXTERN blob_type BlobOfFunctor(Functor f);
inline EXTERN blob_type
BlobOfFunctor (Functor f)
inline EXTERN blob_type BlobOfFunctor(Functor f)
{
return (blob_type) ((CELL) f);
return (blob_type) ((CELL)f);
}
@ -85,32 +80,28 @@ BlobOfFunctor (Functor f)
#ifdef COROUTINING
typedef struct
{
typedef struct {
/* what to do when someone tries to bind our term to someone else
in some predefined context */
void (*bind_op) (Term *, Term);
void (*bind_op)(Term *, Term);
/* 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 */
void (*mark_op) (CELL *);
}
ext_op;
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 */
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;
} exts;
/* array with the ops for your favourite extensions */
extern ext_op attas[attvars_ext + 1];
extern ext_op attas[attvars_ext+1];
#endif
@ -129,25 +120,21 @@ special_functors;
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
inline EXTERN Term MkFloatTerm (Float);
inline EXTERN Term MkFloatTerm(Float);
inline EXTERN Term
MkFloatTerm (Float dbl)
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)));
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);
inline EXTERN Float
FloatOfTerm (Term t)
inline EXTERN Float 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)
#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
CpFloatUnaligned (CELL * ptr)
CpFloatUnaligned(CELL *ptr)
{
union
{
Float f;
CELL d[2];
}
u;
union { Float f; CELL d[2]; } u;
u.d[0] = ptr[1];
u.d[1] = ptr[2];
return (u.f);
return(u.f);
}
inline EXTERN Term MkFloatTerm (Float);
inline EXTERN Term MkFloatTerm(Float);
inline EXTERN Term
MkFloatTerm (Float dbl)
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)));
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);
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))));
return (Float) ((DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))));
}
@ -217,12 +193,11 @@ FloatOfTerm (Term t)
#endif
inline EXTERN int IsFloatTerm (Term);
inline EXTERN int IsFloatTerm(Term);
inline EXTERN int
IsFloatTerm (Term t)
inline EXTERN int 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; */
inline EXTERN Term MkLongIntTerm (Int);
inline EXTERN Term MkLongIntTerm(Int);
inline EXTERN Term
MkLongIntTerm (Int i)
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)));
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);
inline EXTERN Int
LongIntOfTerm (Term t)
inline EXTERN Int 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
IsLongIntTerm (Term t)
inline EXTERN int 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>
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));
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);
inline EXTERN int
IsBigIntTerm (Term t)
inline EXTERN int 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
IsLargeIntTerm (Term t)
inline EXTERN int IsLargeIntTerm(Term t)
{
return (int) (IsApplTerm (t)
&& ((FunctorOfTerm (t) <= FunctorBigInt)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorBigInt) && (FunctorOfTerm(t) >= FunctorLongInt)));
}
@ -301,10 +267,9 @@ IsLargeIntTerm (Term t)
#else
inline EXTERN int IsBigIntTerm (Term);
inline EXTERN int IsBigIntTerm(Term);
inline EXTERN int
IsBigIntTerm (Term t)
inline EXTERN int IsBigIntTerm(Term t)
{
return (int) (FALSE);
}
@ -312,12 +277,11 @@ IsBigIntTerm (Term t)
inline EXTERN int IsLargeIntTerm (Term);
inline EXTERN int IsLargeIntTerm(Term);
inline EXTERN int
IsLargeIntTerm (Term t)
inline EXTERN int 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; */
inline EXTERN int IsLargeNumTerm (Term);
inline EXTERN int IsLargeNumTerm(Term);
inline EXTERN int
IsLargeNumTerm (Term t)
inline EXTERN int IsLargeNumTerm(Term t)
{
return (int) (IsApplTerm (t)
&& ((FunctorOfTerm (t) <= FunctorDouble)
&& (FunctorOfTerm (t) >= FunctorLongInt)));
return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorDouble) && (FunctorOfTerm(t) >= FunctorLongInt)));
}
inline EXTERN int IsNumTerm (Term);
inline EXTERN int IsNumTerm(Term);
inline EXTERN int
IsNumTerm (Term t)
inline EXTERN int 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
IsAtomicTerm (Term t)
inline EXTERN Int 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
IsExtensionFunctor (Functor f)
inline EXTERN Int IsExtensionFunctor(Functor f)
{
return (Int) (f <= FunctorDouble);
}
inline EXTERN Int IsBlobFunctor (Functor);
inline EXTERN Int IsBlobFunctor(Functor);
inline EXTERN Int
IsBlobFunctor (Functor f)
inline EXTERN Int IsBlobFunctor(Functor f)
{
return (Int) ((f <= FunctorDouble && f >= FunctorDBRef));
}
inline EXTERN Int IsPrimitiveTerm (Term);
inline EXTERN Int IsPrimitiveTerm(Term);
inline EXTERN Int
IsPrimitiveTerm (Term t)
inline EXTERN Int IsPrimitiveTerm(Term t)
{
return (Int) ((IsAtomOrIntTerm (t)
|| (IsApplTerm (t) && IsBlobFunctor (FunctorOfTerm (t)))));
return (Int) ((IsAtomOrIntTerm(t) || (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t)))));
}
@ -395,10 +350,9 @@ IsPrimitiveTerm (Term t)
#ifdef TERM_EXTENSIONS
inline EXTERN Int IsAttachFunc (Functor);
inline EXTERN Int IsAttachFunc(Functor);
inline EXTERN Int
IsAttachFunc (Functor f)
inline EXTERN Int IsAttachFunc(Functor f)
{
return (Int) (FALSE);
}
@ -406,21 +360,19 @@ IsAttachFunc (Functor f)
inline EXTERN Int IsAttachedTerm (Term);
inline EXTERN Int IsAttachedTerm(Term);
inline EXTERN Int
IsAttachedTerm (Term t)
inline EXTERN Int 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
ExtFromCell (CELL * pt)
inline EXTERN exts ExtFromCell(CELL * pt)
{
return (exts) (pt[1]);
}
@ -430,10 +382,9 @@ ExtFromCell (CELL * pt)
#else
inline EXTERN Int IsAttachFunc (Functor);
inline EXTERN Int IsAttachFunc(Functor);
inline EXTERN Int
IsAttachFunc (Functor f)
inline EXTERN Int IsAttachFunc(Functor f)
{
return (Int) (FALSE);
}
@ -441,10 +392,9 @@ IsAttachFunc (Functor f)
inline EXTERN Int IsAttachedTerm (Term);
inline EXTERN Int IsAttachedTerm(Term);
inline EXTERN Int
IsAttachedTerm (Term t)
inline EXTERN Int IsAttachedTerm(Term t)
{
return (Int) (FALSE);
}
@ -453,24 +403,23 @@ IsAttachedTerm (Term t)
#endif
EXTERN int STD_PROTO (unify_extension, (Functor, CELL, CELL *, CELL));
EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL));
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:
return (d0 == d1);
case long_int_e:
return (pt0[1] == RepAppl (d1)[1]);
return(pt0[1] == RepAppl(d1)[1]);
#ifdef USE_GMP
case big_int_e:
return (mpz_cmp (BigIntOfTerm (d0), BigIntOfTerm (d1)) == 0);
return (mpz_cmp(BigIntOfTerm(d0),BigIntOfTerm(d1)) == 0);
#endif /* USE_GMP */
case double_e:
{
CELL *pt1 = RepAppl (d1);
CELL *pt1 = RepAppl(d1);
return (pt0[1] == pt1[1]
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
&& 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 *
* 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"
@ -86,6 +86,20 @@
#endif
#endif
#ifdef SBA
#ifdef YAPOR
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#endif
#ifdef TABLING
#ifndef FROZEN_STACKS
#define FROZEN_STACKS 1
#endif
#endif
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
/* adjust a config.h from mingw32 to work with vc++ */
#ifdef HAVE_GCC
@ -157,8 +171,9 @@
/* */ 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;
@ -166,6 +181,7 @@ error Yap require integer types of the same size as a pointer
#else
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;
@ -194,10 +211,13 @@ error Yap requires integer types of the same size as a pointer
# else
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;
#if SIZEOF_INT<SIZEOF_INT_P
@ -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
@ -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 */
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
@ -604,10 +624,9 @@ 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);
}
@ -615,20 +634,18 @@ VarOfTerm (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++));
}
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);
}
@ -636,108 +653,98 @@ IsUnboundVar (Term t)
#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++));
}
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
@ -791,7 +796,8 @@ IsIntTerm (Term t)
extern ADDR HeapBase,
LocalBase,
GlobalBase,
TrailBase, TrailTop, ForeignCodeBase, ForeignCodeTop, ForeignCodeMax;
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));
}
@ -937,14 +934,12 @@ extern char version_number[];
/* consult stack management */
typedef union CONSULT_OBJ
{
typedef union CONSULT_OBJ {
char *filename;
int mode;
Prop p;
union CONSULT_OBJ *c;
}
consult_obj;
} consult_obj;
/********* common instructions codes*************************/
@ -953,12 +948,10 @@ 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
@ -974,14 +967,16 @@ extern int CurFileNo;
/********* 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)
@ -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); \
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 YAPEnterCriticalSection() \
{ \
PrologMode |= CritMode; \
CritLocks++; \
}
#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 */
/* 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
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 ***********************/
@ -1077,3 +1099,4 @@ extern int snoozing;
#if SBA
#include "sbaunify.h"
#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 */
extern Int HDiff, GDiff, LDiff, TrDiff, XDiff, DelayDiff;
extern Int HDiff,
GDiff,
LDiff,
TrDiff,
XDiff,
DelayDiff;
/* The old stack pointers */
extern CELL *OldASP, *OldLCL0;
@ -36,569 +41,515 @@ extern ADDR OldHeapBase, OldHeapTop;
#define CharP(ptr) ((char *) (ptr))
inline EXTERN int IsHeapP (CELL *);
inline EXTERN int IsHeapP(CELL *);
inline EXTERN int
IsHeapP (CELL * ptr)
inline EXTERN int 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 */
inline EXTERN CELL *PtoGloAdjust (CELL *);
inline EXTERN CELL * PtoGloAdjust(CELL *);
inline EXTERN CELL *
PtoGloAdjust (CELL * ptr)
inline EXTERN CELL * 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 *
PtoDelayAdjust (CELL * ptr)
inline EXTERN CELL * 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
PtoTRAdjust (tr_fr_ptr ptr)
inline EXTERN tr_fr_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 *
CellPtoTRAdjust (CELL * ptr)
inline EXTERN CELL * 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 *
PtoLocAdjust (CELL * ptr)
inline EXTERN CELL * 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
ChoicePtrAdjust (choiceptr ptr)
inline EXTERN choiceptr ChoicePtrAdjust(choiceptr ptr)
{
return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff)));
return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) );
}
#ifdef TABLING
inline EXTERN choiceptr ConsumerChoicePtrAdjust (choiceptr);
inline EXTERN choiceptr ConsumerChoicePtrAdjust(choiceptr);
inline EXTERN choiceptr
ConsumerChoicePtrAdjust (choiceptr ptr)
inline EXTERN choiceptr 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
GeneratorChoicePtrAdjust (choiceptr ptr)
inline EXTERN choiceptr GeneratorChoicePtrAdjust(choiceptr ptr)
{
return (choiceptr) (((choiceptr) (CharP (ptr) + LDiff)));
return (choiceptr) (((choiceptr)(CharP(ptr) + LDiff)) );
}
#endif /* TABLING */
inline EXTERN CELL GlobalAdjust (CELL);
inline EXTERN CELL GlobalAdjust(CELL);
inline EXTERN CELL
GlobalAdjust (CELL val)
inline EXTERN CELL GlobalAdjust(CELL val)
{
return (CELL) ((val + GDiff));
return (CELL) ((val+GDiff) );
}
inline EXTERN CELL DelayAdjust (CELL);
inline EXTERN CELL DelayAdjust(CELL);
inline EXTERN CELL
DelayAdjust (CELL val)
inline EXTERN CELL DelayAdjust(CELL val)
{
return (CELL) ((val + DelayDiff));
return (CELL) ((val+DelayDiff) );
}
inline EXTERN ADDR GlobalAddrAdjust (ADDR);
inline EXTERN ADDR GlobalAddrAdjust(ADDR);
inline EXTERN ADDR
GlobalAddrAdjust (ADDR ptr)
inline EXTERN ADDR GlobalAddrAdjust(ADDR ptr)
{
return (ADDR) ((ptr + GDiff));
return (ADDR) ((ptr+GDiff) );
}
inline EXTERN ADDR DelayAddrAdjust (ADDR);
inline EXTERN ADDR DelayAddrAdjust(ADDR);
inline EXTERN ADDR
DelayAddrAdjust (ADDR ptr)
inline EXTERN ADDR DelayAddrAdjust(ADDR ptr)
{
return (ADDR) ((ptr + DelayDiff));
return (ADDR) ((ptr+DelayDiff) );
}
inline EXTERN CELL LocalAdjust (CELL);
inline EXTERN CELL LocalAdjust(CELL);
inline EXTERN CELL
LocalAdjust (CELL val)
inline EXTERN CELL LocalAdjust(CELL val)
{
return (CELL) ((val + LDiff));
return (CELL) ((val+LDiff) );
}
inline EXTERN ADDR LocalAddrAdjust (ADDR);
inline EXTERN ADDR LocalAddrAdjust(ADDR);
inline EXTERN ADDR
LocalAddrAdjust (ADDR ptr)
inline EXTERN ADDR LocalAddrAdjust(ADDR ptr)
{
return (ADDR) ((ptr + LDiff));
return (ADDR) ((ptr+LDiff) );
}
inline EXTERN CELL TrailAdjust (CELL);
inline EXTERN CELL TrailAdjust(CELL);
inline EXTERN CELL
TrailAdjust (CELL val)
inline EXTERN CELL TrailAdjust(CELL val)
{
return (CELL) ((val + TrDiff));
return (CELL) ((val+TrDiff) );
}
inline EXTERN ADDR TrailAddrAdjust (ADDR);
inline EXTERN ADDR TrailAddrAdjust(ADDR);
inline EXTERN ADDR
TrailAddrAdjust (ADDR ptr)
inline EXTERN ADDR TrailAddrAdjust(ADDR ptr)
{
return (ADDR) ((ptr + TrDiff));
return (ADDR) ((ptr+TrDiff) );
}
/* heap data structures */
inline EXTERN Functor FuncAdjust (Functor);
inline EXTERN Functor FuncAdjust(Functor);
inline EXTERN Functor
FuncAdjust (Functor f)
inline EXTERN Functor 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 *
CellPtoHeapAdjust (CELL * ptr)
inline EXTERN CELL * CellPtoHeapAdjust(CELL * ptr)
{
return (CELL *) (((CELL *) (CharP (ptr) + HDiff)));
return (CELL *) (((CELL *)(CharP(ptr) + HDiff)) );
}
#if USE_OFFSETS
inline EXTERN Atom AtomAdjust (Atom);
inline EXTERN Atom AtomAdjust(Atom);
inline EXTERN Atom
AtomAdjust (Atom at)
inline EXTERN Atom AtomAdjust(Atom at)
{
return (Atom) ((at));
return (Atom) ((at) );
}
inline EXTERN Term AtomTermAdjust (Term);
inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term
AtomTermAdjust (Term at)
inline EXTERN Term AtomTermAdjust(Term at)
{
return (Term) ((at));
return (Term) ((at) );
}
inline EXTERN Prop PropAdjust (Prop);
inline EXTERN Prop PropAdjust(Prop);
inline EXTERN Prop
PropAdjust (Prop p)
inline EXTERN Prop PropAdjust(Prop p)
{
return (Prop) ((p));
return (Prop) ((p) );
}
#else
inline EXTERN Atom AtomAdjust (Atom);
inline EXTERN Atom AtomAdjust(Atom);
inline EXTERN Atom
AtomAdjust (Atom at)
inline EXTERN Atom AtomAdjust(Atom at)
{
return (Atom) ((Atom) (CharP (at) + HDiff));
return (Atom) ((Atom)(CharP(at)+HDiff) );
}
#if MMAP_ADDR >= 0x40000000
inline EXTERN Term AtomTermAdjust (Term);
inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term
AtomTermAdjust (Term at)
inline EXTERN Term AtomTermAdjust(Term at)
{
return (Term) ((at));
return (Term) ((at) );
}
#else
inline EXTERN Term AtomTermAdjust (Term);
inline EXTERN Term AtomTermAdjust(Term);
inline EXTERN Term
AtomTermAdjust (Term at)
inline EXTERN Term AtomTermAdjust(Term at)
{
return (Term) (MkAtomTerm ((Atom) (CharP (AtomOfTerm (at) + HDiff))));
return (Term) (MkAtomTerm((Atom)(CharP(AtomOfTerm(at)+HDiff))) );
}
#endif
inline EXTERN Prop PropAdjust (Prop);
inline EXTERN Prop PropAdjust(Prop);
inline EXTERN Prop
PropAdjust (Prop p)
inline EXTERN Prop PropAdjust(Prop p)
{
return (Prop) ((Prop) (CharP (p) + HDiff));
return (Prop) ((Prop)(CharP(p)+HDiff) );
}
#endif
#if TAGS_FAST_OPS
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermAdjust(Term);
inline EXTERN Term
BlobTermAdjust (Term t)
inline EXTERN Term BlobTermAdjust(Term t)
{
return (Term) ((t - HDiff));
return (Term) ((t-HDiff) );
}
#else
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermAdjust(Term);
inline EXTERN Term
BlobTermAdjust (Term t)
inline EXTERN Term BlobTermAdjust(Term t)
{
return (Term) ((t + HDiff));
return (Term) ((t+HDiff) );
}
#endif
inline EXTERN AtomEntry *AtomEntryAdjust (AtomEntry *);
inline EXTERN AtomEntry * AtomEntryAdjust(AtomEntry *);
inline EXTERN AtomEntry *
AtomEntryAdjust (AtomEntry * at)
inline EXTERN AtomEntry * 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 *
ConsultObjAdjust (consult_obj * co)
inline EXTERN consult_obj * 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
DBRefAdjust (DBRef dbr)
inline EXTERN DBRef 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
CodeAdjust (Term dbr)
inline EXTERN Term 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
AddrAdjust (ADDR addr)
inline EXTERN 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
CodeAddrAdjust (CODEADDR addr)
inline EXTERN CODEADDR 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 *
BlockAdjust (BlockHeader * addr)
inline EXTERN BlockHeader * 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 *
PtoOpAdjust (yamop * ptr)
inline EXTERN yamop * 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 *
PtoHeapCellAdjust (CELL * ptr)
inline EXTERN CELL * 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 *
PtoPredAdjust (PredEntry * ptr)
inline EXTERN PredEntry * PtoPredAdjust(PredEntry * ptr)
{
return (PredEntry *) (((CELL *) (CharP (ptr) + HDiff)));
return (PredEntry *) (((CELL *)(CharP(ptr) + HDiff)) );
}
#if PRECOMPUTE_REGADDRESS
inline EXTERN AREG XAdjust (AREG);
inline EXTERN AREG XAdjust(AREG);
inline EXTERN AREG
XAdjust (AREG reg)
inline EXTERN AREG XAdjust(AREG reg)
{
return (AREG) ((AREG) ((reg) + XDiff));
return (AREG) ((AREG)((reg)+XDiff) );
}
#else
inline EXTERN AREG XAdjust (AREG);
inline EXTERN AREG XAdjust(AREG);
inline EXTERN AREG
XAdjust (AREG reg)
inline EXTERN AREG XAdjust(AREG reg)
{
return (AREG) ((reg));
return (AREG) ((reg) );
}
#endif
inline EXTERN YREG YAdjust (YREG);
inline EXTERN YREG YAdjust(YREG);
inline EXTERN YREG
YAdjust (YREG reg)
inline EXTERN YREG YAdjust(YREG reg)
{
return (YREG) ((reg));
return (YREG) ((reg) );
}
inline EXTERN int IsOldLocal (CELL);
inline EXTERN int IsOldLocal(CELL);
inline EXTERN int
IsOldLocal (CELL reg)
inline EXTERN int 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 */
inline EXTERN int IsOldLocalInTR (CELL);
inline EXTERN int IsOldLocalInTR(CELL);
inline EXTERN int
IsOldLocalInTR (CELL reg)
inline EXTERN int 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
IsOldLocalInTRPtr (CELL * ptr)
inline EXTERN int 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
IsOldH (CELL reg)
inline EXTERN int 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
IsOldGlobal (CELL reg)
inline EXTERN int 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
IsOldGlobalPtr (CELL * ptr)
inline EXTERN int 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
IsOldDelay (CELL reg)
inline EXTERN int 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
IsOldDelayPtr (CELL * ptr)
inline EXTERN int 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
IsOldTrail (CELL reg)
inline EXTERN int 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
IsOldTrailPtr (CELL * ptr)
inline EXTERN int 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
IsOldCode (CELL reg)
inline EXTERN int 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
IsOldCodeCellPtr (CELL * ptr)
inline EXTERN int 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
IsGlobal (CELL reg)
inline EXTERN int 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 (AdjustRegs, (int));
void STD_PROTO(AdjustStacksAndTrail, (void));
void STD_PROTO(AdjustRegs, (int));

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