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

all global symbols should now start with _YAP

Browse Source 
global functions should not be called from within file (bug in
binutils/WIN32).


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@675 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-11-11 17:38:10 +00:00
parent 932a850d5e
commit 7b2c4dc6ff
89 changed files with 8506 additions and 8901 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1874
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

92
C/adtdefs.c
View File

@ -61,7 +61,7 @@ InlinedUnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
if (p0 != NIL) { if (p0 != NIL) {
return ((Functor) RepProp(p0)); return ((Functor) RepProp(p0));
} }
p = (FunctorEntry *) AllocAtomSpace(sizeof(*p)); p = (FunctorEntry *) _YAP_AllocAtomSpace(sizeof(*p));
p->KindOfPE = FunctorProperty; p->KindOfPE = FunctorProperty;
p->NameOfFE = AbsAtom(ae); p->NameOfFE = AbsAtom(ae);
p->ArityOfFE = arity; p->ArityOfFE = arity;
@ -73,14 +73,14 @@ InlinedUnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
} }
Functor Functor
UnlockedMkFunctor(AtomEntry *ae, unsigned int arity) _YAP_UnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
{ {
return(InlinedUnlockedMkFunctor(ae, arity)); return(InlinedUnlockedMkFunctor(ae, arity));
} }
/* vsc: We must guarantee that IsVarTerm(functor) returns true! */ /* vsc: We must guarantee that IsVarTerm(functor) returns true! */
Functor Functor
MkFunctor(Atom ap, unsigned int arity) _YAP_MkFunctor(Atom ap, unsigned int arity)
{ {
AtomEntry *ae = RepAtom(ap); AtomEntry *ae = RepAtom(ap);
Functor f; Functor f;
@ -93,7 +93,7 @@ MkFunctor(Atom ap, unsigned int arity)
/* vsc: We must guarantee that IsVarTerm(functor) returns true! */ /* vsc: We must guarantee that IsVarTerm(functor) returns true! */
void void
MkFunctorWithAddress(Atom ap, unsigned int arity, FunctorEntry *p) _YAP_MkFunctorWithAddress(Atom ap, unsigned int arity, FunctorEntry *p)
{ {
AtomEntry *ae = RepAtom(ap); AtomEntry *ae = RepAtom(ap);
@ -138,7 +138,7 @@ SearchAtom(unsigned char *p, Atom a) {
return(NIL); return(NIL);
} }
Atom static Atom
LookupAtom(char *atom) LookupAtom(char *atom)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
register CELL hash; register CELL hash;
@ -160,7 +160,7 @@ LookupAtom(char *atom)
return(a); return(a);
} }
/* add new atom to start of chain */ /* add new atom to start of chain */
ae = (AtomEntry *) AllocAtomSpace((sizeof *ae) + strlen(atom)); ae = (AtomEntry *) _YAP_AllocAtomSpace((sizeof *ae) + strlen(atom));
a = AbsAtom(ae); a = AbsAtom(ae);
ae->NextOfAE = HashChain[hash].Entry; ae->NextOfAE = HashChain[hash].Entry;
HashChain[hash].Entry = a; HashChain[hash].Entry = a;
@ -173,7 +173,13 @@ LookupAtom(char *atom)
} }
Atom Atom
FullLookupAtom(char *atom) _YAP_LookupAtom(char *atom)
{ /* lookup atom in atom table */
return(LookupAtom(atom));
}
Atom
_YAP_FullLookupAtom(char *atom)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
Atom t; Atom t;
@ -184,7 +190,7 @@ FullLookupAtom(char *atom)
} }
void void
LookupAtomWithAddress(char *atom, AtomEntry *ae) _YAP_LookupAtomWithAddress(char *atom, AtomEntry *ae)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
register CELL hash; register CELL hash;
register unsigned char *p; register unsigned char *p;
@ -198,7 +204,7 @@ LookupAtomWithAddress(char *atom, AtomEntry *ae)
a = HashChain[hash].Entry; a = HashChain[hash].Entry;
/* search atom in chain */ /* search atom in chain */
if (SearchAtom(p, a) != NIL) { if (SearchAtom(p, a) != NIL) {
Error(FATAL_ERROR,TermNil,"repeated initialisation for atom %s", ae); _YAP_Error(FATAL_ERROR,TermNil,"repeated initialisation for atom %s", ae);
WRITE_UNLOCK(HashChain[hash].AERWLock); WRITE_UNLOCK(HashChain[hash].AERWLock);
return; return;
} }
@ -212,7 +218,7 @@ LookupAtomWithAddress(char *atom, AtomEntry *ae)
} }
void void
ReleaseAtom(Atom atom) _YAP_ReleaseAtom(Atom atom)
{ /* Releases an atom from the hash chain */ { /* Releases an atom from the hash chain */
register Int hash; register Int hash;
register unsigned char *p; register unsigned char *p;
@ -240,7 +246,7 @@ ReleaseAtom(Atom atom)
} }
static Prop static Prop
StaticGetAPropHavingLock(AtomEntry *ae, PropFlags kind) GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
{ /* look property list of atom a for kind */ { /* look property list of atom a for kind */
PropEntry *pp; PropEntry *pp;
@ -251,23 +257,29 @@ StaticGetAPropHavingLock(AtomEntry *ae, PropFlags kind)
} }
Prop Prop
GetAPropHavingLock(AtomEntry *ae, PropFlags kind) _YAP_GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
{ /* look property list of atom a for kind */ { /* look property list of atom a for kind */
return (StaticGetAPropHavingLock(ae,kind)); return (GetAPropHavingLock(ae,kind));
} }
Prop static Prop
GetAProp(Atom a, PropFlags kind) GetAProp(Atom a, PropFlags kind)
{ /* look property list of atom a for kind */ { /* look property list of atom a for kind */
AtomEntry *ae = RepAtom(a); AtomEntry *ae = RepAtom(a);
Prop out; Prop out;
READ_LOCK(ae->ARWLock); READ_LOCK(ae->ARWLock);
out = StaticGetAPropHavingLock(ae, kind); out = GetAPropHavingLock(ae, kind);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
return (out); return (out);
} }
Prop
_YAP_GetAProp(Atom a, PropFlags kind)
{ /* look property list of atom a for kind */
return GetAProp(a,kind);
}
inline static Prop inline static Prop
GetPredPropByAtomHavingLock(AtomEntry* ae, SMALLUNSGN cur_mod) GetPredPropByAtomHavingLock(AtomEntry* ae, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */
@ -287,7 +299,7 @@ GetPredPropByAtomHavingLock(AtomEntry* ae, SMALLUNSGN cur_mod)
} }
Prop Prop
GetPredPropByAtom(Atom at, SMALLUNSGN cur_mod) _YAP_GetPredPropByAtom(Atom at, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */
{ {
Prop p0; Prop p0;
@ -320,7 +332,7 @@ GetPredPropByFuncHavingLock(Functor f, SMALLUNSGN cur_mod)
} }
Prop Prop
GetPredPropByFunc(Functor f, SMALLUNSGN cur_mod) _YAP_GetPredPropByFunc(Functor f, SMALLUNSGN cur_mod)
/* get predicate entry for ap/arity; */ /* get predicate entry for ap/arity; */
{ {
Prop p0; Prop p0;
@ -332,7 +344,7 @@ GetPredPropByFunc(Functor f, SMALLUNSGN cur_mod)
} }
Prop Prop
GetPredPropHavingLock(Atom ap, unsigned int arity, SMALLUNSGN mod) _YAP_GetPredPropHavingLock(Atom ap, unsigned int arity, SMALLUNSGN mod)
/* get predicate entry for ap/arity; */ /* get predicate entry for ap/arity; */
{ {
Prop p0; Prop p0;
@ -351,7 +363,7 @@ GetPredPropHavingLock(Atom ap, unsigned int arity, SMALLUNSGN mod)
/* get expression entry for at/arity; */ /* get expression entry for at/arity; */
Prop Prop
GetExpProp(Atom at, unsigned int arity) _YAP_GetExpProp(Atom at, unsigned int arity)
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
@ -367,7 +379,7 @@ GetExpProp(Atom at, unsigned int arity)
/* get expression entry for at/arity, at is already locked; */ /* get expression entry for at/arity, at is already locked; */
Prop Prop
GetExpPropHavingLock(AtomEntry *ae, unsigned int arity) _YAP_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
{ {
Prop p0; Prop p0;
ExpEntry *p; ExpEntry *p;
@ -379,10 +391,10 @@ GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
} }
Prop Prop
NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod) _YAP_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
{ {
Prop p0; Prop p0;
PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p)); PredEntry *p = (PredEntry *) _YAP_AllocAtomSpace(sizeof(*p));
/* printf("entering %s:%s/%d\n", RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, RepAtom(fe->NameOfFE)->StrOfAE, fe->ArityOfFE); */ /* printf("entering %s:%s/%d\n", RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, RepAtom(fe->NameOfFE)->StrOfAE, fe->ArityOfFE); */
@ -414,10 +426,10 @@ NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
} }
Prop Prop
NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod) _YAP_NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
{ {
Prop p0; Prop p0;
PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p)); PredEntry *p = (PredEntry *) _YAP_AllocAtomSpace(sizeof(*p));
/* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, ae->StrOfAE); */ /* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, ae->StrOfAE); */
@ -449,7 +461,7 @@ NewPredPropByAtom(AtomEntry *ae, SMALLUNSGN cur_mod)
} }
Term Term
GetValue(Atom a) _YAP_GetValue(Atom a)
{ {
Prop p0 = GetAProp(a, ValProperty); Prop p0 = GetAProp(a, ValProperty);
Term out; Term out;
@ -467,7 +479,7 @@ GetValue(Atom a)
} }
#ifdef USE_GMP #ifdef USE_GMP
else { else {
out = MkBigIntTerm(BigIntOfTerm(out)); out = _YAP_MkBigIntTerm(_YAP_BigIntOfTerm(out));
} }
#endif #endif
} }
@ -476,7 +488,7 @@ GetValue(Atom a)
} }
void void
PutValue(Atom a, Term v) _YAP_PutValue(Atom a, Term v)
{ {
AtomEntry *ae = RepAtom(a); AtomEntry *ae = RepAtom(a);
Prop p0; Prop p0;
@ -490,7 +502,7 @@ PutValue(Atom a, Term v)
WRITE_LOCK(p->VRWLock); WRITE_LOCK(p->VRWLock);
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
} else { } else {
p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry)); p = (ValEntry *) _YAP_AllocAtomSpace(sizeof(ValEntry));
p->NextOfPE = RepAtom(a)->PropsOfAE; p->NextOfPE = RepAtom(a)->PropsOfAE;
RepAtom(a)->PropsOfAE = AbsValProp(p); RepAtom(a)->PropsOfAE = AbsValProp(p);
p->KindOfPE = ValProperty; p->KindOfPE = ValProperty;
@ -516,9 +528,9 @@ PutValue(Atom a, Term v)
pt = RepAppl(t0); pt = RepAppl(t0);
} else { } else {
if (IsApplTerm(t0)) { if (IsApplTerm(t0)) {
FreeCodeSpace((char *) (RepAppl(t0))); _YAP_FreeCodeSpace((char *) (RepAppl(t0)));
} }
pt = (CELL *) AllocAtomSpace(sizeof(CELL)*(1 + 2*sizeof(Float)/sizeof(CELL))); pt = (CELL *) _YAP_AllocAtomSpace(sizeof(CELL)*(1 + 2*sizeof(Float)/sizeof(CELL)));
p->ValueOfVE = AbsAppl(pt); p->ValueOfVE = AbsAppl(pt);
pt[0] = (CELL)FunctorDouble; pt[0] = (CELL)FunctorDouble;
} }
@ -535,9 +547,9 @@ PutValue(Atom a, Term v)
pt = RepAppl(t0); pt = RepAppl(t0);
} else { } else {
if (IsApplTerm(t0)) { if (IsApplTerm(t0)) {
FreeCodeSpace((char *) (RepAppl(t0))); _YAP_FreeCodeSpace((char *) (RepAppl(t0)));
} }
pt = (CELL *) AllocAtomSpace(2*sizeof(CELL)); pt = (CELL *) _YAP_AllocAtomSpace(2*sizeof(CELL));
p->ValueOfVE = AbsAppl(pt); p->ValueOfVE = AbsAppl(pt);
pt[0] = (CELL)FunctorLongInt; pt[0] = (CELL)FunctorLongInt;
} }
@ -548,9 +560,9 @@ PutValue(Atom a, Term v)
Int sz = Int sz =
sizeof(MP_INT)+sizeof(CELL)+ sizeof(MP_INT)+sizeof(CELL)+
(((MP_INT *)(ap+1))->_mp_alloc*sizeof(mp_limb_t)); (((MP_INT *)(ap+1))->_mp_alloc*sizeof(mp_limb_t));
CELL *pt = (CELL *) AllocAtomSpace(sz); CELL *pt = (CELL *) _YAP_AllocAtomSpace(sz);
if (IsApplTerm(t0)) { if (IsApplTerm(t0)) {
FreeCodeSpace((char *) RepAppl(t0)); _YAP_FreeCodeSpace((char *) RepAppl(t0));
} }
memcpy((void *)pt, (void *)ap, sz); memcpy((void *)pt, (void *)ap, sz);
p->ValueOfVE = AbsAppl(pt); p->ValueOfVE = AbsAppl(pt);
@ -558,7 +570,7 @@ PutValue(Atom a, Term v)
} else { } else {
if (IsApplTerm(t0)) { if (IsApplTerm(t0)) {
/* recover space */ /* recover space */
FreeCodeSpace((char *) (RepAppl(p->ValueOfVE))); _YAP_FreeCodeSpace((char *) (RepAppl(p->ValueOfVE)));
} }
p->ValueOfVE = v; p->ValueOfVE = v;
} }
@ -566,7 +578,7 @@ PutValue(Atom a, Term v)
} }
Term Term
StringToList(char *s) _YAP_StringToList(char *s)
{ {
register Term t; register Term t;
register unsigned char *cp = (unsigned char *)s + strlen(s); register unsigned char *cp = (unsigned char *)s + strlen(s);
@ -579,7 +591,7 @@ StringToList(char *s)
} }
Term Term
StringToListOfAtoms(char *s) _YAP_StringToListOfAtoms(char *s)
{ {
register Term t; register Term t;
char so[2]; char so[2];
@ -595,7 +607,7 @@ StringToListOfAtoms(char *s)
} }
Term Term
ArrayToList(register Term *tp, int nof) _YAP_ArrayToList(register Term *tp, int nof)
{ {
register Term *pt = tp + nof; register Term *pt = tp + nof;
register Term t; register Term t;
@ -614,7 +626,7 @@ ArrayToList(register Term *tp, int nof)
} }
int int
GetName(char *s, UInt max, Term t) _YAP_GetName(char *s, UInt max, Term t)
{ {
register Term Head; register Term Head;
register Int i; register Int i;
@ -631,7 +643,7 @@ GetName(char *s, UInt max, Term t)
*s++ = i; *s++ = i;
t = TailOfTerm(t); t = TailOfTerm(t);
if (--max == 0) { if (--max == 0) {
Error(FATAL_ERROR,t,"not enough space for GetName"); _YAP_Error(FATAL_ERROR,t,"not enough space for GetName");
} }
} }
*s = '\0'; *s = '\0';

50
C/agc.c
View File

@ -25,7 +25,7 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
#ifdef DEBUG #ifdef DEBUG
/* #define DEBUG_RESTORE2 1 */ /* #define DEBUG_RESTORE2 1 */
#define errout YP_stderr #define errout _YAP_stderr
#endif #endif
STATIC_PROTO(void RestoreEntries, (PropEntry *)); STATIC_PROTO(void RestoreEntries, (PropEntry *));
@ -192,7 +192,7 @@ mark_atoms(void)
at = RepAtom(atm); at = RepAtom(atm);
do { do {
#ifdef DEBUG_RESTORE2 /* useful during debug */ #ifdef DEBUG_RESTORE2 /* useful during debug */
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE); fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif #endif
RestoreEntries(RepProp(at->PropsOfAE)); RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE; atm = at->NextOfAE;
@ -209,7 +209,7 @@ mark_atoms(void)
} }
do { do {
#ifdef DEBUG_RESTORE2 /* useful during debug */ #ifdef DEBUG_RESTORE2 /* useful during debug */
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE); fprintf(errout, "Restoring %s\n", at->StrOfAE);
if (strcmp(at->StrOfAE,"$module_expansion") == 0) { if (strcmp(at->StrOfAE,"$module_expansion") == 0) {
printf("oops\n"); printf("oops\n");
} }
@ -227,7 +227,7 @@ mark_trail(void)
pt = (CELL *)TR; pt = (CELL *)TR;
/* moving the trail is simple */ /* moving the trail is simple */
while (pt != (CELL *)TrailBase) { while (pt != (CELL *)_YAP_TrailBase) {
register CELL reg = pt[-1]; register CELL reg = pt[-1];
pt--; pt--;
if (!IsVarTerm(reg)) { if (!IsVarTerm(reg)) {
@ -266,7 +266,7 @@ mark_global(void)
* to clean the global now that functors are just variables pointing to * to clean the global now that functors are just variables pointing to
* the code * the code
*/ */
pt = CellPtr(GlobalBase); pt = CellPtr(_YAP_GlobalBase);
while (pt < H) { while (pt < H) {
register CELL reg; register CELL reg;
@ -343,8 +343,8 @@ clean_atoms(void)
#endif #endif
*patm = at->NextOfAE; *patm = at->NextOfAE;
atm = at->NextOfAE; atm = at->NextOfAE;
agc_collected += SizeOfBlock((char *)at); agc_collected += _YAP_SizeOfBlock((char *)at);
FreeCodeSpace((char *)at); _YAP_FreeCodeSpace((char *)at);
} }
} }
HashPtr++; HashPtr++;
@ -362,45 +362,51 @@ clean_atoms(void)
#endif #endif
*patm = at->NextOfAE; *patm = at->NextOfAE;
atm = at->NextOfAE; atm = at->NextOfAE;
agc_collected += SizeOfBlock((char *)at); agc_collected += _YAP_SizeOfBlock((char *)at);
FreeCodeSpace((char *)at); _YAP_FreeCodeSpace((char *)at);
} }
} }
} }
void static void
atom_gc(void) atom_gc(void)
{ {
int gc_verbose = is_gc_verbose(); int gc_verbose = _YAP_is_gc_verbose();
int gc_trace = 0; int gc_trace = 0;
Int time_start, agc_time; Int time_start, agc_time;
if (GetValue(AtomGcTrace) != TermNil) if (_YAP_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1; gc_trace = 1;
agc_calls++; agc_calls++;
agc_collected = 0; agc_collected = 0;
if (gc_trace) { if (gc_trace) {
YP_fprintf(YP_stderr, "[agc]\n"); fprintf(_YAP_stderr, "[agc]\n");
} else if (gc_verbose) { } else if (gc_verbose) {
YP_fprintf(YP_stderr, "[AGC] Start of atom garbage collection %d:\n", agc_calls); fprintf(_YAP_stderr, "[AGC] Start of atom garbage collection %d:\n", agc_calls);
} }
time_start = cputime(); time_start = _YAP_cputime();
/* get the number of active registers */ /* get the number of active registers */
YAPEnterCriticalSection(); YAPEnterCriticalSection();
mark_stacks(); mark_stacks();
mark_atoms(); mark_atoms();
clean_atoms(); clean_atoms();
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
agc_time = cputime()-time_start; agc_time = _YAP_cputime()-time_start;
tot_agc_time += agc_time; tot_agc_time += agc_time;
tot_agc_recovered += agc_collected; tot_agc_recovered += agc_collected;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[AGC] collected %d bytes.\n", agc_collected); fprintf(_YAP_stderr, "[AGC] collected %d bytes.\n", agc_collected);
YP_fprintf(YP_stderr, "[AGC] GC %d took %g sec, total of %g sec doing GC so far.\n", agc_calls, (double)agc_time/1000, (double)tot_agc_time/1000); fprintf(_YAP_stderr, "[AGC] GC %d took %g sec, total of %g sec doing GC so far.\n", agc_calls, (double)agc_time/1000, (double)tot_agc_time/1000);
} }
} }
void
_YAP_atom_gc(void)
{
atom_gc();
}
static Int static Int
p_atom_gc(void) p_atom_gc(void)
{ {
@ -417,13 +423,13 @@ p_inform_agc(void)
Term tt = MkIntegerTerm(agc_calls); Term tt = MkIntegerTerm(agc_calls);
Term ts = MkIntegerTerm(tot_agc_recovered); Term ts = MkIntegerTerm(tot_agc_recovered);
return(unify(tn, ARG2) && unify(tt, ARG1) && unify(ts, ARG3)); return(_YAP_unify(tn, ARG2) && _YAP_unify(tt, ARG1) && _YAP_unify(ts, ARG3));
} }
void void
init_agc(void) _YAP_init_agc(void)
{ {
InitCPred("$atom_gc", 0, p_atom_gc, 0); _YAP_InitCPred("$atom_gc", 0, p_atom_gc, 0);
InitCPred("$inform_agc", 3, p_inform_agc, 0); _YAP_InitCPred("$inform_agc", 3, p_inform_agc, 0);
} }

279
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.26 2002-10-23 20:55:36 vsc Exp $ * * version:$Id: alloc.c,v 1.27 2002-11-11 17:37:52 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -76,7 +76,7 @@ STATIC_PROTO(void AddToFreeList, (BlockHeader *));
/* Yap workspace management */ /* Yap workspace management */
int int
SizeOfBlock(CODEADDR p) _YAP_SizeOfBlock(CODEADDR p)
{ {
BlockHeader *b = (BlockHeader *) (p - sizeof(YAP_SEG_SIZE)); BlockHeader *b = (BlockHeader *) (p - sizeof(YAP_SEG_SIZE));
YAP_SEG_SIZE s = (b->b_size) & ~InUseFlag; YAP_SEG_SIZE s = (b->b_size) & ~InUseFlag;
@ -155,10 +155,10 @@ FreeBlock(BlockHeader *b)
sp = &(b->b_size) + (b->b_size & ~InUseFlag); sp = &(b->b_size) + (b->b_size & ~InUseFlag);
if (*sp != b->b_size) { if (*sp != b->b_size) {
#if !SHORT_INTS #if !SHORT_INTS
YP_fprintf(YP_stderr, "** sanity check failed in FreeBlock %p %x %x\n", fprintf(_YAP_stderr, "** sanity check failed in FreeBlock %p %x %x\n",
b, b->b_size, Unsigned(*sp)); b, b->b_size, Unsigned(*sp));
#else #else
YP_fprintf(YP_stderr, "** sanity check failed in FreeBlock %p %lx %lx\n", fprintf(_YAP_stderr, "** sanity check failed in FreeBlock %p %lx %lx\n",
b, b->b_size, *sp); b, b->b_size, *sp);
#endif #endif
return; return;
@ -265,7 +265,7 @@ AllocHeap(unsigned int size)
HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE); HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
#ifdef YAPOR #ifdef YAPOR
if (HeapTop > Addr(GlobalBase) - MinHeapGap) { if (HeapTop > Addr(_YAP_GlobalBase) - MinHeapGap) {
abort_optyap("No heap left in function AllocHeap"); abort_optyap("No heap left in function AllocHeap");
} }
#else #else
@ -278,7 +278,7 @@ AllocHeap(unsigned int size)
UNLOCK(HeapTopLock); UNLOCK(HeapTopLock);
} }
/* we destroyed the stack */ /* we destroyed the stack */
Error(SYSTEM_ERROR, TermNil, "Stack Crashed against Heap..."); _YAP_Error(SYSTEM_ERROR, TermNil, "Stack Crashed against Heap...");
return(NULL); return(NULL);
} else { } else {
if (HeapTop + size * sizeof(CELL) + sizeof(YAP_SEG_SIZE) < Addr(AuxSp)) { if (HeapTop + size * sizeof(CELL) + sizeof(YAP_SEG_SIZE) < Addr(AuxSp)) {
@ -320,7 +320,7 @@ AllocHeap(unsigned int size)
/* If you need to dinamically allocate space from the heap, this is /* If you need to dinamically allocate space from the heap, this is
* the macro you should use */ * the macro you should use */
ADDR ADDR
PreAllocCodeSpace(void) _YAP_PreAllocCodeSpace(void)
{ {
LOCK(HeapTopLock); LOCK(HeapTopLock);
HEAPTOP_OWN(worker_id); HEAPTOP_OWN(worker_id);
@ -331,7 +331,7 @@ PreAllocCodeSpace(void)
/* Grabbing the HeapTop is an excellent idea for a sequential system, /* Grabbing the HeapTop is an excellent idea for a sequential system,
but does work as well in parallel systems. Anyway, this will do for now */ but does work as well in parallel systems. Anyway, this will do for now */
void void
ReleasePreAllocCodeSpace(ADDR ptr) _YAP_ReleasePreAllocCodeSpace(ADDR ptr)
{ {
HEAPTOP_DISOWN(worker_id); HEAPTOP_DISOWN(worker_id);
UNLOCK(HeapTopLock); UNLOCK(HeapTopLock);
@ -340,25 +340,33 @@ ReleasePreAllocCodeSpace(ADDR ptr)
/* If you need to dinamically allocate space from the heap, this is /* If you need to dinamically allocate space from the heap, this is
* the macro you should use */ * the macro you should use */
void static void
FreeCodeSpace(char *p) FreeCodeSpace(char *p)
{ {
FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE)))); FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
} }
char * /* If you need to dinamically allocate space from the heap, this is
AllocAtomSpace(unsigned int size) * the macro you should use */
{
return (AllocHeap(size));
}
void void
FreeAtomSpace(char *p) _YAP_FreeCodeSpace(char *p)
{ {
FreeCodeSpace(p); FreeCodeSpace(p);
} }
char * char *
_YAP_AllocAtomSpace(unsigned int size)
{
return (AllocHeap(size));
}
void
_YAP_FreeAtomSpace(char *p)
{
FreeCodeSpace(p);
}
static char *
AllocCodeSpace(unsigned int size) AllocCodeSpace(unsigned int size)
{ {
if (size < SmallSize + 2 * OpCodeSize + 3 * CellSize) if (size < SmallSize + 2 * OpCodeSize + 3 * CellSize)
@ -366,6 +374,12 @@ AllocCodeSpace(unsigned int size)
return (AllocHeap(size)); return (AllocHeap(size));
} }
char *
_YAP_AllocCodeSpace(unsigned int size)
{
return AllocCodeSpace(size);
}
/************************************************************************/ /************************************************************************/
/* Workspace allocation */ /* Workspace allocation */
/* */ /* */
@ -379,10 +393,10 @@ AllocCodeSpace(unsigned int size)
/* functions: */ /* functions: */
/* void *InitWorkSpace(int s) - initial workspace allocation */ /* void *InitWorkSpace(int s) - initial workspace allocation */
/* int ExtendWorkSpace(int s) - extend workspace */ /* int ExtendWorkSpace(int s) - extend workspace */
/* int FreeWorkSpace() - release workspace */ /* int _YAP_FreeWorkSpace() - release workspace */
/************************************************************************/ /************************************************************************/
#if defined(_WIN32) || defined(__CYGWIN__) #if defined(_WIN32)
#include "windows.h" #include "windows.h"
@ -392,58 +406,57 @@ AllocCodeSpace(unsigned int size)
static LPVOID brk; static LPVOID brk;
int static int
ExtendWorkSpace(Int s) ExtendWorkSpace(Int s)
{ {
LPVOID b; LPVOID b;
prolog_exec_mode OldPrologMode = PrologMode; prolog_exec_mode OldPrologMode = _YAP_PrologMode;
PrologMode = ExtendStackMode; _YAP_PrologMode = ExtendStackMode;
s = ((s-1)/page_size+1)*page_size; s = ((s-1)/_YAP_page_size+1)*_YAP_page_size;
b = VirtualAlloc(brk, s, MEM_COMMIT, PAGE_READWRITE); b = VirtualAlloc(brk, s, MEM_COMMIT, PAGE_READWRITE);
if (b) { if (b) {
brk = (LPVOID) ((Int) brk + s); brk = (LPVOID) ((Int) brk + s);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return TRUE; return TRUE;
} }
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"VirtualAlloc could not commit %ld bytes", "VirtualAlloc could not commit %ld bytes",
(long int)s); (long int)s);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
MALLOC_T static MALLOC_T
InitWorkSpace(Int s) InitWorkSpace(Int s)
{ {
SYSTEM_INFO si; SYSTEM_INFO si;
LPVOID b; LPVOID b;
GetSystemInfo(&si); GetSystemInfo(&si);
page_size = si.dwPageSize; _YAP_page_size = si.dwPageSize;
b = VirtualAlloc(BASE_ADDRESS, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS); b = VirtualAlloc(BASE_ADDRESS, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS);
if (b==NULL) { if (b==NULL) {
fprintf(stderr,"[ Warning: YAP reserving space at a variable address ]\n");
b = VirtualAlloc(0x0, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS); b = VirtualAlloc(0x0, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS);
if (b == NULL) { if (b == NULL) {
Error(FATAL_ERROR,TermNil,"VirtualAlloc failed"); _YAP_Error(FATAL_ERROR,TermNil,"VirtualAlloc failed");
return(0); return(0);
} }
fprintf(stderr,"[ Warning: YAP reserving space at variable address %p ]\n", b);
} }
brk = BASE_ADDRESS; brk = BASE_ADDRESS;
if (ExtendWorkSpace(s)) { if (ExtendWorkSpace(s)) {
return BASE_ADDRESS; return BASE_ADDRESS;
} else { } else {
Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed"); _YAP_Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
return(0); return(0);
} }
} }
int int
FreeWorkSpace(void) _YAP_FreeWorkSpace(void)
{ {
return TRUE; return TRUE;
} }
@ -469,14 +482,13 @@ FreeWorkSpace(void)
static MALLOC_T WorkSpaceTop; static MALLOC_T WorkSpaceTop;
MALLOC_T static MALLOC_T
InitWorkSpace(Int s) InitWorkSpace(Int s)
{ {
MALLOC_T a; MALLOC_T a;
#if !defined(_AIX) && !defined(__APPLE__) && !__hpux #if !defined(_AIX) && !defined(__APPLE__) && !__hpux
int fd; int fd;
#endif #endif
#if defined(_AIX) #if defined(_AIX)
a = mmap(0, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(0, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_VARIABLE, -1, 0); MAP_PRIVATE | MAP_ANONYMOUS | MAP_VARIABLE, -1, 0);
@ -484,14 +496,14 @@ InitWorkSpace(Int s)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0); MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0);
if (a != (MALLOC_T)MMAP_ADDR) { if (a != (MALLOC_T)MMAP_ADDR) {
Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR, a); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR, a);
return(NULL); return(NULL);
} }
#elif defined(__APPLE__) #elif defined(__APPLE__)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0); MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
if (a != (MALLOC_T)MMAP_ADDR) { if (a != (MALLOC_T)MMAP_ADDR) {
Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR,a ); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR,a );
return(NULL); return(NULL);
} }
#else #else
@ -502,9 +514,9 @@ InitWorkSpace(Int s)
strncpy(file,"/tmp/YAP.TMPXXXXXX", 256); strncpy(file,"/tmp/YAP.TMPXXXXXX", 256);
if (mkstemp(file) == -1) { if (mkstemp(file) == -1) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s (%s)", file, strerror(errno)); _YAP_Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s (%s)", file, strerror(errno));
#else #else
Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s", file); _YAP_Error(FATAL_ERROR, TermNil, "mkstemp could not create temporary file %s", file);
#endif #endif
return NULL; return NULL;
} }
@ -519,21 +531,21 @@ InitWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */ #endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR); fd = open(file, O_CREAT|O_RDWR);
if (fd < 0) { if (fd < 0) {
Error(FATAL_ERROR, TermNil, "mmap could not open %s", file); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not open %s", file);
return NULL; return NULL;
} }
if (lseek(fd, s, SEEK_SET) < 0) { if (lseek(fd, s, SEEK_SET) < 0) {
Error(FATAL_ERROR, TermNil, "mmap could not lseek in mmapped file %s", file); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not lseek in mmapped file %s", file);
close(fd); close(fd);
return FALSE; return FALSE;
} }
if (write(fd, "", 1) < 0) { if (write(fd, "", 1) < 0) {
Error(FATAL_ERROR, TermNil, "mmap could not write in mmapped file %s", file); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not write in mmapped file %s", file);
close(fd); close(fd);
return NULL; return NULL;
} }
if (unlink(file) < 0) { if (unlink(file) < 0) {
Error(FATAL_ERROR,TermNil, "mmap could not unlink mmapped file %s", file); _YAP_Error(FATAL_ERROR,TermNil, "mmap could not unlink mmapped file %s", file);
close(fd); close(fd);
return NULL; return NULL;
} }
@ -542,7 +554,7 @@ InitWorkSpace(Int s)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_FIXED, fd, 0); MAP_PRIVATE | MAP_FIXED, fd, 0);
if (a != (MALLOC_T)MMAP_ADDR) { if (a != (MALLOC_T)MMAP_ADDR) {
Error(FATAL_ERROR, TermNil, "mmap could not map at %p, got %p", (void *)MMAP_ADDR, a); _YAP_Error(FATAL_ERROR, TermNil, "mmap could not map at %p, got %p", (void *)MMAP_ADDR, a);
return NULL; return NULL;
} }
#else #else
@ -550,11 +562,11 @@ InitWorkSpace(Int s)
MAP_PRIVATE, fd, 0); MAP_PRIVATE, fd, 0);
if ((CELL)a & YAP_PROTECTED_MASK) { if ((CELL)a & YAP_PROTECTED_MASK) {
close(fd); close(fd);
Error(FATAL_ERROR, TermNil, "mmapped address %p collides with YAP tags", a); _YAP_Error(FATAL_ERROR, TermNil, "mmapped address %p collides with YAP tags", a);
return NULL; return NULL;
} }
if (close(fd) == -1) { if (close(fd) == -1) {
Error(FATAL_ERROR, TermNil, "while closing mmaped file"); _YAP_Error(FATAL_ERROR, TermNil, "while closing mmaped file");
return NULL; return NULL;
} }
#endif #endif
@ -566,14 +578,14 @@ InitWorkSpace(Int s)
(a == (MALLOC_T) - 1) (a == (MALLOC_T) - 1)
#endif #endif
{ {
Error(FATAL_ERROR, TermNil, "mmap cannot allocate memory ***"); _YAP_Error(FATAL_ERROR, TermNil, "mmap cannot allocate memory ***");
return(NULL); return(NULL);
} }
WorkSpaceTop = (char *) a + s; WorkSpaceTop = (char *) a + s;
return (void *) a; return (void *) a;
} }
int static int
ExtendWorkSpace(Int s) ExtendWorkSpace(Int s)
{ {
#ifdef YAPOR #ifdef YAPOR
@ -582,36 +594,36 @@ ExtendWorkSpace(Int s)
#else #else
MALLOC_T a; MALLOC_T a;
prolog_exec_mode OldPrologMode = PrologMode; prolog_exec_mode OldPrologMode = _YAP_PrologMode;
#if defined(_AIX) || defined(__hpux) #if defined(_AIX) || defined(__hpux)
PrologMode = ExtendStackMode; _YAP_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
#elif defined(__APPLE__) #elif defined(__APPLE__)
PrologMode = ExtendStackMode; _YAP_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0); MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
#else #else
int fd; int fd;
PrologMode = ExtendStackMode; _YAP_PrologMode = ExtendStackMode;
fd = open("/dev/zero", O_RDWR); fd = open("/dev/zero", O_RDWR);
if (fd < 0) { if (fd < 0) {
#if HAVE_MKSTEMP #if HAVE_MKSTEMP
char file[256]; char file[256];
strncpy(file,"/tmp/YAP.TMPXXXXXX",256); strncpy(file,"/tmp/YAP.TMPXXXXXX",256);
if (mkstemp(file) == -1) { if (mkstemp(file) == -1) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
#if HAVE_STRERROR #if HAVE_STRERROR
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s (%s)", "mkstemp could not create temporary file %s (%s)",
file, strerror(errno)); file, strerror(errno));
#else #else
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file); "mkstemp could not create temporary file %s", file);
#endif /* HAVE_STRERROR */ #endif /* HAVE_STRERROR */
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
#else #else
@ -625,85 +637,85 @@ ExtendWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */ #endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR); fd = open(file, O_CREAT|O_RDWR);
if (fd < 0) { if (fd < 0) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not open %s", file); "mmap could not open %s", file);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
if (lseek(fd, s, SEEK_SET) < 0) { if (lseek(fd, s, SEEK_SET) < 0) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not lseek in mmapped file %s", file); "mmap could not lseek in mmapped file %s", file);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
close(fd); close(fd);
return FALSE; return FALSE;
} }
if (write(fd, "", 1) < 0) { if (write(fd, "", 1) < 0) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not write in mmapped file %s", file); "mmap could not write in mmapped file %s", file);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
close(fd); close(fd);
return FALSE; return FALSE;
} }
if (unlink(file) < 0) { if (unlink(file) < 0) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not unlink mmapped file %s", file); "mmap could not unlink mmapped file %s", file);
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
close(fd); close(fd);
return FALSE; return FALSE;
} }
} }
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC, a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE MAP_PRIVATE
#ifndef __linux #if !defined(__linux)
/* use MAP_FIXED, otherwise God knows where you will be placed */ /* use MAP_FIXED, otherwise God knows where you will be placed */
|MAP_FIXED |MAP_FIXED
#endif #endif
, fd, 0); , fd, 0);
if (close(fd) == -1) { if (close(fd) == -1) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
#if HAVE_STRERROR #if HAVE_STRERROR
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not close file (%s) ]\n", strerror(errno)); "mmap could not close file (%s) ]\n", strerror(errno));
#else #else
snprintf3(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf3(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not close file ]\n"); "mmap could not close file ]\n");
#endif #endif
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
#endif #endif
if (a == (MALLOC_T) - 1) { if (a == (MALLOC_T) - 1) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
#if HAVE_STRERROR #if HAVE_STRERROR
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes (%s)", (int)s, strerror(errno)); "could not allocate %d bytes (%s)", (int)s, strerror(errno));
#else #else
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", (int)s); "could not allocate %d bytes", (int)s);
#endif #endif
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
if (a != WorkSpaceTop) { if (a != WorkSpaceTop) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a ); "mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return FALSE; return FALSE;
} }
WorkSpaceTop = (char *) a + s; WorkSpaceTop = (char *) a + s;
PrologMode = OldPrologMode; _YAP_PrologMode = OldPrologMode;
return TRUE; return TRUE;
#endif /* YAPOR */ #endif /* YAPOR */
} }
int int
FreeWorkSpace(void) _YAP_FreeWorkSpace(void)
{ {
return 1; return 1;
} }
@ -720,7 +732,7 @@ FreeWorkSpace(void)
static MALLOC_T WorkSpaceTop; static MALLOC_T WorkSpaceTop;
MALLOC_T static MALLOC_T
InitWorkSpace(Int s) InitWorkSpace(Int s)
{ {
MALLOC_T ptr; MALLOC_T ptr;
@ -728,22 +740,22 @@ InitWorkSpace(Int s)
/* mapping heap area */ /* mapping heap area */
if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) { if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) {
Error(FATAL_ERROR, TermNil, "could not shmget %d bytes", s); _YAP_Error(FATAL_ERROR, TermNil, "could not shmget %d bytes", s);
return(NULL); return(NULL);
} }
if((ptr = (MALLOC_T)shmat(shm_id, (void *) MMAP_ADDR, 0)) == (MALLOC_T) -1) { if((ptr = (MALLOC_T)shmat(shm_id, (void *) MMAP_ADDR, 0)) == (MALLOC_T) -1) {
Error(FATAL_ERROR, TermNil, "could not shmat at %p", MMAP_ADDR); _YAP_Error(FATAL_ERROR, TermNil, "could not shmat at %p", MMAP_ADDR);
return(NULL); return(NULL);
} }
if (shmctl(shm_id, IPC_RMID, 0) != 0) { if (shmctl(shm_id, IPC_RMID, 0) != 0) {
Error(FATAL_ERROR, TermNil, "could not remove shm segment", shm_id); _YAP_Error(FATAL_ERROR, TermNil, "could not remove shm segment", shm_id);
return(NULL); return(NULL);
} }
WorkSpaceTop = (char *) ptr + s; WorkSpaceTop = (char *) ptr + s;
return(ptr); return(ptr);
} }
int static int
ExtendWorkSpace(Int s) ExtendWorkSpace(Int s)
{ {
MALLOC_T ptr; MALLOC_T ptr;
@ -753,22 +765,22 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode; PrologMode = ExtendStackMode;
/* mapping heap area */ /* mapping heap area */
if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) { if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmget %d bytes", s); "could not shmget %d bytes", s);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
} }
if((ptr = (MALLOC_T)shmat(shm_id, WorkSpaceTop, 0)) == (MALLOC_T) -1) { if((ptr = (MALLOC_T)shmat(shm_id, WorkSpaceTop, 0)) == (MALLOC_T) -1) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmat at %p", MMAP_ADDR); "could not shmat at %p", MMAP_ADDR);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
} }
if (shmctl(shm_id, IPC_RMID, 0) != 0) { if (shmctl(shm_id, IPC_RMID, 0) != 0) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not remove shm segment", shm_id); "could not remove shm segment", shm_id);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
@ -779,7 +791,7 @@ ExtendWorkSpace(Int s)
} }
int int
FreeWorkSpace(void) _YAP_FreeWorkSpace(void)
{ {
return TRUE; return TRUE;
} }
@ -807,19 +819,19 @@ int in_limbo; /* non-zero when restoring a saved state */
static char limbo_space[LIMBO_SIZE]; /* temporary malloc space */ static char limbo_space[LIMBO_SIZE]; /* temporary malloc space */
static char *limbo_p = limbo_space, *limbo_pp = 0; static char *limbo_p = limbo_space, *limbo_pp = 0;
MALLOC_T static MALLOC_T
InitWorkSpace(Int s) InitWorkSpace(Int s)
{ {
MALLOC_T ptr = (MALLOC_T)sbrk(s); MALLOC_T ptr = (MALLOC_T)sbrk(s);
if (ptr == ((MALLOC_T) - 1)) { if (ptr == ((MALLOC_T) - 1)) {
Error(FATAL_ERROR, TermNil, "could not allocate %d bytes", s); _YAP_Error(FATAL_ERROR, TermNil, "could not allocate %d bytes", s);
return(NULL); return(NULL);
} }
return(ptr); return(ptr);
} }
int static int
ExtendWorkSpace(Int s) ExtendWorkSpace(Int s)
{ {
MALLOC_T ptr = (MALLOC_T)sbrk(s); MALLOC_T ptr = (MALLOC_T)sbrk(s);
@ -827,8 +839,8 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode; PrologMode = ExtendStackMode;
if (ptr == ((MALLOC_T) - 1)) { if (ptr == ((MALLOC_T) - 1)) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand stacks over %d bytes", s); "could not expand stacks over %d bytes", s);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
@ -838,7 +850,7 @@ ExtendWorkSpace(Int s)
} }
int int
FreeWorkSpace(void) _YAP_FreeWorkSpace(void)
{ {
return TRUE; return TRUE;
} }
@ -873,7 +885,7 @@ free(MALLOC_T ptr)
} }
if (!ptr) if (!ptr)
return; return;
if ((char *) ptr < HeapBase || (char *) ptr > HeapTop) if ((char *) ptr < _YAP_HeapBase || (char *) ptr > HeapTop)
return; return;
if (!(b->b_size & InUseFlag)) if (!(b->b_size & InUseFlag))
return; return;
@ -931,7 +943,7 @@ mallinfo(void)
static int total_space; static int total_space;
MALLOC_T static MALLOC_T
InitWorkSpace(Int s) InitWorkSpace(Int s)
{ {
MALLOC_T ptr; MALLOC_T ptr;
@ -943,13 +955,13 @@ InitWorkSpace(Int s)
total_space = s; total_space = s;
if (ptr == NULL) { if (ptr == NULL) {
Error(FATAL_ERROR, TermNil, "could not allocate %d bytes", s); _YAP_Error(FATAL_ERROR, TermNil, "could not allocate %d bytes", s);
return(NULL); return(NULL);
} }
return(ptr); return(ptr);
} }
int static int
ExtendWorkSpace(Int s) ExtendWorkSpace(Int s)
{ {
MALLOC_T ptr; MALLOC_T ptr;
@ -958,24 +970,24 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode; PrologMode = ExtendStackMode;
total_space += s; total_space += s;
if (total_space < MAX_SPACE) return(TRUE); if (total_space < MAX_SPACE) return(TRUE);
ptr = (MALLOC_T)realloc((void *)HeapBase, total_space); ptr = (MALLOC_T)realloc((void *)_YAP_HeapBase, total_space);
if (ptr == NULL) { if (ptr == NULL) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", s); "could not allocate %d bytes", s);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
} }
if (ptr != (MALLOC_T)HeapBase) { if (ptr != (MALLOC_T)_YAP_HeapBase) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand contiguous stacks %d bytes", s); "could not expand contiguous stacks %d bytes", s);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
} }
if ((CELL)ptr & MBIT) { if ((CELL)ptr & MBIT) {
ErrorMessage = ErrorSay; _YAP_ErrorMessage = _YAP_ErrorSay;
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE, snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"memory at %p conflicts with MBIT %lx", ptr, (unsigned long)MBIT); "memory at %p conflicts with MBIT %lx", ptr, (unsigned long)MBIT);
PrologMode = OldPrologMode; PrologMode = OldPrologMode;
return(FALSE); return(FALSE);
@ -985,23 +997,23 @@ ExtendWorkSpace(Int s)
} }
int int
FreeWorkSpace(void) _YAP_FreeWorkSpace(void)
{ {
return TRUE; return TRUE;
} }
#endif #endif
void static void
YAP_InitHeap(void *heap_addr) InitHeap(void *heap_addr)
{ {
/* allocate space */ /* allocate space */
HeapBase = heap_addr; _YAP_HeapBase = heap_addr;
/* reserve space for specially allocated functors and atoms so that /* reserve space for specially allocated functors and atoms so that
their values can be known statically */ their values can be known statically */
HeapTop = HeapBase + AdjustSize(sizeof(all_heap_codes)); HeapTop = _YAP_HeapBase + AdjustSize(sizeof(all_heap_codes));
HeapMax = HeapUsed = HeapTop-HeapBase; HeapMax = HeapUsed = HeapTop-_YAP_HeapBase;
*((YAP_SEG_SIZE *) HeapTop) = InUseFlag; *((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
HeapTop = HeapTop + sizeof(YAP_SEG_SIZE); HeapTop = HeapTop + sizeof(YAP_SEG_SIZE);
@ -1027,7 +1039,13 @@ YAP_InitHeap(void *heap_addr)
} }
void void
InitMemory(int Trail, int Heap, int Stack) _YAP_InitHeap(void *heap_addr)
{
InitHeap(heap_addr);
}
void
_YAP_InitMemory(int Trail, int Heap, int Stack)
{ {
Int pm, sa, ta; Int pm, sa, ta;
@ -1040,14 +1058,14 @@ InitMemory(int Trail, int Heap, int Stack)
sa = Stack; /* stack area size */ sa = Stack; /* stack area size */
ta = Trail; /* trail area size */ ta = Trail; /* trail area size */
YAP_InitHeap(InitWorkSpace(pm)); InitHeap(InitWorkSpace(pm));
TrailTop = HeapBase + pm; _YAP_TrailTop = _YAP_HeapBase + pm;
LocalBase = TrailTop - ta; _YAP_LocalBase = _YAP_TrailTop - ta;
TrailBase = LocalBase + sizeof(CELL); _YAP_TrailBase = _YAP_LocalBase + sizeof(CELL);
GlobalBase = LocalBase - sa; _YAP_GlobalBase = _YAP_LocalBase - sa;
AuxTop = GlobalBase - CellSize; /* avoid confusions while AuxTop = _YAP_GlobalBase - CellSize; /* avoid confusions while
* * restoring */ * * restoring */
AuxSp = (CELL *) AuxTop; AuxSp = (CELL *) AuxTop;
@ -1055,12 +1073,12 @@ InitMemory(int Trail, int Heap, int Stack)
#if SIZEOF_INT_P!=SIZEOF_INT #if SIZEOF_INT_P!=SIZEOF_INT
if (output_msg) { if (output_msg) {
fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n", fprintf(stderr, "HeapBase = %p GlobalBase = %p\n LocalBase = %p TrailTop = %p\n",
HeapBase, GlobalBase, LocalBase, TrailTop); _YAP_HeapBase, _YAP_GlobalBase, _YAP_LocalBase, _YAP_TrailTop);
#else #else
if (output_msg) { if (output_msg) {
fprintf(stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n", fprintf(stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n",
(UInt) HeapBase, (UInt) GlobalBase, (UInt) _YAP_HeapBase, (UInt) _YAP_GlobalBase,
(UInt) LocalBase, (UInt) TrailTop); (UInt) _YAP_LocalBase, (UInt) _YAP_TrailTop);
#endif #endif
#if !SHORT_INTS #if !SHORT_INTS
@ -1075,3 +1093,8 @@ InitMemory(int Trail, int Heap, int Stack)
} }
int
_YAP_ExtendWorkSpace(Int s)
{
return ExtendWorkSpace(s);
}

155
C/amasm.c
View File

@ -31,11 +31,11 @@ static char SccsId[] = "@(#)amasm.c 1.3 3/15/90";
#endif #endif
STATIC_PROTO(void Var_Ref, (Ventry *)); STATIC_PROTO(void Var_Ref, (Ventry *));
STATIC_PROTO(AREG emit_xreg, (CELL)); STATIC_PROTO(wamreg emit_xreg, (CELL));
STATIC_PROTO(YREG emit_yreg, (CELL)); STATIC_PROTO(yslot emit_yreg, (CELL));
STATIC_PROTO(AREG emit_xreg2, (void)); STATIC_PROTO(wamreg emit_xreg2, (void));
STATIC_PROTO(AREG emit_x, (CELL)); STATIC_PROTO(wamreg emit_x, (CELL));
STATIC_PROTO(YREG emit_y, (Ventry *)); STATIC_PROTO(yslot emit_y, (Ventry *));
STATIC_PROTO(CODEADDR emit_a, (CELL)); STATIC_PROTO(CODEADDR emit_a, (CELL));
STATIC_PROTO(CELL *emit_bmlabel, (CELL)); STATIC_PROTO(CELL *emit_bmlabel, (CELL));
STATIC_PROTO(CODEADDR emit_ilabel, (CELL)); STATIC_PROTO(CODEADDR emit_ilabel, (CELL));
@ -85,7 +85,7 @@ STATIC_PROTO(void a_either, (op_numbers, CELL, CELL));
STATIC_PROTO(void a_gl_in, (op_numbers)); STATIC_PROTO(void a_gl_in, (op_numbers));
STATIC_PROTO(void a_gl, (op_numbers)); STATIC_PROTO(void a_gl, (op_numbers));
STATIC_PROTO(void a_bfunc, (CELL)); STATIC_PROTO(void a_bfunc, (CELL));
STATIC_PROTO(AREG compile_cmp_flags, (char *)); STATIC_PROTO(wamreg compile_cmp_flags, (char *));
STATIC_PROTO(void a_igl, (op_numbers)); STATIC_PROTO(void a_igl, (op_numbers));
STATIC_PROTO(void a_ucons, (compiler_vm_op)); STATIC_PROTO(void a_ucons, (compiler_vm_op));
STATIC_PROTO(void a_uvar, (void)); STATIC_PROTO(void a_uvar, (void));
@ -116,7 +116,6 @@ static yamop *code_p;
static CODEADDR code_addr; static CODEADDR code_addr;
static int pass_no; static int pass_no;
int *label_offset;
static OPREG var_offset; static OPREG var_offset;
static int is_y_var; static int is_y_var;
@ -130,7 +129,7 @@ static CELL comit_lab;
static int do_not_optimize_uatom = FALSE; static int do_not_optimize_uatom = FALSE;
static AREG x1_arg, x2_arg; static wamreg x1_arg, x2_arg;
static Int c_arg; static Int c_arg;
@ -141,7 +140,7 @@ static int c_type;
static int clause_has_blobs; static int clause_has_blobs;
inline static YREG inline static yslot
emit_y(Ventry *ve) emit_y(Ventry *ve)
{ {
#if MSHIFTOFFS #if MSHIFTOFFS
@ -205,19 +204,19 @@ fill_a(CELL a)
code_p = (yamop *) (++ptr); code_p = (yamop *) (++ptr);
} }
inline static AREG inline static wamreg
emit_xreg(CELL w) emit_xreg(CELL w)
{ {
return ((AREG) w); return ((wamreg) w);
} }
inline static YREG inline static yslot
emit_yreg(CELL w) emit_yreg(CELL w)
{ {
return ((YREG) w); return ((yslot) w);
} }
inline static AREG inline static wamreg
emit_xreg2(void) emit_xreg2(void)
{ {
#if PRECOMPUTE_REGADDRESS #if PRECOMPUTE_REGADDRESS
@ -231,7 +230,7 @@ emit_xreg2(void)
#endif /* ALIGN_LONGS */ #endif /* ALIGN_LONGS */
} }
inline static AREG inline static wamreg
emit_x(CELL xarg) emit_x(CELL xarg)
{ {
#if PRECOMPUTE_REGADDRESS #if PRECOMPUTE_REGADDRESS
@ -298,8 +297,8 @@ DumpOpCodes(void)
while (i < 30) { while (i < 30) {
for (j = i; j <= _std_top; j += 25) for (j = i; j <= _std_top; j += 25)
YP_fprintf(YP_stderr, "%5d %6lx", j, absmadr(j)); fprintf(_YAP_stderr, "%5d %6lx", j, absmadr(j));
YP_putchar('\n'); fputc('\n',_YAP_stderr);
++i; ++i;
} }
} }
@ -311,12 +310,18 @@ emit_op(op_numbers op)
return (absmadr((Int) op)); return (absmadr((Int) op));
} }
OPCODE static OPCODE
opcode(op_numbers op) opcode(op_numbers op)
{ {
return (emit_op(op)); return (emit_op(op));
} }
OPCODE
_YAP_opcode(op_numbers op)
{
return (opcode(op));
}
static void static void
a_cl(op_numbers opcode) a_cl(op_numbers opcode)
{ {
@ -726,15 +731,15 @@ a_p(op_numbers opcode)
break; break;
default: default:
op = _p_equal; /* just to make some compilers happy */ op = _p_equal; /* just to make some compilers happy */
Error(SYSTEM_ERROR, TermNil, "internal assembler error for built-in (%d)", (Flags & 0x7f)); _YAP_Error(SYSTEM_ERROR, TermNil, "internal assembler error for built-in (%d)", (Flags & 0x7f));
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
} }
a_e(op); a_e(op);
if (!comit_ok) { if (!comit_ok) {
Error(SYSTEM_ERROR, TermNil,"internal assembler error for commit"); _YAP_Error(SYSTEM_ERROR, TermNil,"internal assembler error for commit");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
} }
return; return;
} }
@ -743,10 +748,10 @@ a_p(op_numbers opcode)
if (!comit_ok && (Flags & TestPredFlag)) { if (!comit_ok && (Flags & TestPredFlag)) {
if (pass_no) { if (pass_no) {
if (Flags & UserCPredFlag) { if (Flags & UserCPredFlag) {
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"user defined predicate cannot be a test predicate"); "user defined predicate cannot be a test predicate");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
} else } else
code_p->opc = emit_op(_call_c_wfail); code_p->opc = emit_op(_call_c_wfail);
code_p->u.sdl.s = code_p->u.sdl.s =
@ -791,9 +796,9 @@ a_p(op_numbers opcode)
GONEXT(sla); GONEXT(sla);
} }
if (!comit_ok) { if (!comit_ok) {
Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit"); _YAP_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch,1); longjmp(_YAP_CompilerBotch,1);
} }
return; return;
} }
@ -833,9 +838,9 @@ a_p(op_numbers opcode)
GONEXT(l); GONEXT(l);
} }
if (!comit_ok) { if (!comit_ok) {
Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit"); _YAP_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch,1); longjmp(_YAP_CompilerBotch,1);
} }
} }
@ -857,7 +862,7 @@ a_empty_call(void)
code_p->opc = emit_op(_fcall); code_p->opc = emit_op(_fcall);
} }
if (pass_no) { if (pass_no) {
PredEntry *pe = RepPredProp(GetPredPropByAtom(AtomTrue,0)); PredEntry *pe = RepPredProp(_YAP_GetPredPropByAtom(AtomTrue,0));
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE * code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE *
cpc->rnd2); cpc->rnd2);
code_p->u.sla.l = emit_a((CELL)&(pe->StateOfPred)); code_p->u.sla.l = emit_a((CELL)&(pe->StateOfPred));
@ -892,7 +897,7 @@ a_pl(op_numbers opcode, PredEntry *pred)
GONEXT(l); GONEXT(l);
} }
static AREG static wamreg
compile_cmp_flags(char *s) compile_cmp_flags(char *s)
{ {
if (strcmp(s,"=<") == 0) return(EQ_OK_IN_CMP|LT_OK_IN_CMP); if (strcmp(s,"=<") == 0) return(EQ_OK_IN_CMP|LT_OK_IN_CMP);
@ -901,7 +906,7 @@ compile_cmp_flags(char *s)
if (strcmp(s,">") == 0) return(GT_OK_IN_CMP); if (strcmp(s,">") == 0) return(GT_OK_IN_CMP);
if (strcmp(s,"=:=") == 0) return(EQ_OK_IN_CMP); if (strcmp(s,"=:=") == 0) return(EQ_OK_IN_CMP);
if (strcmp(s,"=\\=") == 0) return(GT_OK_IN_CMP|LT_OK_IN_CMP); if (strcmp(s,"=\\=") == 0) return(GT_OK_IN_CMP|LT_OK_IN_CMP);
Error(SYSTEM_ERROR, x1_arg, "internal assembler error in flags for %s", s); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error in flags for %s", s);
return(0); return(0);
} }
@ -913,7 +918,7 @@ a_bfunc(CELL pred)
Var_Ref(ve); Var_Ref(ve);
if (ve->KindOfVE == PermVar) { if (ve->KindOfVE == PermVar) {
YREG v1 = emit_yreg(var_offset); yslot v1 = emit_yreg(var_offset);
cpc = cpc->nextInst; cpc = cpc->nextInst;
ve = (Ventry *) cpc->rnd1; ve = (Ventry *) cpc->rnd1;
Var_Ref(ve); Var_Ref(ve);
@ -939,7 +944,7 @@ a_bfunc(CELL pred)
GONEXT(lxy); GONEXT(lxy);
} }
} else { } else {
AREG x1 = emit_xreg(var_offset); wamreg x1 = emit_xreg(var_offset);
cpc = cpc->nextInst; cpc = cpc->nextInst;
ve = (Ventry *) cpc->rnd1; ve = (Ventry *) cpc->rnd1;
Var_Ref(ve); Var_Ref(ve);
@ -1184,7 +1189,7 @@ a_either(op_numbers opcode, CELL opr, CELL lab)
#endif /* YAPOR */ #endif /* YAPOR */
{ {
if (pass_no) { if (pass_no) {
Prop fe = GetPredPropByAtom(AtomTrue,0); Prop fe = _YAP_GetPredPropByAtom(AtomTrue,0);
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.sla.s = emit_count(opr); code_p->u.sla.s = emit_count(opr);
code_p->u.sla.l = emit_a(lab); code_p->u.sla.l = emit_a(lab);
@ -1707,40 +1712,40 @@ a_f2(int var)
if (pass_no) { if (pass_no) {
switch (opc) { switch (opc) {
case _plus: case _plus:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for +/2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for +/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _minus: case _minus:
code_p->opc = emit_op(_p_minus_y_cv); code_p->opc = emit_op(_p_minus_y_cv);
break; break;
case _times: case _times:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for */2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for */2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _div: case _div:
code_p->opc = emit_op(_p_div_y_cv); code_p->opc = emit_op(_p_div_y_cv);
break; break;
case _and: case _and:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for /\\/2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for /\\/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _or: case _or:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for \\//2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for \\//2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _sll: case _sll:
code_p->opc = emit_op(_p_sll_y_cv); code_p->opc = emit_op(_p_sll_y_cv);
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _slr: case _slr:
code_p->opc = emit_op(_p_slr_y_cv); code_p->opc = emit_op(_p_slr_y_cv);
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _arg: case _arg:
code_p->opc = emit_op(_p_arg_y_cv); code_p->opc = emit_op(_p_arg_y_cv);
@ -1762,9 +1767,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_plus_y_vc); code_p->opc = emit_op(_p_plus_y_vc);
break; break;
case _minus: case _minus:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error XC for -/2"); _YAP_Error(SYSTEM_ERROR, x2_arg, "internal assembler error XC for -/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _times: case _times:
code_p->opc = emit_op(_p_times_y_vc); code_p->opc = emit_op(_p_times_y_vc);
@ -1785,9 +1790,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_slr_y_vc); code_p->opc = emit_op(_p_slr_y_vc);
break; break;
case _arg: case _arg:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3"); _YAP_Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _functor: case _functor:
code_p->opc = emit_op(_p_func2s_y_vc); code_p->opc = emit_op(_p_func2s_y_vc);
@ -1846,30 +1851,30 @@ a_f2(int var)
if (pass_no) { if (pass_no) {
switch (opc) { switch (opc) {
case _plus: case _plus:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for +/2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for +/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _minus: case _minus:
code_p->opc = emit_op(_p_minus_cv); code_p->opc = emit_op(_p_minus_cv);
break; break;
case _times: case _times:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for */2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for */2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _div: case _div:
code_p->opc = emit_op(_p_div_cv); code_p->opc = emit_op(_p_div_cv);
break; break;
case _and: case _and:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for /\\/2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for /\\/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _or: case _or:
Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for \\//2"); _YAP_Error(SYSTEM_ERROR, x1_arg, "internal assembler error CX for \\//2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _sll: case _sll:
code_p->opc = emit_op(_p_sll_cv); code_p->opc = emit_op(_p_sll_cv);
@ -1897,9 +1902,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_plus_vc); code_p->opc = emit_op(_p_plus_vc);
break; break;
case _minus: case _minus:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error XC for -/2"); _YAP_Error(SYSTEM_ERROR, x2_arg, "internal assembler error XC for -/2");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _times: case _times:
code_p->opc = emit_op(_p_times_vc); code_p->opc = emit_op(_p_times_vc);
@ -1920,9 +1925,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_slr_vc); code_p->opc = emit_op(_p_slr_vc);
break; break;
case _arg: case _arg:
Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3"); _YAP_Error(SYSTEM_ERROR, x2_arg, "internal assembler error for arg/3");
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
break; break;
case _functor: case _functor:
code_p->opc = emit_op(_p_func2s_vc); code_p->opc = emit_op(_p_func2s_vc);
@ -1972,15 +1977,15 @@ do_pass(void)
if (assembling != ASSEMBLING_INDEX) { if (assembling != ASSEMBLING_INDEX) {
Clause *cl_p = (Clause *)code_p; Clause *cl_p = (Clause *)code_p;
if (pass_no) { if (pass_no) {
cl_p->u.ClValue = c_store; cl_p->u.ClValue = clause_store;
cl_p->ClFlags = c_mask; cl_p->ClFlags = clause_mask;
if (log_update) if (log_update)
cl_p->ClFlags |= LogUpdMask; cl_p->ClFlags |= LogUpdMask;
if (clause_has_blobs) { if (clause_has_blobs) {
cl_p->ClFlags |= HasBlobsMask; cl_p->ClFlags |= HasBlobsMask;
} }
cl_p->u2.ClExt = NULL; cl_p->u2.ClExt = NULL;
cl_p->Owner = YapConsultingFile(); cl_p->Owner = _YAP_ConsultingFile();
} }
code_p = (yamop *)(cl_p->ClCode); code_p = (yamop *)(cl_p->ClCode);
IPredArity = cpc->rnd2; /* number of args */ IPredArity = cpc->rnd2; /* number of args */
@ -2005,7 +2010,7 @@ do_pass(void)
cl_p->ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask; cl_p->ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask;
} else { } else {
cl_p->u2.ClExt = NULL; cl_p->u2.ClExt = NULL;
cl_p->ClFlags = c_mask|IndexMask; cl_p->ClFlags = clause_mask|IndexMask;
} }
cl_p->Owner = CurrentPred->OwnerFile; cl_p->Owner = CurrentPred->OwnerFile;
} }
@ -2391,7 +2396,7 @@ do_pass(void)
if (!pass_no) { if (!pass_no) {
if (CellPtr(label_offset+cpc->rnd1) > ASP-256) { if (CellPtr(label_offset+cpc->rnd1) > ASP-256) {
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch,3); longjmp(_YAP_CompilerBotch,3);
} }
if ( (char *)(label_offset+cpc->rnd1) > freep) if ( (char *)(label_offset+cpc->rnd1) > freep)
@ -2540,9 +2545,9 @@ do_pass(void)
break; break;
case fetch_args_for_bccall: case fetch_args_for_bccall:
if (cpc->nextInst->op != bccall_op) { if (cpc->nextInst->op != bccall_op) {
Error(SYSTEM_ERROR, TermNil, "compiling binary test", (int) cpc->op); _YAP_Error(SYSTEM_ERROR, TermNil, "compiling binary test", (int) cpc->op);
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
} }
a_bfunc(cpc->nextInst->rnd2); a_bfunc(cpc->nextInst->rnd2);
break; break;
@ -2561,9 +2566,9 @@ do_pass(void)
case name_op: case name_op:
break; break;
default: default:
Error(SYSTEM_ERROR, TermNil, "instruction %d found while assembling", (int) cpc->op); _YAP_Error(SYSTEM_ERROR, TermNil, "instruction %d found while assembling", (int) cpc->op);
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 1); longjmp(_YAP_CompilerBotch, 1);
} }
cpc = cpc->nextInst; cpc = cpc->nextInst;
} }
@ -2572,7 +2577,7 @@ do_pass(void)
} }
CODEADDR CODEADDR
assemble(int mode) _YAP_assemble(int mode)
{ {
/* /*
* the assembly proccess is done in two passes: 1 - a first pass * the assembly proccess is done in two passes: 1 - a first pass
@ -2589,8 +2594,8 @@ assemble(int mode)
asm_error = FALSE; asm_error = FALSE;
do_pass(); do_pass();
if (asm_error) { if (asm_error) {
Error_TYPE = SYSTEM_ERROR; _YAP_Error_TYPE = SYSTEM_ERROR;
ErrorMessage = "internal assembler error"; _YAP_ErrorMessage = "internal assembler error";
return (NIL); return (NIL);
} }
pass_no = 1; pass_no = 1;
@ -2605,9 +2610,9 @@ assemble(int mode)
#else #else
size = (CELL)code_p; size = (CELL)code_p;
#endif #endif
while ((code_addr = (CODEADDR) AllocCodeSpace(size)) == NULL) { while ((code_addr = (CODEADDR) _YAP_AllocCodeSpace(size)) == NULL) {
if (!growheap(TRUE)) { if (!_YAP_growheap(TRUE)) {
Error_TYPE = SYSTEM_ERROR; _YAP_Error_TYPE = SYSTEM_ERROR;
return (NIL); return (NIL);
} }
} }

688
C/analyst.c
View File

File diff suppressed because it is too large Load Diff

26
C/arith0.c
View File

@ -68,12 +68,12 @@ static E_FUNC
p_inf(E_ARGS) p_inf(E_ARGS)
{ {
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); _YAP_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#else #else
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); _YAP_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} else { } else {
@ -91,12 +91,12 @@ static E_FUNC
p_nan(E_ARGS) p_nan(E_ARGS)
{ {
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); _YAP_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#else #else
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */
Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number"); _YAP_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} else { } else {
@ -108,13 +108,13 @@ p_nan(E_ARGS)
static E_FUNC static E_FUNC
p_random(E_ARGS) p_random(E_ARGS)
{ {
RFLOAT(yap_random()); RFLOAT(_YAP_random());
} }
static E_FUNC static E_FUNC
p_cputime(E_ARGS) p_cputime(E_ARGS)
{ {
RFLOAT((Float)cputime()/1000.0); RFLOAT((Float)_YAP_cputime()/1000.0);
} }
static E_FUNC static E_FUNC
@ -204,19 +204,19 @@ static InitConstEntry InitConstTab[] = {
}; };
void void
InitConstExps(void) _YAP_InitConstExps(void)
{ {
unsigned int i; unsigned int i;
ExpEntry *p; ExpEntry *p;
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) { for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
AtomEntry *ae = RepAtom(LookupAtom(InitConstTab[i].OpName)); AtomEntry *ae = RepAtom(_YAP_LookupAtom(InitConstTab[i].OpName));
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
if (GetExpPropHavingLock(ae, 0)) { if (_YAP_GetExpPropHavingLock(ae, 0)) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
break; break;
} }
p = (ExpEntry *) AllocAtomSpace(sizeof(ExpEntry)); p = (ExpEntry *) _YAP_AllocAtomSpace(sizeof(ExpEntry));
p->KindOfPE = ExpProperty; p->KindOfPE = ExpProperty;
p->ArityOfEE = 0; p->ArityOfEE = 0;
p->ENoOfEE = 0; p->ENoOfEE = 0;
@ -229,16 +229,16 @@ InitConstExps(void)
/* This routine is called from Restore to make sure we have the same arithmetic operators */ /* This routine is called from Restore to make sure we have the same arithmetic operators */
int int
ReInitConstExps(void) _YAP_ReInitConstExps(void)
{ {
unsigned int i; unsigned int i;
Prop p; Prop p;
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) { for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
AtomEntry *ae = RepAtom(FullLookupAtom(InitConstTab[i].OpName)); AtomEntry *ae = RepAtom(_YAP_FullLookupAtom(InitConstTab[i].OpName));
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
if ((p = GetExpPropHavingLock(ae, 0)) == NULL) { if ((p = _YAP_GetExpPropHavingLock(ae, 0)) == NULL) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
return(FALSE); return(FALSE);
} }

406
C/arith1.c
View File

File diff suppressed because it is too large Load Diff

312
C/arith2.c
View File

@ -37,7 +37,7 @@ static char SccsId[] = "%W% %G%";
#define RBIG(v) (o)->big = v; return(big_int_e) #define RBIG(v) (o)->big = v; return(big_int_e)
#define RERROR() return(db_ref_e) #define RERROR() return(db_ref_e)
#define ArithIEval(t,v) Eval(t,v) #define ArithIEval(t,v) _YAP_Eval(t,v)
inline static Functor inline static Functor
AritFunctorOfTerm(Term t) { AritFunctorOfTerm(Term t) {
@ -64,7 +64,7 @@ EvalToTerm(blob_type f, union arith_ret *res)
return(MkFloatTerm(res->dbl)); return(MkFloatTerm(res->dbl));
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
return(MkBigIntTerm(res->big)); return(_YAP_MkBigIntTerm(res->big));
#endif #endif
default: default:
return(TermNil); return(TermNil);
@ -104,7 +104,7 @@ p_mod(Term t1, Term t2 E_ARGS)
RINT(IntegerOfTerm(t1) % i2); RINT(IntegerOfTerm(t1) % i2);
} }
case (CELL)double_e: case (CELL)double_e:
Error(TYPE_ERROR_INTEGER, t2, "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -117,11 +117,11 @@ p_mod(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case (CELL)double_e: case (CELL)double_e:
Error(TYPE_ERROR_INTEGER, t1, "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "mod/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -133,50 +133,50 @@ p_mod(Term t1, Term t2 E_ARGS)
/* modulo between bignum and integer */ /* modulo between bignum and integer */
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, l1, i2); Int r = mpz_mod_ui(new, l1, i2);
CleanBigNum(); _YAP_CleanBigNum();
RINT((mpz_sgn(l1) ? r : -r)); RINT((mpz_sgn(l1) ? r : -r));
} else if (i2 == 0) { } else if (i2 == 0) {
goto zero_divisor; goto zero_divisor;
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, l1, -i2); Int r = mpz_mod_ui(new, l1, -i2);
CleanBigNum(); _YAP_CleanBigNum();
RINT((mpz_sgn(l1) ? r : -r)); RINT((mpz_sgn(l1) ? r : -r));
} }
} }
case (CELL)big_int_e: case (CELL)big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mod(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_mod(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -187,7 +187,7 @@ p_mod(Term t1, Term t2 E_ARGS)
if (v2.Int == 0) goto zero_divisor; if (v2.Int == 0) goto zero_divisor;
RINT(v1.Int % v2.Int); RINT(v1.Int % v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -197,11 +197,11 @@ p_mod(Term t1, Term t2 E_ARGS)
RINT(v1.Int); RINT(v1.Int);
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "mod/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -210,30 +210,30 @@ p_mod(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* big mod integer */ /* big mod integer */
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, v1.big, v2.Int); Int r = mpz_mod_ui(new, v1.big, v2.Int);
CleanBigNum(); _YAP_CleanBigNum();
RINT((mpz_sgn(v1.big) ? r : -r)); RINT((mpz_sgn(v1.big) ? r : -r));
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
goto zero_divisor; goto zero_divisor;
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, v1.big, -v2.Int); Int r = mpz_mod_ui(new, v1.big, -v2.Int);
CleanBigNum(); _YAP_CleanBigNum();
RINT((mpz_sgn(v1.big) ? r : -r)); RINT((mpz_sgn(v1.big) ? r : -r));
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case (CELL)big_int_e: case (CELL)big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mod(new, v1.big, v2.big); mpz_mod(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -248,7 +248,7 @@ p_mod(Term t1, Term t2 E_ARGS)
RERROR(); RERROR();
} }
zero_divisor: zero_divisor:
Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); _YAP_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -264,14 +264,14 @@ fdiv_bigint(MP_INT *b1,MP_INT *b2)
mpf_t f1,f2; mpf_t f1,f2;
Float res; Float res;
PreAllocBigNum(); _YAP_PreAllocBigNum();
mpf_init(f1); mpf_init(f1);
mpf_init(f2); mpf_init(f2);
mpf_set_z(f1, b1); mpf_set_z(f1, b1);
mpf_set_z(f2, b2); mpf_set_z(f2, b2);
mpf_div(f1, f1, f2); mpf_div(f1, f1, f2);
res = mpf_get_d(f1); res = mpf_get_d(f1);
CleanBigNum(); _YAP_CleanBigNum();
return(res); return(res);
} else { } else {
return(f1/f2); return(f1/f2);
@ -312,7 +312,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
case (CELL)big_int_e: case (CELL)big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2)); Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(i1/f2); RFLOAT(i1/f2);
} }
#endif #endif
@ -320,7 +320,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
@ -341,14 +341,14 @@ p_fdiv(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
RFLOAT(FloatOfTerm(t1)/mpz_get_d(BigIntOfTerm(t2))); RFLOAT(FloatOfTerm(t1)/mpz_get_d(_YAP_BigIntOfTerm(t2)));
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1); v1.dbl = FloatOfTerm(t1);
bt1 = double_e; bt1 = double_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
#ifdef USE_GMP #ifdef USE_GMP
@ -359,30 +359,30 @@ p_fdiv(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
RFLOAT(mpz_get_d(BigIntOfTerm(t1))/(Float)i); RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))/(Float)i);
} }
case big_int_e: case big_int_e:
/* two bignums*/ /* two bignums*/
RFLOAT(fdiv_bigint(BigIntOfTerm(t1),BigIntOfTerm(t2))); RFLOAT(fdiv_bigint(_YAP_BigIntOfTerm(t1),_YAP_BigIntOfTerm(t2)));
// RFLOAT(mpz_get_d(BigIntOfTerm(t1))/mpz_get_d(BigIntOfTerm(t2))); // RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))/mpz_get_d(_YAP_BigIntOfTerm(t2)));
case double_e: case double_e:
{ {
Float dbl = FloatOfTerm(t2); Float dbl = FloatOfTerm(t2);
RFLOAT(mpz_get_d(BigIntOfTerm(t1))/dbl); RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))/dbl);
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -400,7 +400,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
RFLOAT(v1.Int/mpz_get_d(v2.big)); RFLOAT(v1.Int/mpz_get_d(v2.big));
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
@ -447,7 +447,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
static void static void
mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2) mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2)
{ {
MP_INT *n2 = PreAllocBigNum(), *n3 = PreAllocBigNum(); MP_INT *n2 = _YAP_PreAllocBigNum(), *n3 = _YAP_PreAllocBigNum();
mpz_ior(new, r1, r2); mpz_ior(new, r1, r2);
mpz_com(n2, r1); mpz_com(n2, r1);
@ -455,7 +455,7 @@ mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2)
mpz_com(n3, r2); mpz_com(n3, r2);
mpz_and(n3, n3, new); mpz_and(n3, n3, new);
mpz_ior(new, n2, n3); mpz_ior(new, n2, n3);
CleanBigNum(); _YAP_CleanBigNum();
} }
#endif #endif
#endif #endif
@ -479,16 +479,16 @@ p_xor(Term t1, Term t2 E_ARGS)
/* two integers */ /* two integers */
RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2)); RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "#/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "#/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t1)); mpz_set_si(new,IntOfTerm(t1));
mpz_xor(new, new, BigIntOfTerm(t2)); mpz_xor(new, new, _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
#endif #endif
@ -496,11 +496,11 @@ p_xor(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "#/2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "#/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -510,38 +510,38 @@ p_xor(Term t1, Term t2 E_ARGS)
switch (BlobOfFunctor(f2)) { switch (BlobOfFunctor(f2)) {
case long_int_e: case long_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t2)); mpz_set_si(new,IntOfTerm(t2));
mpz_xor(new, BigIntOfTerm(t1), new); mpz_xor(new, _YAP_BigIntOfTerm(t1), new);
RBIG(new); RBIG(new);
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_xor(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_xor(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "#/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "#/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -550,14 +550,14 @@ p_xor(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
RINT(v1.Int ^ v2.Int); RINT(v1.Int ^ v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "#/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "#/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,v1.Int); mpz_set_si(new,v1.Int);
mpz_xor(new, new, v2.big); mpz_xor(new, new, v2.big);
@ -565,11 +565,11 @@ p_xor(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "#/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "#/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -578,7 +578,7 @@ p_xor(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* anding a bignum with an integer is easy */ /* anding a bignum with an integer is easy */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,v2.Int); mpz_set_si(new,v2.Int);
mpz_xor(new, v1.big, new); mpz_xor(new, v1.big, new);
@ -586,14 +586,14 @@ p_xor(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_xor(new, v1.big, v2.big); mpz_xor(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -642,7 +642,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2)); Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(atan2(i1,f2)); RFLOAT(atan2(i1,f2));
} }
#endif #endif
@ -650,7 +650,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
@ -671,14 +671,14 @@ p_atan2(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(BigIntOfTerm(t2)))); RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(_YAP_BigIntOfTerm(t2))));
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1); v1.dbl = FloatOfTerm(t1);
bt1 = double_e; bt1 = double_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
#ifdef USE_GMP #ifdef USE_GMP
@ -689,29 +689,29 @@ p_atan2(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
RFLOAT(atan2(mpz_get_d(BigIntOfTerm(t1)),i)); RFLOAT(atan2(mpz_get_d(_YAP_BigIntOfTerm(t1)),i));
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
RFLOAT(atan2(mpz_get_d(BigIntOfTerm(t1)),mpz_get_d(BigIntOfTerm(t2)))); RFLOAT(atan2(mpz_get_d(_YAP_BigIntOfTerm(t1)),mpz_get_d(_YAP_BigIntOfTerm(t2))));
case double_e: case double_e:
{ {
Float dbl = FloatOfTerm(t2); Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(mpz_get_d(BigIntOfTerm(t1)),dbl)); RFLOAT(atan2(mpz_get_d(_YAP_BigIntOfTerm(t1)),dbl));
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -729,7 +729,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
RFLOAT(atan2(v1.Int,mpz_get_d(v2.big))); RFLOAT(atan2(v1.Int,mpz_get_d(v2.big)));
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
@ -804,7 +804,7 @@ p_power(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2)); Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(pow(i1,f2)); RFLOAT(pow(i1,f2));
} }
#endif #endif
@ -812,7 +812,7 @@ p_power(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
@ -833,14 +833,14 @@ p_power(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(BigIntOfTerm(t2)))); RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(_YAP_BigIntOfTerm(t2))));
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1); v1.dbl = FloatOfTerm(t1);
bt1 = double_e; bt1 = double_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
#ifdef USE_GMP #ifdef USE_GMP
@ -851,29 +851,29 @@ p_power(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
RFLOAT(pow(mpz_get_d(BigIntOfTerm(t1)),i)); RFLOAT(pow(mpz_get_d(_YAP_BigIntOfTerm(t1)),i));
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
RFLOAT(pow(mpz_get_d(BigIntOfTerm(t1)),mpz_get_d(BigIntOfTerm(t2)))); RFLOAT(pow(mpz_get_d(_YAP_BigIntOfTerm(t1)),mpz_get_d(_YAP_BigIntOfTerm(t2))));
case double_e: case double_e:
{ {
Float dbl = FloatOfTerm(t2); Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(BigIntOfTerm(t1)),dbl)); RFLOAT(pow(mpz_get_d(_YAP_BigIntOfTerm(t1)),dbl));
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -891,7 +891,7 @@ p_power(Term t1, Term t2 E_ARGS)
RFLOAT(pow(v1.Int,mpz_get_d(v2.big))); RFLOAT(pow(v1.Int,mpz_get_d(v2.big)));
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
@ -947,7 +947,7 @@ gcd(Int m11,Int m21)
} }
if (m11<0 || m21<0) { /* overflow? */ if (m11<0 || m21<0) { /* overflow? */
/* Oflow = 1; */ /* Oflow = 1; */
Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), _YAP_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
"gcd/2 with %d and %d", m11, m21); "gcd/2 with %d and %d", m11, m21);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
return(1); return(1);
@ -969,7 +969,7 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */
} }
if (m11<0 || m21<0) { /* overflow? */ if (m11<0 || m21<0) { /* overflow? */
/* Oflow = 1; */ /* Oflow = 1; */
Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), _YAP_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11),
"gcdmult/2 with %d and %d", m11, m21); "gcdmult/2 with %d and %d", m11, m21);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
return(1); return(1);
@ -1007,7 +1007,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
RINT(gcd(i1,i2)); RINT(gcd(i1,i2));
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -1018,14 +1018,14 @@ p_gcd(Term t1, Term t2 E_ARGS)
Int i = IntegerOfTerm(t1); Int i = IntegerOfTerm(t1);
if (i > 0) { if (i > 0) {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t2),i)); RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t2),i));
} else if (i == 0) { } else if (i == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, BigIntOfTerm(t2)); mpz_abs(new, _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} else { } else {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t2),-i)); RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t2),-i));
} }
} }
#endif #endif
@ -1033,11 +1033,11 @@ p_gcd(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "gcd/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1051,42 +1051,42 @@ p_gcd(Term t1, Term t2 E_ARGS)
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
if (i > 0) { if (i > 0) {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t1),i)); RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t1),i));
} else if (i == 0) { } else if (i == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, BigIntOfTerm(t1)); mpz_abs(new, _YAP_BigIntOfTerm(t1));
RBIG(new); RBIG(new);
} else { } else {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t1),-i)); RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t1),-i));
} }
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_gcd(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_gcd(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -1102,7 +1102,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
RINT(gcd(i1,i2)); RINT(gcd(i1,i2));
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -1112,7 +1112,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
if (v1.Int > 0) { if (v1.Int > 0) {
RINT(mpz_gcd_ui(NULL,v2.big,v1.Int)); RINT(mpz_gcd_ui(NULL,v2.big,v1.Int));
} else if (v1.Int == 0) { } else if (v1.Int == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, v2.big); mpz_abs(new, v2.big);
RBIG(new); RBIG(new);
@ -1122,11 +1122,11 @@ p_gcd(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "gcd/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1138,7 +1138,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
if (v2.Int > 0) { if (v2.Int > 0) {
RINT(mpz_gcd_ui(NULL,v1.big,v2.Int)); RINT(mpz_gcd_ui(NULL,v1.big,v2.Int));
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, v1.big); mpz_abs(new, v1.big);
RBIG(new); RBIG(new);
@ -1148,13 +1148,13 @@ p_gcd(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_gcd(new, v1.big, v2.big); mpz_gcd(new, v1.big, v2.big);
RBIG(new); RBIG(new);
} }
@ -1204,7 +1204,7 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i = IntegerOfTerm(t1); Int i = IntegerOfTerm(t1);
MP_INT *b = BigIntOfTerm(t2); MP_INT *b = _YAP_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) < 0) { if (mpz_cmp_si(b,i) < 0) {
RBIG(b); RBIG(b);
@ -1216,7 +1216,7 @@ p_min(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
@ -1246,7 +1246,7 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Float fl1 = FloatOfTerm(t1); Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(BigIntOfTerm(t2)); Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
if (fl1 <= fl2) { if (fl1 <= fl2) {
RFLOAT(fl1); RFLOAT(fl1);
} }
@ -1257,7 +1257,7 @@ p_min(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1); v1.dbl = FloatOfTerm(t1);
bt1 = double_e; bt1 = double_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
#ifdef USE_GMP #ifdef USE_GMP
@ -1268,7 +1268,7 @@ p_min(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
MP_INT *b = BigIntOfTerm(t1); MP_INT *b = _YAP_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) < 0) { if (mpz_cmp_si(b,i) < 0) {
RBIG(b); RBIG(b);
@ -1278,8 +1278,8 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *b1 = BigIntOfTerm(t1); MP_INT *b1 = _YAP_BigIntOfTerm(t1);
MP_INT *b2 = BigIntOfTerm(t2); MP_INT *b2 = _YAP_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) < 0) { if (mpz_cmp(b1,b2) < 0) {
RBIG(b1); RBIG(b1);
@ -1289,7 +1289,7 @@ p_min(Term t1, Term t2 E_ARGS)
case double_e: case double_e:
{ {
Float fl1 = FloatOfTerm(t2); Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(BigIntOfTerm(t1)); Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t1));
if (fl1 <= fl2) { if (fl1 <= fl2) {
RFLOAT(fl1); RFLOAT(fl1);
} }
@ -1297,17 +1297,17 @@ p_min(Term t1, Term t2 E_ARGS)
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -1335,7 +1335,7 @@ p_min(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
@ -1443,7 +1443,7 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i = IntegerOfTerm(t1); Int i = IntegerOfTerm(t1);
MP_INT *b = BigIntOfTerm(t2); MP_INT *b = _YAP_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) > 0) { if (mpz_cmp_si(b,i) > 0) {
RBIG(b); RBIG(b);
@ -1455,7 +1455,7 @@ p_max(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1); v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e; bt1 = long_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
case double_e: case double_e:
@ -1485,7 +1485,7 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Float fl1 = FloatOfTerm(t1); Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(BigIntOfTerm(t2)); Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
if (fl1 >= fl2) { if (fl1 >= fl2) {
RFLOAT(fl1); RFLOAT(fl1);
} }
@ -1496,7 +1496,7 @@ p_max(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1); v1.dbl = FloatOfTerm(t1);
bt1 = double_e; bt1 = double_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
break; break;
#ifdef USE_GMP #ifdef USE_GMP
@ -1507,7 +1507,7 @@ p_max(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i = IntegerOfTerm(t2); Int i = IntegerOfTerm(t2);
MP_INT *b = BigIntOfTerm(t1); MP_INT *b = _YAP_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) > 0) { if (mpz_cmp_si(b,i) > 0) {
RBIG(b); RBIG(b);
@ -1517,8 +1517,8 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *b1 = BigIntOfTerm(t1); MP_INT *b1 = _YAP_BigIntOfTerm(t1);
MP_INT *b2 = BigIntOfTerm(t2); MP_INT *b2 = _YAP_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) > 0) { if (mpz_cmp(b1,b2) > 0) {
RBIG(b1); RBIG(b1);
@ -1528,7 +1528,7 @@ p_max(Term t1, Term t2 E_ARGS)
case double_e: case double_e:
{ {
Float fl1 = FloatOfTerm(t2); Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(BigIntOfTerm(t1)); Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t1));
if (fl1 >= fl2) { if (fl1 >= fl2) {
RFLOAT(fl1); RFLOAT(fl1);
} }
@ -1536,17 +1536,17 @@ p_max(Term t1, Term t2 E_ARGS)
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
break; break;
} }
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
/* don't know anything about second */ /* don't know anything about second */
bt2 = Eval(t2, &v2); bt2 = _YAP_Eval(t2, &v2);
} }
/* second case, no need no evaluation */ /* second case, no need no evaluation */
switch (bt1) { switch (bt1) {
@ -1574,7 +1574,7 @@ p_max(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
@ -1681,50 +1681,50 @@ p_binary_is(void)
blob_type f; blob_type f;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t, "X is Y"); _YAP_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE); return(FALSE);
} }
if (IsIntTerm(t)) { if (IsIntTerm(t)) {
blob_type f = InitBinTab[IntOfTerm(t)].f(Deref(ARG3),Deref(ARG4),&res); blob_type f = InitBinTab[IntOfTerm(t)].f(Deref(ARG3),Deref(ARG4),&res);
return (unify_constant(ARG1,EvalToTerm(f,&res))); return (_YAP_unify_constant(ARG1,EvalToTerm(f,&res)));
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t); Atom name = AtomOfTerm(t);
ExpEntry *p; ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, 2)))) { if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, 2)))) {
Term ti[2]; Term ti[2];
/* error */ /* error */
ti[0] = t; ti[0] = t;
ti[1] = MkIntTerm(2); ti[1] = MkIntTerm(2);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti); t = _YAP_MkApplTerm(_YAP_MkFunctor(_YAP_LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t, _YAP_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression", "functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,2); RepAtom(name)->StrOfAE,2);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
return(FALSE); return(FALSE);
} }
f = p->FOfEE.binary(Deref(ARG3),Deref(ARG4),&res); f = p->FOfEE.binary(Deref(ARG3),Deref(ARG4),&res);
return (unify_constant(ARG1,EvalToTerm(f,&res))); return (_YAP_unify_constant(ARG1,EvalToTerm(f,&res)));
} }
return(FALSE); return(FALSE);
} }
void void
InitBinaryExps(void) _YAP_InitBinaryExps(void)
{ {
unsigned int i; unsigned int i;
ExpEntry *p; ExpEntry *p;
for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) { for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
AtomEntry *ae = RepAtom(LookupAtom(InitBinTab[i].OpName)); AtomEntry *ae = RepAtom(_YAP_LookupAtom(InitBinTab[i].OpName));
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
if (GetExpPropHavingLock(ae, 2)) { if (_YAP_GetExpPropHavingLock(ae, 2)) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
break; break;
} }
p = (ExpEntry *) AllocAtomSpace(sizeof(ExpEntry)); p = (ExpEntry *) _YAP_AllocAtomSpace(sizeof(ExpEntry));
p->KindOfPE = ExpProperty; p->KindOfPE = ExpProperty;
p->ArityOfEE = 2; p->ArityOfEE = 2;
p->ENoOfEE = 2; p->ENoOfEE = 2;
@ -1733,21 +1733,21 @@ InitBinaryExps(void)
ae->PropsOfAE = AbsExpProp(p); ae->PropsOfAE = AbsExpProp(p);
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
} }
InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag); _YAP_InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
} }
/* This routine is called from Restore to make sure we have the same arithmetic operators */ /* This routine is called from Restore to make sure we have the same arithmetic operators */
int int
ReInitBinaryExps(void) _YAP_ReInitBinaryExps(void)
{ {
unsigned int i; unsigned int i;
Prop p; Prop p;
for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) { for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
AtomEntry *ae = RepAtom(FullLookupAtom(InitBinTab[i].OpName)); AtomEntry *ae = RepAtom(_YAP_FullLookupAtom(InitBinTab[i].OpName));
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
if ((p = GetExpPropHavingLock(ae, 2)) == NULL) { if ((p = _YAP_GetExpPropHavingLock(ae, 2)) == NULL) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
return(FALSE); return(FALSE);
} }

289
C/arrays.c
View File

@ -173,7 +173,7 @@ AccessNamedArray(Atom a, Int indx)
READ_LOCK(ptr->ArRWLock); READ_LOCK(ptr->ArRWLock);
if (-(pp->ArrayEArity) <= indx || indx < 0) { if (-(pp->ArrayEArity) <= indx || indx < 0) {
/* Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/ /* _YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/
READ_UNLOCK(ptr->ArRWLock); READ_UNLOCK(ptr->ArRWLock);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
return(MkAtomTerm(AtomFoundVar)); return(MkAtomTerm(AtomFoundVar));
@ -259,7 +259,7 @@ AccessNamedArray(Atom a, Int indx)
READ_UNLOCK(ptr->ArRWLock); READ_UNLOCK(ptr->ArRWLock);
if (ref != NULL) { if (ref != NULL) {
TRef = FetchTermFromDB(ref,3); TRef = _YAP_FetchTermFromDB(ref,3);
} else { } else {
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
TRef = TermNil; TRef = TermNil;
@ -273,7 +273,7 @@ AccessNamedArray(Atom a, Int indx)
} }
} }
else { else {
Error(EXISTENCE_ERROR_ARRAY,MkAtomTerm(a),"named array"); _YAP_Error(EXISTENCE_ERROR_ARRAY,MkAtomTerm(a),"named array");
return (TermNil); return (TermNil);
} }
@ -291,22 +291,22 @@ p_access_array(void)
union arith_ret v; union arith_ret v;
if (IsIntTerm(ti)) if (IsIntTerm(ti))
indx = IntOfTerm(ti); indx = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e) else if (_YAP_Eval(ti, &v) == long_int_e)
indx = v.Int; indx = v.Int;
else { else {
Error(TYPE_ERROR_INTEGER,ti,"access_array"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"access_array");
return (FALSE); return (FALSE);
} }
} }
else { else {
Error(INSTANTIATION_ERROR,ti,"access_array"); _YAP_Error(INSTANTIATION_ERROR,ti,"access_array");
return (TermNil); return (TermNil);
} }
if (IsNonVarTerm(t)) { if (IsNonVarTerm(t)) {
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
if (indx >= ArityOfFunctor(FunctorOfTerm(t)) || indx < 0) { if (indx >= ArityOfFunctor(FunctorOfTerm(t)) || indx < 0) {
/* Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/ /* _YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx), "access_array");*/
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
return(FALSE); return(FALSE);
} }
@ -317,14 +317,14 @@ p_access_array(void)
return(FALSE); return(FALSE);
} }
} else { } else {
Error(TYPE_ERROR_ARRAY,t,"access_array"); _YAP_Error(TYPE_ERROR_ARRAY,t,"access_array");
return(FALSE); return(FALSE);
} }
} else { } else {
Error(INSTANTIATION_ERROR,t,"access_array"); _YAP_Error(INSTANTIATION_ERROR,t,"access_array");
return(FALSE); return(FALSE);
} }
return (unify(tf, ARG3)); return (_YAP_unify(tf, ARG3));
} }
static Int static Int
@ -337,35 +337,35 @@ p_array_arg(void)
union arith_ret v; union arith_ret v;
if (IsIntTerm(ti)) if (IsIntTerm(ti))
indx = IntOfTerm(ti); indx = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e) else if (_YAP_Eval(ti, &v) == long_int_e)
indx = v.Int; indx = v.Int;
else { else {
Error(TYPE_ERROR_INTEGER,ti,"array_arg"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"array_arg");
return (FALSE); return (FALSE);
} }
} }
else { else {
Error(INSTANTIATION_ERROR,ti,"array_arg"); _YAP_Error(INSTANTIATION_ERROR,ti,"array_arg");
return (FALSE); return (FALSE);
} }
t = Deref(ARG2); t = Deref(ARG2);
if (IsNonVarTerm(t)) { if (IsNonVarTerm(t)) {
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
return (unify(((RepAppl(t))[indx + 1]), ARG1)); return (_YAP_unify(((RepAppl(t))[indx + 1]), ARG1));
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
Term tf = AccessNamedArray(AtomOfTerm(t), indx); Term tf = AccessNamedArray(AtomOfTerm(t), indx);
if (tf == MkAtomTerm(AtomFoundVar)) { if (tf == MkAtomTerm(AtomFoundVar)) {
return(FALSE); return(FALSE);
} }
return (unify(tf, ARG1)); return (_YAP_unify(tf, ARG1));
} }
else else
Error(TYPE_ERROR_ARRAY,t,"array_arg"); _YAP_Error(TYPE_ERROR_ARRAY,t,"array_arg");
} }
else else
Error(INSTANTIATION_ERROR,t,"array_arg"); _YAP_Error(INSTANTIATION_ERROR,t,"array_arg");
return (FALSE); return (FALSE);
@ -382,7 +382,7 @@ InitNamedArray(ArrayEntry * p, Int dim)
/* place terms in reverse order */ /* place terms in reverse order */
Bind_Global(&(p->ValueOfVE),AbsAppl(H)); Bind_Global(&(p->ValueOfVE),AbsAppl(H));
tp = H; tp = H;
tp[0] = (CELL)MkFunctor(AtomArray, dim); tp[0] = (CELL)_YAP_MkFunctor(AtomArray, dim);
tp++; tp++;
p->ArrayEArity = dim; p->ArrayEArity = dim;
/* Initialise the array as a set of variables */ /* Initialise the array as a set of variables */
@ -399,7 +399,7 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
{ {
ArrayEntry *p; ArrayEntry *p;
p = (ArrayEntry *) AllocAtomSpace(sizeof(*p)); p = (ArrayEntry *) _YAP_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty; p->KindOfPE = ArrayProperty;
p->NextOfPE = ae->PropsOfAE; p->NextOfPE = ae->PropsOfAE;
INIT_RWLOCK(p->ArRWLock); INIT_RWLOCK(p->ArRWLock);
@ -439,10 +439,10 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
asize = array_size*sizeof(DBRef); asize = array_size*sizeof(DBRef);
break; break;
} }
while ((p->ValueOfVE.floats = (Float *) AllocAtomSpace(asize) ) == NULL) { while ((p->ValueOfVE.floats = (Float *) _YAP_AllocAtomSpace(asize) ) == NULL) {
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return; return;
} }
YAPEnterCriticalSection(); YAPEnterCriticalSection();
@ -454,7 +454,7 @@ static void
CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR start_addr, StaticArrayEntry *p) CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR start_addr, StaticArrayEntry *p)
{ {
if (EndOfPAEntr(p)) { if (EndOfPAEntr(p)) {
p = (StaticArrayEntry *) AllocAtomSpace(sizeof(*p)); p = (StaticArrayEntry *) _YAP_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty; p->KindOfPE = ArrayProperty;
p->NextOfPE = ae->PropsOfAE; p->NextOfPE = ae->PropsOfAE;
INIT_RWLOCK(p->ArRWLock); INIT_RWLOCK(p->ArRWLock);
@ -520,7 +520,7 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
return; return;
pp->ArrayEArity = -dim; pp->ArrayEArity = -dim;
#if HAVE_MMAP #if HAVE_MMAP
if (pp->ValueOfVE.chars < (char *)HeapBase || if (pp->ValueOfVE.chars < (char *)_YAP_HeapBase ||
pp->ValueOfVE.chars > (char *)HeapTop) { pp->ValueOfVE.chars > (char *)HeapTop) {
ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars)); ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars));
return; return;
@ -580,32 +580,6 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
WRITE_UNLOCK(pp->ArRWLock); WRITE_UNLOCK(pp->ArRWLock);
} }
CELL *
ClearNamedArray(CELL *pt0)
{
/* given a key to an array, just take it off-line */
PropEntry *pp;
AtomEntry *ae = (AtomEntry *)RepAppl(pt0[-1]);
READ_LOCK(ae->ARWLock);
pp = RepProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) {
pp = RepProp(pp->NextOfPE);
}
READ_UNLOCK(ae->ARWLock);
WRITE_LOCK(((ArrayEntry *)pp)->ArRWLock);
if (!EndOfPAEntr(pp)) {
((ArrayEntry *) pp)->ArrayEArity = 0;
/* tell backtracking to skip two cells */
WRITE_UNLOCK(((ArrayEntry *)pp)->ArRWLock);
return(pt0-2);
} else {
WRITE_UNLOCK(((ArrayEntry *)pp)->ArRWLock);
Error(EXISTENCE_ERROR_ARRAY,TermNil,"clear array");
return(pt0); /* just make GCC happy */
}
}
/* create an array (?Name, + Size) */ /* create an array (?Name, + Size) */
static Int static Int
p_create_array(void) p_create_array(void)
@ -621,10 +595,10 @@ p_create_array(void)
union arith_ret v; union arith_ret v;
if (IsIntTerm(ti)) if (IsIntTerm(ti))
size = IntOfTerm(ti); size = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e) else if (_YAP_Eval(ti, &v) == long_int_e)
size = v.Int; size = v.Int;
else { else {
Error(TYPE_ERROR_INTEGER,ti,"create_array"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"create_array");
return (FALSE); return (FALSE);
} }
} }
@ -633,15 +607,15 @@ p_create_array(void)
/* Create an anonymous array */ /* Create an anonymous array */
Functor farray; Functor farray;
farray = MkFunctor(AtomArray, size); farray = _YAP_MkFunctor(AtomArray, size);
if (H+1+size > ASP-1024) { if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE); return(FALSE);
} else { } else {
if (H+1+size > ASP-1024) { if (H+1+size > ASP-1024) {
if (!growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) { if (!_YAP_growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return FALSE; return FALSE;
} }
} }
@ -654,7 +628,7 @@ p_create_array(void)
RESET_VARIABLE(H); RESET_VARIABLE(H);
H++; H++;
} }
return (unify(t, ARG1)); return (_YAP_unify(t, ARG1));
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
/* Create a named array */ /* Create a named array */
@ -668,8 +642,8 @@ p_create_array(void)
if (EndOfPAEntr(pp)) { if (EndOfPAEntr(pp)) {
if (H+1+size > ASP-1024) { if (H+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto restart; goto restart;
@ -682,12 +656,12 @@ p_create_array(void)
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
if (!IsVarTerm(app->ValueOfVE) || !IsUnboundVar(app->ValueOfVE)) if (!IsVarTerm(app->ValueOfVE) || !IsUnboundVar(app->ValueOfVE))
Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array", _YAP_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array",
ae->StrOfAE); ae->StrOfAE);
else { else {
if (H+1+size > ASP-1024) { if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto restart; goto restart;
@ -711,23 +685,23 @@ p_create_static_array(void)
static_array_types props; static_array_types props;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"create static array"); _YAP_Error(INSTANTIATION_ERROR,ti,"create static array");
return (FALSE); return (FALSE);
} else if (IsIntTerm(ti)) } else if (IsIntTerm(ti))
size = IntOfTerm(ti); size = IntOfTerm(ti);
else { else {
union arith_ret v; union arith_ret v;
if (Eval(ti, &v) == long_int_e) { if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int; size = v.Int;
} }
else { else {
Error(TYPE_ERROR_INTEGER,ti,"create static array"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"create static array");
return (FALSE); return (FALSE);
} }
} }
if (IsVarTerm(tprops)) { if (IsVarTerm(tprops)) {
Error(INSTANTIATION_ERROR,tprops,"create static array"); _YAP_Error(INSTANTIATION_ERROR,tprops,"create static array");
return (FALSE); return (FALSE);
} else if (IsAtomTerm(tprops)) { } else if (IsAtomTerm(tprops)) {
char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE; char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
@ -748,16 +722,16 @@ p_create_static_array(void)
else if (!strcmp(atname, "term")) else if (!strcmp(atname, "term"))
props = array_of_terms; props = array_of_terms;
else { else {
Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array"); _YAP_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
return(FALSE); return(FALSE);
} }
} else { } else {
Error(TYPE_ERROR_ATOM,tprops,"create static array"); _YAP_Error(TYPE_ERROR_ATOM,tprops,"create static array");
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"create static array"); _YAP_Error(INSTANTIATION_ERROR,t,"create static array");
return (FALSE); return (FALSE);
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
@ -780,15 +754,15 @@ p_create_static_array(void)
CreateStaticArray(ae, size, props, NULL, pp); CreateStaticArray(ae, size, props, NULL, pp);
return (TRUE); return (TRUE);
} else { } else {
Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over dynamic array"); _YAP_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over dynamic array");
return (FALSE); return (FALSE);
} }
} else { } else {
Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over static array"); _YAP_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over static array");
return (FALSE); return (FALSE);
} }
} }
Error(TYPE_ERROR_ATOM,t,"create static array"); _YAP_Error(TYPE_ERROR_ATOM,t,"create static array");
return (FALSE); return (FALSE);
} }
@ -832,23 +806,23 @@ p_resize_static_array(void)
Int size; Int size;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"resize a static array"); _YAP_Error(INSTANTIATION_ERROR,ti,"resize a static array");
return (FALSE); return (FALSE);
} else if (IsIntTerm(ti)) } else if (IsIntTerm(ti))
size = IntOfTerm(ti); size = IntOfTerm(ti);
else { else {
union arith_ret v; union arith_ret v;
if (Eval(ti, &v) == long_int_e) { if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int; size = v.Int;
} }
else { else {
Error(TYPE_ERROR_INTEGER,ti,"resize a static array"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"resize a static array");
return (FALSE); return (FALSE);
} }
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"resize a static array"); _YAP_Error(INSTANTIATION_ERROR,t,"resize a static array");
return (FALSE); return (FALSE);
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
@ -859,15 +833,15 @@ p_resize_static_array(void)
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE); pp = RepStaticArrayProp(pp->NextOfPE);
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) { if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
Error(PERMISSION_ERROR_RESIZE_ARRAY,t,"resize a static array"); _YAP_Error(PERMISSION_ERROR_RESIZE_ARRAY,t,"resize a static array");
return(FALSE); return(FALSE);
} else { } else {
Int osize = - pp->ArrayEArity; Int osize = - pp->ArrayEArity;
ResizeStaticArray(pp, size); ResizeStaticArray(pp, size);
return(unify(ARG2,MkIntegerTerm(osize))); return(_YAP_unify(ARG2,MkIntegerTerm(osize)));
} }
} else { } else {
Error(TYPE_ERROR_ATOM,t,"resize a static array"); _YAP_Error(TYPE_ERROR_ATOM,t,"resize a static array");
return (FALSE); return (FALSE);
} }
} }
@ -880,7 +854,7 @@ p_close_static_array(void)
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"close static array"); _YAP_Error(INSTANTIATION_ERROR,t,"close static array");
return (FALSE); return (FALSE);
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
@ -899,12 +873,12 @@ p_close_static_array(void)
StaticArrayEntry *ptr = (StaticArrayEntry *)pp; StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
if (ptr->ValueOfVE.ints != NULL) { if (ptr->ValueOfVE.ints != NULL) {
#if HAVE_MMAP #if HAVE_MMAP
if (ptr->ValueOfVE.chars < (char *)HeapBase || if (ptr->ValueOfVE.chars < (char *)_YAP_HeapBase ||
ptr->ValueOfVE.chars > (char *)HeapTop) { ptr->ValueOfVE.chars > (char *)HeapTop) {
return(CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars)); return(CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars));
} }
#endif #endif
FreeAtomSpace((char *)(ptr->ValueOfVE.ints)); _YAP_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
ptr->ValueOfVE.ints = NULL; ptr->ValueOfVE.ints = NULL;
ptr->ArrayEArity = 0; ptr->ArrayEArity = 0;
return(TRUE); return(TRUE);
@ -913,7 +887,7 @@ p_close_static_array(void)
} }
} }
} else { } else {
Error(TYPE_ERROR_ATOM,t,"close static array"); _YAP_Error(TYPE_ERROR_ATOM,t,"close static array");
return (FALSE); return (FALSE);
} }
} }
@ -958,21 +932,21 @@ CloseMmappedArray(StaticArrayEntry *pp, void *area)
optr = ptr; optr = ptr;
} }
if (ptr == NULL) { if (ptr == NULL) {
Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (array chain incoherent)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (array chain incoherent)", strerror(errno));
return(FALSE); return(FALSE);
} }
if (munmap(ptr->start, ptr->size) == -1) { if (munmap(ptr->start, ptr->size) == -1) {
Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (munmap: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (munmap: %s)", strerror(errno));
return(FALSE); return(FALSE);
} }
optr->next = ptr->next; optr->next = ptr->next;
pp->ValueOfVE.ints = NULL; pp->ValueOfVE.ints = NULL;
pp->ArrayEArity = 0; pp->ArrayEArity = 0;
if (close(ptr->fd) < 0) { if (close(ptr->fd) < 0) {
Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (close: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"close_mmapped_array (close: %s)", strerror(errno));
return(FALSE); return(FALSE);
} }
FreeAtomSpace((char *)ptr); _YAP_FreeAtomSpace((char *)ptr);
return(TRUE); return(TRUE);
} }
@ -992,24 +966,24 @@ ResizeMmappedArray(StaticArrayEntry *pp, Int dim, void *area)
and last we initialise again and last we initialise again
*/ */
if (munmap(ptr->start, ptr->size) == -1) { if (munmap(ptr->start, ptr->size) == -1) {
Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (munmap: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (munmap: %s)", strerror(errno));
return; return;
} }
total_size = (ptr->size / ptr->items)*dim; total_size = (ptr->size / ptr->items)*dim;
if (ftruncate(ptr->fd, total_size) < 0) { if (ftruncate(ptr->fd, total_size) < 0) {
Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (ftruncate: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (ftruncate: %s)", strerror(errno));
return; return;
} }
if (lseek(ptr->fd, total_size-1, SEEK_SET) < 0) { if (lseek(ptr->fd, total_size-1, SEEK_SET) < 0) {
Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (lseek: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (lseek: %s)", strerror(errno));
return; return;
} }
if (write(ptr->fd, "", 1) < 0) { if (write(ptr->fd, "", 1) < 0) {
Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (write: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (write: %s)", strerror(errno));
return; return;
} }
if ((ptr->start = (void *)mmap(0, (size_t) total_size, PROT_READ | PROT_WRITE, MAP_SHARED, ptr->fd, 0)) == (void *) - 1) { if ((ptr->start = (void *)mmap(0, (size_t) total_size, PROT_READ | PROT_WRITE, MAP_SHARED, ptr->fd, 0)) == (void *) - 1) {
Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (mmap: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"resize_mmapped_array (mmap: %s)", strerror(errno));
return; return;
} }
ptr->size = total_size; ptr->size = total_size;
@ -1035,23 +1009,23 @@ p_create_mmapped_array(void)
int fd; int fd;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"create_mmapped_array"); _YAP_Error(INSTANTIATION_ERROR,ti,"create_mmapped_array");
return (FALSE); return (FALSE);
} else if (IsIntTerm(ti)) } else if (IsIntTerm(ti))
size = IntOfTerm(ti); size = IntOfTerm(ti);
else { else {
union arith_ret v; union arith_ret v;
if (Eval(ti, &v) == long_int_e) { if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int; size = v.Int;
} }
else { else {
Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array");
return (FALSE); return (FALSE);
} }
} }
if (IsVarTerm(tprops)) { if (IsVarTerm(tprops)) {
Error(INSTANTIATION_ERROR,tprops,"create_mmapped_array"); _YAP_Error(INSTANTIATION_ERROR,tprops,"create_mmapped_array");
return (FALSE); return (FALSE);
} else if (IsAtomTerm(tprops)) { } else if (IsAtomTerm(tprops)) {
char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE; char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
@ -1077,16 +1051,16 @@ p_create_mmapped_array(void)
props = array_of_uchars; props = array_of_uchars;
total_size = size*sizeof(unsigned char); total_size = size*sizeof(unsigned char);
} else { } else {
Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create_mmapped_array"); _YAP_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create_mmapped_array");
return(FALSE); return(FALSE);
} }
} else { } else {
Error(TYPE_ERROR_ATOM,tprops,"create_mmapped_array"); _YAP_Error(TYPE_ERROR_ATOM,tprops,"create_mmapped_array");
return (FALSE); return (FALSE);
} }
if (IsVarTerm(tfile)) { if (IsVarTerm(tfile)) {
Error(INSTANTIATION_ERROR,tfile,"create_mmapped_array"); _YAP_Error(INSTANTIATION_ERROR,tfile,"create_mmapped_array");
return (FALSE); return (FALSE);
} else if (IsAtomTerm(tfile)) { } else if (IsAtomTerm(tfile)) {
char *filename = RepAtom(AtomOfTerm(tfile))->StrOfAE; char *filename = RepAtom(AtomOfTerm(tfile))->StrOfAE;
@ -1094,26 +1068,26 @@ p_create_mmapped_array(void)
fd = open(filename, O_RDWR|O_CREAT, S_IRUSR|S_IWUSR); fd = open(filename, O_RDWR|O_CREAT, S_IRUSR|S_IWUSR);
if (fd == -1) { if (fd == -1) {
Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (open: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (open: %s)", strerror(errno));
return(FALSE); return(FALSE);
} }
if (lseek(fd, total_size-1, SEEK_SET) < 0) if (lseek(fd, total_size-1, SEEK_SET) < 0)
Error(SYSTEM_ERROR,tfile,"create_mmapped_array (lseek: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,tfile,"create_mmapped_array (lseek: %s)", strerror(errno));
if (write(fd, "", 1) < 0) if (write(fd, "", 1) < 0)
Error(SYSTEM_ERROR,tfile,"create_mmapped_array (write: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,tfile,"create_mmapped_array (write: %s)", strerror(errno));
/* /*
if (ftruncate(fd, total_size) < 0) if (ftruncate(fd, total_size) < 0)
Error(SYSTEM_ERROR,tfile,"create_mmapped_array"); _YAP_Error(SYSTEM_ERROR,tfile,"create_mmapped_array");
*/ */
if ((array_addr = (CODEADDR)mmap(0, (size_t) total_size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0)) == (CODEADDR) - 1) if ((array_addr = (CODEADDR)mmap(0, (size_t) total_size, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0)) == (CODEADDR) - 1)
Error(SYSTEM_ERROR,tfile,"create_mmapped_array (mmap: %s)", strerror(errno)); _YAP_Error(SYSTEM_ERROR,tfile,"create_mmapped_array (mmap: %s)", strerror(errno));
} else { } else {
Error(TYPE_ERROR_ATOM,tfile,"create_mmapped_array"); _YAP_Error(TYPE_ERROR_ATOM,tfile,"create_mmapped_array");
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"create_mmapped_array"); _YAP_Error(INSTANTIATION_ERROR,t,"create_mmapped_array");
return (FALSE); return (FALSE);
} }
else if (IsAtomTerm(t)) { else if (IsAtomTerm(t)) {
@ -1132,7 +1106,7 @@ p_create_mmapped_array(void)
mmap_array_block *ptr; mmap_array_block *ptr;
CreateStaticArray(ae, size, props, array_addr, pp); CreateStaticArray(ae, size, props, array_addr, pp);
ptr = (mmap_array_block *)AllocAtomSpace(sizeof(mmap_array_block)); ptr = (mmap_array_block *)_YAP_AllocAtomSpace(sizeof(mmap_array_block));
ptr->name = AbsAtom(ae); ptr->name = AbsAtom(ae);
ptr->size = total_size; ptr->size = total_size;
ptr->items = size; ptr->items = size;
@ -1144,15 +1118,15 @@ p_create_mmapped_array(void)
} else { } else {
WRITE_UNLOCK(pp->ArRWLock); WRITE_UNLOCK(pp->ArRWLock);
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
Error(DOMAIN_ERROR_ARRAY_TYPE,t,"create_mmapped_array", ae->StrOfAE); _YAP_Error(DOMAIN_ERROR_ARRAY_TYPE,t,"create_mmapped_array", ae->StrOfAE);
return(FALSE); return(FALSE);
} }
} else { } else {
Error(TYPE_ERROR_ATOM,t,"create_mmapped_array"); _YAP_Error(TYPE_ERROR_ATOM,t,"create_mmapped_array");
return (FALSE); return (FALSE);
} }
#else #else
Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (mmap)"); _YAP_Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (mmap)");
return (FALSE); return (FALSE);
#endif #endif
} }
@ -1165,7 +1139,7 @@ replace_array_references_complex(register CELL *pt0,
Term Var) Term Var)
{ {
register CELL **to_visit = (CELL **) PreAllocCodeSpace(); register CELL **to_visit = (CELL **) _YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit; CELL **to_visit_base = to_visit;
loop: loop:
@ -1261,7 +1235,7 @@ loop:
} }
Bind_Global(PtrOfTerm(Var), TermNil); Bind_Global(PtrOfTerm(Var), TermNil);
ReleasePreAllocCodeSpace((ADDR)to_visit); _YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
} }
/* /*
@ -1311,7 +1285,7 @@ p_array_references(void)
Term t1 = HeadOfTerm(t); Term t1 = HeadOfTerm(t);
Term t2 = TailOfTerm(t); Term t2 = TailOfTerm(t);
return (unify(t1, ARG2) && unify(t2, ARG3)); return (_YAP_unify(t1, ARG2) && _YAP_unify(t2, ARG3));
} }
static Int static Int
@ -1327,22 +1301,22 @@ p_assign_static(void)
indx = IntOfTerm(t2); indx = IntOfTerm(t2);
else { else {
union arith_ret v; union arith_ret v;
if (Eval(t2, &v) == long_int_e) { if (_YAP_Eval(t2, &v) == long_int_e) {
indx = v.Int; indx = v.Int;
} else { } else {
Error(TYPE_ERROR_INTEGER,t2,"update_array"); _YAP_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE); return (FALSE);
} }
} }
} else { } else {
Error(INSTANTIATION_ERROR,t2,"update_array"); _YAP_Error(INSTANTIATION_ERROR,t2,"update_array");
return (FALSE); return (FALSE);
} }
t3 = Deref(ARG3); t3 = Deref(ARG3);
t1 = Deref(ARG1); t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR,t1,"update_array"); _YAP_Error(INSTANTIATION_ERROR,t1,"update_array");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(t1)) { if (!IsAtomTerm(t1)) {
@ -1351,11 +1325,11 @@ p_assign_static(void)
Functor f = FunctorOfTerm(t1); Functor f = FunctorOfTerm(t1);
/* store the terms to visit */ /* store the terms to visit */
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_ARRAY,t1,"update_array"); _YAP_Error(TYPE_ERROR_ARRAY,t1,"update_array");
return(FALSE); return(FALSE);
} }
if (indx > 0 && indx > ArityOfFunctor(f)) { if (indx > 0 && indx > ArityOfFunctor(f)) {
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array"); _YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"update_array");
return(FALSE); return(FALSE);
} }
ptr = RepAppl(t1)+indx+1; ptr = RepAppl(t1)+indx+1;
@ -1363,11 +1337,11 @@ p_assign_static(void)
MaBind(ptr, t3); MaBind(ptr, t3);
return(TRUE); return(TRUE);
#else #else
Error(SYSTEM_ERROR,t2,"update_array"); _YAP_Error(SYSTEM_ERROR,t2,"update_array");
return(FALSE); return(FALSE);
#endif #endif
} else { } else {
Error(TYPE_ERROR_ATOM,t1,"update_array"); _YAP_Error(TYPE_ERROR_ATOM,t1,"update_array");
return(FALSE); return(FALSE);
} }
} }
@ -1382,7 +1356,7 @@ p_assign_static(void)
} }
if (EndOfPAEntr(ptr)) { if (EndOfPAEntr(ptr)) {
Error(EXISTENCE_ERROR_ARRAY,t1,"assign_static %s", RepAtom(AtomOfTerm(t1))->StrOfAE); _YAP_Error(EXISTENCE_ERROR_ARRAY,t1,"assign_static %s", RepAtom(AtomOfTerm(t1))->StrOfAE);
return(FALSE); return(FALSE);
} }
@ -1391,7 +1365,7 @@ p_assign_static(void)
ArrayEntry *pp = (ArrayEntry *)ptr; ArrayEntry *pp = (ArrayEntry *)ptr;
CELL *pt; CELL *pt;
if (indx < 0 || indx >= pp->ArrayEArity) { if (indx < 0 || indx >= pp->ArrayEArity) {
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static"); _YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
READ_UNLOCK(((ArrayEntry *)ptr)->ArRWLock); READ_UNLOCK(((ArrayEntry *)ptr)->ArRWLock);
return(FALSE); return(FALSE);
} }
@ -1402,7 +1376,7 @@ p_assign_static(void)
MaBind(pt, t3); MaBind(pt, t3);
return(TRUE); return(TRUE);
#else #else
Error(SYSTEM_ERROR,t2,"update_array"); _YAP_Error(SYSTEM_ERROR,t2,"update_array");
return(FALSE); return(FALSE);
#endif #endif
} }
@ -1410,12 +1384,12 @@ p_assign_static(void)
/* a static array */ /* a static array */
if (IsVarTerm(t3)) { if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(INSTANTIATION_ERROR,t3,"assign_static"); _YAP_Error(INSTANTIATION_ERROR,t3,"assign_static");
return (FALSE); return (FALSE);
} }
if (indx < 0 || indx >= - ptr->ArrayEArity) { if (indx < 0 || indx >= - ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static"); _YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return(FALSE); return(FALSE);
} }
switch (ptr->ArrayType) { switch (ptr->ArrayType) {
@ -1426,11 +1400,11 @@ p_assign_static(void)
if (IsIntTerm(t3)) if (IsIntTerm(t3))
i = IntOfTerm(t3); i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e) else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int; i = v.Int;
else { else {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_INTEGER,t3,"assign_static"); _YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.ints[indx]= i; ptr->ValueOfVE.ints[indx]= i;
@ -1444,15 +1418,15 @@ p_assign_static(void)
if (IsIntTerm(t3)) if (IsIntTerm(t3))
i = IntOfTerm(t3); i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e) else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int; i = v.Int;
else { else {
Error(TYPE_ERROR_INTEGER,t3,"assign_static"); _YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE); return (FALSE);
} }
if (i > 127 || i < -128) { if (i > 127 || i < -128) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_BYTE,t3,"assign_static"); _YAP_Error(TYPE_ERROR_BYTE,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.chars[indx]= i; ptr->ValueOfVE.chars[indx]= i;
@ -1466,16 +1440,16 @@ p_assign_static(void)
if (IsIntTerm(t3)) if (IsIntTerm(t3))
i = IntOfTerm(t3); i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e) else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int; i = v.Int;
else { else {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_INTEGER,t3,"assign_static"); _YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE); return (FALSE);
} }
if (i > 255 || i < 0) { if (i > 255 || i < 0) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_UBYTE,t3,"assign_static"); _YAP_Error(TYPE_ERROR_UBYTE,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.chars[indx]= i; ptr->ValueOfVE.chars[indx]= i;
@ -1489,11 +1463,11 @@ p_assign_static(void)
if (IsFloatTerm(t3)) if (IsFloatTerm(t3))
f = FloatOfTerm(t3); f = FloatOfTerm(t3);
else if (Eval(t3, &v) == double_e) else if (_YAP_Eval(t3, &v) == double_e)
f = v.dbl; f = v.dbl;
else { else {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_FLOAT,t3,"assign_static"); _YAP_Error(TYPE_ERROR_FLOAT,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.floats[indx]= f; ptr->ValueOfVE.floats[indx]= f;
@ -1508,7 +1482,7 @@ p_assign_static(void)
r = IntegerOfTerm(t3); r = IntegerOfTerm(t3);
else { else {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_PTR,t3,"assign_static"); _YAP_Error(TYPE_ERROR_PTR,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.ptrs[indx]= (AtomEntry *)r; ptr->ValueOfVE.ptrs[indx]= (AtomEntry *)r;
@ -1519,7 +1493,7 @@ p_assign_static(void)
{ {
if (!IsAtomTerm(t3)) { if (!IsAtomTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_ATOM,t3,"assign_static"); _YAP_Error(TYPE_ERROR_ATOM,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.atoms[indx]= t3; ptr->ValueOfVE.atoms[indx]= t3;
@ -1533,7 +1507,7 @@ p_assign_static(void)
if (!IsDBRefTerm(t3)) { if (!IsDBRefTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_DBREF,t3,"assign_static"); _YAP_Error(TYPE_ERROR_DBREF,t3,"assign_static");
return (FALSE); return (FALSE);
} }
ptr->ValueOfVE.dbrefs[indx]= t3; ptr->ValueOfVE.dbrefs[indx]= t3;
@ -1549,9 +1523,9 @@ p_assign_static(void)
DBRef ref = ptr->ValueOfVE.terms[indx]; DBRef ref = ptr->ValueOfVE.terms[indx];
if (ref != NULL) { if (ref != NULL) {
ReleaseTermFromDB(ref); _YAP_ReleaseTermFromDB(ref);
} }
ptr->ValueOfVE.terms[indx] = StoreTermInDB(3,3); ptr->ValueOfVE.terms[indx] = _YAP_StoreTermInDB(3,3);
if (ptr->ValueOfVE.terms[indx] == NULL){ if (ptr->ValueOfVE.terms[indx] == NULL){
WRITE_UNLOCK(ptr->ArRWLock); WRITE_UNLOCK(ptr->ArRWLock);
return(FALSE); return(FALSE);
@ -1563,9 +1537,6 @@ p_assign_static(void)
return(TRUE); return(TRUE);
} }
int compile_arrays = FALSE;
static Int static Int
p_compile_array_refs(void) p_compile_array_refs(void)
{ {
@ -1593,20 +1564,20 @@ p_sync_mmapped_arrays(void)
} }
void void
InitArrayPreds(void) _YAP_InitArrayPreds(void)
{ {
InitCPred("$create_array", 2, p_create_array, SyncPredFlag); _YAP_InitCPred("$create_array", 2, p_create_array, SyncPredFlag);
InitCPred("$array_references", 3, p_array_references, SafePredFlag); _YAP_InitCPred("$array_references", 3, p_array_references, SafePredFlag);
InitCPred("$array_arg", 3, p_array_arg, SafePredFlag); _YAP_InitCPred("$array_arg", 3, p_array_arg, SafePredFlag);
InitCPred("static_array", 3, p_create_static_array, SafePredFlag|SyncPredFlag); _YAP_InitCPred("static_array", 3, p_create_static_array, SafePredFlag|SyncPredFlag);
InitCPred("resize_static_array", 3, p_resize_static_array, SafePredFlag|SyncPredFlag); _YAP_InitCPred("resize_static_array", 3, p_resize_static_array, SafePredFlag|SyncPredFlag);
InitCPred("mmapped_array", 4, p_create_mmapped_array, SafePredFlag|SyncPredFlag); _YAP_InitCPred("mmapped_array", 4, p_create_mmapped_array, SafePredFlag|SyncPredFlag);
InitCPred("update_array", 3, p_assign_static, SafePredFlag); _YAP_InitCPred("update_array", 3, p_assign_static, SafePredFlag);
InitCPred("array_element", 3, p_access_array, 0); _YAP_InitCPred("array_element", 3, p_access_array, 0);
InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag); _YAP_InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag); _YAP_InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag);
InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag); _YAP_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag);
InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag); _YAP_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag);
InitCPred("$has_static_array", 1, p_has_static_array, TestPredFlag|SafePredFlag); _YAP_InitCPred("$has_static_array", 1, p_has_static_array, TestPredFlag|SafePredFlag);
} }

114
C/attvar.c
View File

@ -44,15 +44,15 @@ AddToQueue(attvar_record *attv)
t[0] = (CELL)&(attv->Done); t[0] = (CELL)&(attv->Done);
t[1] = attv->Value; t[1] = attv->Value;
/* follow the chain */ /* follow the chain */
WGs = (sus_record *)ReadTimedVar(WokenGoals); WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
new = (sus_record *)H; new = (sus_record *)H;
H = (CELL *)(new+1); H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR)); new->NR = (sus_record *)(&(new->NR));
new->SG = MkApplTerm(FunctorAttGoal, 2, t); new->SG = _YAP_MkApplTerm(FunctorAttGoal, 2, t);
new->NS = new; new->NS = new;
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)new); _YAP_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0)) if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0); CreepFlag = Unsigned(LCL0);
@ -71,7 +71,7 @@ AddFailToQueue(void)
sus_record *new; sus_record *new;
/* follow the chain */ /* follow the chain */
WGs = (sus_record *)ReadTimedVar(WokenGoals); WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
new = (sus_record *)H; new = (sus_record *)H;
H = (CELL *)(new+1); H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR)); new->NR = (sus_record *)(&(new->NR));
@ -79,7 +79,7 @@ AddFailToQueue(void)
new->NS = new; new->NS = new;
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)new); _YAP_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */ /* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0)) if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0); CreepFlag = Unsigned(LCL0);
@ -101,13 +101,13 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
Int j; Int j;
/* add a new attributed variable */ /* add a new attributed variable */
newv = (attvar_record *)ReadTimedVar(DelayedVars); newv = (attvar_record *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)newv < 1024+(2*NUM_OF_ATTS)) if (H0 - (CELL *)newv < 1024+(2*NUM_OF_ATTS))
return(FALSE); return(FALSE);
RESET_VARIABLE(&(newv->Done)); RESET_VARIABLE(&(newv->Done));
newv->sus_id = attvars_ext; newv->sus_id = attvars_ext;
RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Value));
newv->NS = UpdateTimedVar(AttsMutableList, (CELL)&(newv->Done)); newv->NS = _YAP_UpdateTimedVar(AttsMutableList, (CELL)&(newv->Done));
for (j = 0; j < NUM_OF_ATTS; j++) { for (j = 0; j < NUM_OF_ATTS; j++) {
Term t = Deref(attv->Atts[2*j+1]); Term t = Deref(attv->Atts[2*j+1]);
newv->Atts[2*j] = time; newv->Atts[2*j] = time;
@ -135,7 +135,7 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
} }
*to_visit_ptr = to_visit; *to_visit_ptr = to_visit;
*res = (CELL)&(newv->Done); *res = (CELL)&(newv->Done);
UpdateTimedVar(DelayedVars, (CELL)(newv->Atts+2*j)); _YAP_UpdateTimedVar(DelayedVars, (CELL)(newv->Atts+2*j));
return(TRUE); return(TRUE);
} }
@ -177,14 +177,14 @@ WakeAttVar(CELL* pt1, CELL reg2)
/* binding two suspended variables, be careful */ /* binding two suspended variables, be careful */
if (susp2->sus_id != attvars_ext) { if (susp2->sus_id != attvars_ext) {
/* joining two different kinds of suspensions */ /* joining two different kinds of suspensions */
Error(SYSTEM_ERROR, TermNil, "joining two different suspensions not implemented"); _YAP_Error(SYSTEM_ERROR, TermNil, "joining two different suspensions not implemented");
return; return;
} }
if (susp2 >= attv) { if (susp2 >= attv) {
if (susp2 == attv) return; if (susp2 == attv) return;
if (!IsVarTerm(susp2->Value) || !IsUnboundVar(susp2->Value)) { if (!IsVarTerm(susp2->Value) || !IsUnboundVar(susp2->Value)) {
/* oops, our goal is on the queue to be woken */ /* oops, our goal is on the queue to be woken */
if (!unify(susp2->Value, (CELL)pt1)) { if (!_YAP_unify(susp2->Value, (CELL)pt1)) {
AddFailToQueue(); AddFailToQueue();
} }
} }
@ -199,7 +199,7 @@ WakeAttVar(CELL* pt1, CELL reg2)
} }
if (!IsVarTerm(attv->Value) || !IsUnboundVar(attv->Value)) { if (!IsVarTerm(attv->Value) || !IsUnboundVar(attv->Value)) {
/* oops, our goal is on the queue to be woken */ /* oops, our goal is on the queue to be woken */
if (!unify(attv->Value, reg2)) { if (!_YAP_unify(attv->Value, reg2)) {
AddFailToQueue(); AddFailToQueue();
} }
return; return;
@ -221,17 +221,17 @@ mark_attvar(CELL *orig)
register attvar_record *attv = (attvar_record *)orig; register attvar_record *attv = (attvar_record *)orig;
Int i; Int i;
mark_external_reference(&(attv->Value)); _YAP_mark_external_reference(&(attv->Value));
mark_external_reference(&(attv->Done)); _YAP_mark_external_reference(&(attv->Done));
for (i = 0; i < NUM_OF_ATTS; i++) { for (i = 0; i < NUM_OF_ATTS; i++) {
mark_external_reference(attv->Atts+2*i+1); _YAP_mark_external_reference(attv->Atts+2*i+1);
} }
} }
#if FROZEN_STACKS #if FROZEN_STACKS
static Term static Term
CurrentTime(void) { CurrentTime(void) {
return(MkIntegerTerm(TR-(tr_fr_ptr)TrailBase)); return(MkIntegerTerm(TR-(tr_fr_ptr)_YAP_TrailBase));
} }
#endif #endif
@ -244,7 +244,7 @@ InitVarTime(void) {
/* so we just init a TR cell that will not harm anyone */ /* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1)); Bind((CELL *)(TR+1),AbsAppl(H-1));
} }
return(MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase)); return(MkIntegerTerm(B->cp_tr-(tr_fr_ptr)_YAP_TrailBase));
#else #else
Term t = (CELL)H; Term t = (CELL)H;
*H++ = TermFoundVar; *H++ = TermFoundVar;
@ -256,7 +256,7 @@ static Int
PutAtt(attvar_record *attv, Int i, Term tatt) { PutAtt(attvar_record *attv, Int i, Term tatt) {
Int pos = i*2; Int pos = i*2;
#if FROZEN_STACKS #if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase+IntegerOfTerm(attv->Atts[pos]); tr_fr_ptr timestmp = (tr_fr_ptr)_YAP_TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp if (B->cp_tr <= timestmp
&& timestmp <= TR) { && timestmp <= TR) {
#if defined(SBA) #if defined(SBA)
@ -297,7 +297,7 @@ RmAtt(attvar_record *attv, Int i) {
Int pos = i *2; Int pos = i *2;
if (!IsVarTerm(attv->Atts[pos+1])) { if (!IsVarTerm(attv->Atts[pos+1])) {
#if FROZEN_STACKS #if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase+IntegerOfTerm(attv->Atts[pos]); tr_fr_ptr timestmp = (tr_fr_ptr)_YAP_TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp if (B->cp_tr <= timestmp
&& timestmp <= TR) { && timestmp <= TR) {
RESET_VARIABLE(attv->Atts+(pos+1)); RESET_VARIABLE(attv->Atts+(pos+1));
@ -344,13 +344,13 @@ BuildNewAttVar(Term t, Int i, Term tatt)
Term time; Term time;
int j; int j;
attvar_record *attv = (attvar_record *)ReadTimedVar(DelayedVars); attvar_record *attv = (attvar_record *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)attv < 1024+(2*NUM_OF_ATTS)) { if (H0 - (CELL *)attv < 1024+(2*NUM_OF_ATTS)) {
H[0] = t; H[0] = t;
H[1] = tatt; H[1] = tatt;
H += 2; H += 2;
if (!growglobal(NULL)) { if (!_YAP_growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage); _YAP_Error(SYSTEM_ERROR, t, _YAP_ErrorMessage);
return FALSE; return FALSE;
} }
H -= 2; H -= 2;
@ -365,9 +365,9 @@ BuildNewAttVar(Term t, Int i, Term tatt)
attv->Atts[2*j] = time; attv->Atts[2*j] = time;
RESET_VARIABLE(attv->Atts+2*j+1); RESET_VARIABLE(attv->Atts+2*j+1);
} }
attv->NS = UpdateTimedVar(AttsMutableList, (CELL)&(attv->Done)); attv->NS = _YAP_UpdateTimedVar(AttsMutableList, (CELL)&(attv->Done));
Bind((CELL *)t,(CELL)attv); Bind((CELL *)t,(CELL)attv);
UpdateTimedVar(DelayedVars,(CELL)(attv->Atts+2*j)); _YAP_UpdateTimedVar(DelayedVars,(CELL)(attv->Atts+2*j));
/* if i < 0 then we have the list of arguments */ /* if i < 0 then we have the list of arguments */
if (i < 0) { if (i < 0) {
Int j = 0; Int j = 0;
@ -408,7 +408,7 @@ BindAttVar(attvar_record *attv) {
Bind_Global(&(attv->Done), attv->Value); Bind_Global(&(attv->Done), attv->Value);
return(TRUE); return(TRUE);
} else { } else {
Error(SYSTEM_ERROR,(CELL)&(attv->Done),"attvar was bound when set"); _YAP_Error(SYSTEM_ERROR,(CELL)&(attv->Done),"attvar was bound when set");
return(FALSE); return(FALSE);
} }
} }
@ -437,8 +437,8 @@ AllAttVars(Term t) {
} }
Term Term
CurrentAttVars(void) { _YAP_CurrentAttVars(void) {
return(AllAttVars(ReadTimedVar(AttsMutableList))); return(AllAttVars(_YAP_ReadTimedVar(AttsMutableList)));
} }
@ -453,14 +453,14 @@ p_put_att(void) {
exts id = (exts)attv->sus_id; exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE); return(FALSE);
} }
return(PutAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3))); return(PutAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
} }
return(BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), Deref(ARG3))); return(BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE); return(FALSE);
} }
} }
@ -476,14 +476,14 @@ p_rm_att(void) {
exts id = (exts)attv->sus_id; exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
return(FALSE); return(FALSE);
} }
return(RmAtt(attv, IntegerOfTerm(Deref(ARG2)))); return(RmAtt(attv, IntegerOfTerm(Deref(ARG2))));
} }
return(TRUE); return(TRUE);
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
return(FALSE); return(FALSE);
} }
} }
@ -500,16 +500,16 @@ p_get_att(void) {
exts id = (exts)attv->sus_id; exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
out = GetAtt(attv,IntegerOfTerm(Deref(ARG2))); out = GetAtt(attv,IntegerOfTerm(Deref(ARG2)));
return(!IsVarTerm(out) && unify(ARG3,out)); return(!IsVarTerm(out) && _YAP_unify(ARG3,out));
} }
/* Error(INSTANTIATION_ERROR,inp,"get_att/2");*/ /* _YAP_Error(INSTANTIATION_ERROR,inp,"get_att/2");*/
return(FALSE); return(FALSE);
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
} }
@ -525,14 +525,14 @@ p_free_att(void) {
exts id = (exts)attv->sus_id; exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
return(FreeAtt(attv,IntegerOfTerm(Deref(ARG2)))); return(FreeAtt(attv,IntegerOfTerm(Deref(ARG2))));
} }
return(TRUE); return(TRUE);
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"free_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"free_att/2");
return(FALSE); return(FALSE);
} }
} }
@ -548,14 +548,14 @@ p_bind_attvar(void) {
exts id = (exts)attv->sus_id; exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
return(BindAttVar(attv)); return(BindAttVar(attv));
} }
return(TRUE); return(TRUE);
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"bind_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"bind_att/2");
return(FALSE); return(FALSE);
} }
} }
@ -571,14 +571,14 @@ p_get_all_atts(void) {
exts id = (exts)(attv->sus_id); exts id = (exts)(attv->sus_id);
if (id != attvars_ext) { if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
return(unify(ARG2,GetAllAtts(attv))); return(_YAP_unify(ARG2,GetAllAtts(attv)));
} }
return(TRUE); return(TRUE);
} else { } else {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); _YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE); return(FALSE);
} }
} }
@ -588,21 +588,21 @@ p_inc_atts(void)
{ {
Term t = MkIntegerTerm(NUM_OF_ATTS); Term t = MkIntegerTerm(NUM_OF_ATTS);
NUM_OF_ATTS++; NUM_OF_ATTS++;
return(unify(ARG1,t)); return(_YAP_unify(ARG1,t));
} }
static Int static Int
p_n_atts(void) p_n_atts(void)
{ {
Term t = MkIntegerTerm(NUM_OF_ATTS); Term t = MkIntegerTerm(NUM_OF_ATTS);
return(unify(ARG1,t)); return(_YAP_unify(ARG1,t));
} }
static Int static Int
p_all_attvars(void) p_all_attvars(void)
{ {
Term t = ReadTimedVar(AttsMutableList); Term t = _YAP_ReadTimedVar(AttsMutableList);
return(unify(ARG1,AllAttVars(t))); return(_YAP_unify(ARG1,AllAttVars(t)));
} }
static Int static Int
@ -625,24 +625,24 @@ p_attvar_bound(void)
!IsUnboundVar(((attvar_record *)VarOfTerm(t))->Done)); !IsUnboundVar(((attvar_record *)VarOfTerm(t))->Done));
} }
void InitAttVarPreds(void) void _YAP_InitAttVarPreds(void)
{ {
attas[attvars_ext].bind_op = WakeAttVar; attas[attvars_ext].bind_op = WakeAttVar;
attas[attvars_ext].copy_term_op = CopyAttVar; attas[attvars_ext].copy_term_op = CopyAttVar;
attas[attvars_ext].to_term_op = AttVarToTerm; attas[attvars_ext].to_term_op = AttVarToTerm;
attas[attvars_ext].term_to_op = TermToAttVar; attas[attvars_ext].term_to_op = TermToAttVar;
attas[attvars_ext].mark_op = mark_attvar; attas[attvars_ext].mark_op = mark_attvar;
InitCPred("get_att", 3, p_get_att, SafePredFlag); _YAP_InitCPred("get_att", 3, p_get_att, SafePredFlag);
InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag); _YAP_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
InitCPred("free_att", 2, p_free_att, SafePredFlag); _YAP_InitCPred("free_att", 2, p_free_att, SafePredFlag);
InitCPred("put_att", 3, p_put_att, 0); _YAP_InitCPred("put_att", 3, p_put_att, 0);
InitCPred("rm_att", 2, p_rm_att, SafePredFlag); _YAP_InitCPred("rm_att", 2, p_rm_att, SafePredFlag);
InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag); _YAP_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag);
InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag); _YAP_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag); _YAP_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag); _YAP_InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag); _YAP_InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag); _YAP_InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
} }
#endif /* COROUTINING */ #endif /* COROUTINING */

72
C/bb.c
View File

@ -38,10 +38,10 @@ PutBBProp(AtomEntry *ae, SMALLUNSGN mod) /* get BBentry for at; */
p = RepBBProp(p0 = p->NextOfPE); p = RepBBProp(p0 = p->NextOfPE);
} }
if (p0 == NIL) { if (p0 == NIL) {
p = (BBProp)AllocAtomSpace(sizeof(*p)); p = (BBProp)_YAP_AllocAtomSpace(sizeof(*p));
if (p == NULL) { if (p == NULL) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2"); _YAP_Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
return(NULL); return(NULL);
} }
p->NextOfPE = ae->PropsOfAE; p->NextOfPE = ae->PropsOfAE;
@ -64,7 +64,7 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
UInt hash_key; UInt hash_key;
if (INT_BB_KEYS == NULL) { if (INT_BB_KEYS == NULL) {
INT_BB_KEYS = (Prop *)AllocCodeSpace(sizeof(Prop)*INT_BB_KEYS_SIZE); INT_BB_KEYS = (Prop *)_YAP_AllocCodeSpace(sizeof(Prop)*INT_BB_KEYS_SIZE);
if (INT_BB_KEYS != NULL) { if (INT_BB_KEYS != NULL) {
UInt i = 0; UInt i = 0;
Prop *pp = INT_BB_KEYS; Prop *pp = INT_BB_KEYS;
@ -73,7 +73,7 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
pp++; pp++;
} }
} else { } else {
Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2"); _YAP_Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
return(NULL); return(NULL);
} }
} }
@ -87,10 +87,10 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
} }
if (p0 == NIL) { if (p0 == NIL) {
YAPEnterCriticalSection(); YAPEnterCriticalSection();
p = (BBProp)AllocAtomSpace(sizeof(*p)); p = (BBProp)_YAP_AllocAtomSpace(sizeof(*p));
if (p == NULL) { if (p == NULL) {
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2"); _YAP_Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
return(NULL); return(NULL);
} }
p->ModuleOfBB = mod; p->ModuleOfBB = mod;
@ -157,10 +157,10 @@ resize_bb_int_keys(UInt new_size) {
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
return(TRUE); return(TRUE);
} }
new = (Prop *)AllocCodeSpace(sizeof(Prop)*new_size); new = (Prop *)_YAP_AllocCodeSpace(sizeof(Prop)*new_size);
if (new == NULL) { if (new == NULL) {
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
Error(SYSTEM_ERROR,ARG1,"could not allocate space"); _YAP_Error(SYSTEM_ERROR,ARG1,"could not allocate space");
return(FALSE); return(FALSE);
} }
for (i = 0; i < new_size; i++) { for (i = 0; i < new_size; i++) {
@ -179,7 +179,7 @@ resize_bb_int_keys(UInt new_size) {
} }
} }
} }
FreeCodeSpace((char *)INT_BB_KEYS); _YAP_FreeCodeSpace((char *)INT_BB_KEYS);
INT_BB_KEYS = new; INT_BB_KEYS = new;
INT_BB_KEYS_SIZE = new_size; INT_BB_KEYS_SIZE = new_size;
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
@ -193,7 +193,7 @@ AddBBProp(Term t1, char *msg, SMALLUNSGN mod)
restart: restart:
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, msg); _YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL); return(NULL);
} if (IsAtomTerm(t1)) { } if (IsAtomTerm(t1)) {
p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod); p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod);
@ -203,14 +203,14 @@ AddBBProp(Term t1, char *msg, SMALLUNSGN mod)
Term tmod = ArgOfTerm(1, t1); Term tmod = ArgOfTerm(1, t1);
if (!IsVarTerm(tmod) ) { if (!IsVarTerm(tmod) ) {
t1 = ArgOfTerm(2, t1); t1 = ArgOfTerm(2, t1);
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
goto restart; goto restart;
} else { } else {
Error(INSTANTIATION_ERROR, t1, msg); _YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL); return(NULL);
} }
} else { } else {
Error(TYPE_ERROR_ATOM, t1, msg); _YAP_Error(TYPE_ERROR_ATOM, t1, msg);
return(NULL); return(NULL);
} }
return(p); return(p);
@ -223,7 +223,7 @@ FetchBBProp(Term t1, char *msg, SMALLUNSGN mod)
restart: restart:
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, msg); _YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL); return(NULL);
} if (IsAtomTerm(t1)) { } if (IsAtomTerm(t1)) {
p = GetBBProp(RepAtom(AtomOfTerm(t1)), mod); p = GetBBProp(RepAtom(AtomOfTerm(t1)), mod);
@ -232,15 +232,15 @@ FetchBBProp(Term t1, char *msg, SMALLUNSGN mod)
} else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) { } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
Term tmod = ArgOfTerm(1, t1); Term tmod = ArgOfTerm(1, t1);
if (!IsVarTerm(tmod) ) { if (!IsVarTerm(tmod) ) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t1 = ArgOfTerm(2, t1); t1 = ArgOfTerm(2, t1);
goto restart; goto restart;
} else { } else {
Error(INSTANTIATION_ERROR, t1, msg); _YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL); return(NULL);
} }
} else { } else {
Error(TYPE_ERROR_ATOM, t1, msg); _YAP_Error(TYPE_ERROR_ATOM, t1, msg);
return(NULL); return(NULL);
} }
return(p); return(p);
@ -255,9 +255,9 @@ p_bb_put(void)
return(FALSE); return(FALSE);
WRITE_LOCK(p->BBRWLock); WRITE_LOCK(p->BBRWLock);
if (p->Element != NULL) { if (p->Element != NULL) {
ReleaseTermFromDB(p->Element); _YAP_ReleaseTermFromDB(p->Element);
} }
p->Element = StoreTermInDB(2,2); p->Element = _YAP_StoreTermInDB(2,2);
WRITE_UNLOCK(p->BBRWLock); WRITE_UNLOCK(p->BBRWLock);
return(p->Element != NULL); return(p->Element != NULL);
} }
@ -271,9 +271,9 @@ p_bb_get(void)
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
READ_LOCK(p->BBRWLock); READ_LOCK(p->BBRWLock);
out = FetchTermFromDB(p->Element,3); out = _YAP_FetchTermFromDB(p->Element,3);
READ_UNLOCK(p->BBRWLock); READ_UNLOCK(p->BBRWLock);
return(unify(ARG2,out)); return(_YAP_unify(ARG2,out));
} }
static Int static Int
@ -286,12 +286,12 @@ p_bb_delete(void)
p = FetchBBProp(t1, "bb_delete/2", CurrentModule); p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
out = FetchTermFromDB(p->Element,3); out = _YAP_FetchTermFromDB(p->Element,3);
WRITE_LOCK(p->BBRWLock); WRITE_LOCK(p->BBRWLock);
ReleaseTermFromDB(p->Element); _YAP_ReleaseTermFromDB(p->Element);
p->Element = NULL; p->Element = NULL;
WRITE_UNLOCK(p->BBRWLock); WRITE_UNLOCK(p->BBRWLock);
return(unify(ARG2,out)); return(_YAP_unify(ARG2,out));
} }
static Int static Int
@ -305,14 +305,14 @@ p_bb_update(void)
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
WRITE_LOCK(p->BBRWLock); WRITE_LOCK(p->BBRWLock);
out = FetchTermFromDB(p->Element,3); out = _YAP_FetchTermFromDB(p->Element,3);
if (!unify(ARG2,out)) { if (!_YAP_unify(ARG2,out)) {
WRITE_UNLOCK(p->BBRWLock); WRITE_UNLOCK(p->BBRWLock);
return(FALSE); return(FALSE);
} }
ReleaseTermFromDB(p->Element); _YAP_ReleaseTermFromDB(p->Element);
p->Element = StoreTermInDB(3,3); p->Element = _YAP_StoreTermInDB(3,3);
WRITE_UNLOCK(p->BBRWLock); WRITE_UNLOCK(p->BBRWLock);
return(p->Element != NULL); return(p->Element != NULL);
} }
@ -322,22 +322,22 @@ p_resize_bb_int_keys(void)
{ {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
return(unify(ARG1,MkIntegerTerm((Int)INT_BB_KEYS_SIZE))); return(_YAP_unify(ARG1,MkIntegerTerm((Int)INT_BB_KEYS_SIZE)));
} }
if (!IsIntegerTerm(t1)) { if (!IsIntegerTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1, "yap_flag(resize_bb_int_keys,T)"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "yap_flag(resize_bb_int_keys,T)");
return(FALSE); return(FALSE);
} }
return(resize_bb_int_keys(IntegerOfTerm(t1))); return(resize_bb_int_keys(IntegerOfTerm(t1)));
} }
void void
InitBBPreds(void) _YAP_InitBBPreds(void)
{ {
InitCPred("bb_put", 2, p_bb_put, 0); _YAP_InitCPred("bb_put", 2, p_bb_put, 0);
InitCPred("bb_get", 2, p_bb_get, 0); _YAP_InitCPred("bb_get", 2, p_bb_get, 0);
InitCPred("bb_delete", 2, p_bb_delete, 0); _YAP_InitCPred("bb_delete", 2, p_bb_delete, 0);
InitCPred("bb_update", 3, p_bb_update, 0); _YAP_InitCPred("bb_update", 3, p_bb_update, 0);
InitCPred("$resize_bb_int_keys", 1, p_resize_bb_int_keys, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$resize_bb_int_keys", 1, p_resize_bb_int_keys, SafePredFlag|SyncPredFlag);
} }

18
C/bignum.c
View File

@ -35,7 +35,7 @@ static char SccsId[] = "%W% %G%";
static CELL *pre_alloc_base = NULL, *alloc_ptr; static CELL *pre_alloc_base = NULL, *alloc_ptr;
MP_INT * MP_INT *
PreAllocBigNum(void) _YAP_PreAllocBigNum(void)
{ {
MP_INT *ret; MP_INT *ret;
@ -54,14 +54,14 @@ PreAllocBigNum(void)
} }
void void
CleanBigNum(void) _YAP_CleanBigNum(void)
{ {
H = pre_alloc_base; H = pre_alloc_base;
pre_alloc_base = NULL; pre_alloc_base = NULL;
} }
MP_INT * MP_INT *
InitBigNum(Int in) _YAP_InitBigNum(Int in)
{ {
MP_INT *ret; MP_INT *ret;
@ -99,7 +99,7 @@ AllocBigNumSpace(size_t size)
alloc_ptr[0] = size; alloc_ptr[0] = size;
alloc_ptr += size+1; alloc_ptr += size+1;
if (alloc_ptr > ASP-1024) if (alloc_ptr > ASP-1024)
Error(SYSTEM_ERROR,TermNil,"no space for bignum"); _YAP_Error(SYSTEM_ERROR,TermNil,"no space for bignum");
return(ret); return(ret);
} }
@ -117,7 +117,7 @@ ReAllocBigNumSpace(void *optr, size_t osize, size_t size)
alloc_ptr += (size-osize); alloc_ptr += (size-osize);
((CELL *)optr)[-1] = size; ((CELL *)optr)[-1] = size;
if (alloc_ptr > ASP-1024) if (alloc_ptr > ASP-1024)
Error(SYSTEM_ERROR,TermNil,"no space for bignum"); _YAP_Error(SYSTEM_ERROR,TermNil,"no space for bignum");
return(optr); return(optr);
} }
out = AllocBigNumSpace(size); out = AllocBigNumSpace(size);
@ -154,7 +154,7 @@ FreeBigNumSpace(void *optr, size_t size)
pre_alloc_base; pre_alloc_base;
*/ */
Term Term
MkBigIntTerm(MP_INT *big) _YAP_MkBigIntTerm(MP_INT *big)
{ {
CELL *new = (CELL *)(big+1); CELL *new = (CELL *)(big+1);
Int nlimbs = (big->_mp_alloc)*(sizeof(mp_limb_t)/CellSize); Int nlimbs = (big->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
@ -198,7 +198,7 @@ MkBigIntTerm(MP_INT *big)
} }
MP_INT * MP_INT *
BigIntOfTerm(Term t) _YAP_BigIntOfTerm(Term t)
{ {
MP_INT *new = (MP_INT *)(RepAppl(t)+1); MP_INT *new = (MP_INT *)(RepAppl(t)+1);
@ -220,7 +220,7 @@ p_is_bignum(void)
} }
void void
InitBigNums(void) _YAP_InitBigNums(void)
{ {
#ifdef USE_GMP #ifdef USE_GMP
/* YAP style memory allocation */ /* YAP style memory allocation */
@ -229,5 +229,5 @@ InitBigNums(void)
ReAllocBigNumSpace, ReAllocBigNumSpace,
FreeBigNumSpace); FreeBigNumSpace);
#endif #endif
InitCPred("$bignum", 1, p_is_bignum, SafePredFlag); _YAP_InitCPred("$bignum", 1, p_is_bignum, SafePredFlag);
} }

131
C/c_interface.c
View File

@ -262,7 +262,7 @@ YAP_AtomName(Atom a)
X_API Atom X_API Atom
YAP_LookupAtom(char *c) YAP_LookupAtom(char *c)
{ {
return(LookupAtom(c)); return(_YAP_LookupAtom(c));
} }
X_API Atom X_API Atom
@ -270,7 +270,7 @@ YAP_FullLookupAtom(char *c)
{ {
Atom at; Atom at;
at = FullLookupAtom(c); at = _YAP_FullLookupAtom(c);
return(at); return(at);
} }
@ -304,7 +304,7 @@ YAP_MkNewPairTerm()
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = MkNewPairTerm(); t = _YAP_MkNewPairTerm();
RECOVER_H(); RECOVER_H();
return(t); return(t);
@ -328,7 +328,7 @@ YAP_MkApplTerm(Functor f,unsigned long int arity, Term args[])
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = MkApplTerm(f, arity, args); t = _YAP_MkApplTerm(f, arity, args);
RECOVER_H(); RECOVER_H();
return(t); return(t);
@ -340,7 +340,7 @@ YAP_MkNewApplTerm(Functor f,unsigned long int arity)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = MkNewApplTerm(f, arity); t = _YAP_MkNewApplTerm(f, arity);
RECOVER_H(); RECOVER_H();
return(t); return(t);
@ -364,7 +364,7 @@ YAP_ArgOfTerm(Int n, Term t)
X_API Functor X_API Functor
YAP_MkFunctor(Atom a, Int n) YAP_MkFunctor(Atom a, Int n)
{ {
return (MkFunctor(a, n)); return (_YAP_MkFunctor(a, n));
} }
X_API Atom X_API Atom
@ -422,7 +422,7 @@ YAP_Unify(Term t1, Term t2)
Int out; Int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
out = unify(t1, t2); out = _YAP_unify(t1, t2);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return(out); return(out);
@ -573,10 +573,10 @@ YAP_CallProlog(Term t)
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (IsVarTerm(tmod)) return(FALSE); if (IsVarTerm(tmod)) return(FALSE);
if (!IsAtomTerm(tmod)) return(FALSE); if (!IsAtomTerm(tmod)) return(FALSE);
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
} }
out = execute_goal(t, 0, mod); out = _YAP_execute_goal(t, 0, mod);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return(out); return(out);
} }
@ -587,9 +587,9 @@ YAP_AllocSpaceFromYap(unsigned int size)
void *ptr; void *ptr;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
if ((ptr = AllocCodeSpace(size)) == NULL) { if ((ptr = _YAP_AllocCodeSpace(size)) == NULL) {
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(NULL); return(NULL);
} }
} }
@ -601,7 +601,7 @@ YAP_AllocSpaceFromYap(unsigned int size)
X_API void X_API void
YAP_FreeSpaceFromYap(void *ptr) YAP_FreeSpaceFromYap(void *ptr)
{ {
FreeCodeSpace(ptr); _YAP_FreeCodeSpace(ptr);
} }
/* copy a string to a buffer */ /* copy a string to a buffer */
@ -616,15 +616,15 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
Head = HeadOfTerm(t); Head = HeadOfTerm(t);
if (IsVarTerm(Head)) { if (IsVarTerm(Head)) {
Error(INSTANTIATION_ERROR,Head,"user defined procedure"); _YAP_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
return(FALSE); return(FALSE);
} else if (!IsIntTerm(Head)) { } else if (!IsIntTerm(Head)) {
Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure"); _YAP_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return(FALSE); return(FALSE);
} }
i = IntOfTerm(Head); i = IntOfTerm(Head);
if (i < 0 || i > 255) { if (i < 0 || i > 255) {
Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure"); _YAP_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
return(FALSE); return(FALSE);
} }
buf[j++] = i; buf[j++] = i;
@ -634,10 +634,10 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
} }
t = TailOfTerm(t); t = TailOfTerm(t);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"user defined procedure"); _YAP_Error(INSTANTIATION_ERROR,t,"user defined procedure");
return(FALSE); return(FALSE);
} else if (!IsPairTerm(t) && t != TermNil) { } else if (!IsPairTerm(t) && t != TermNil) {
Error(TYPE_ERROR_LIST, t, "user defined procedure"); _YAP_Error(TYPE_ERROR_LIST, t, "user defined procedure");
return(FALSE); return(FALSE);
} }
} }
@ -653,7 +653,7 @@ YAP_BufferToString(char *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = StringToList(s); t = _YAP_StringToList(s);
RECOVER_H(); RECOVER_H();
return(t); return(t);
@ -666,7 +666,7 @@ YAP_BufferToAtomList(char *s)
Term t; Term t;
BACKUP_H(); BACKUP_H();
t = StringToListOfAtoms(s); t = _YAP_StringToListOfAtoms(s);
RECOVER_H(); RECOVER_H();
return(t); return(t);
@ -676,7 +676,7 @@ YAP_BufferToAtomList(char *s)
X_API void X_API void
YAP_Error(char *buf) YAP_Error(char *buf)
{ {
Error(SYSTEM_ERROR,TermNil,buf); _YAP_Error(SYSTEM_ERROR,TermNil,buf);
} }
static void myputc (int ch) static void myputc (int ch)
@ -691,7 +691,7 @@ YAP_RunGoal(Term t)
yamop *old_CP = CP; yamop *old_CP = CP;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
out = RunTopGoal(t); out = _YAP_RunTopGoal(t);
if (out) { if (out) {
P = (yamop *)ENV[E_CP]; P = (yamop *)ENV[E_CP];
ENV = (CELL *)ENV[E_E]; ENV = (CELL *)ENV[E_E];
@ -713,10 +713,10 @@ YAP_RestartGoal(void)
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
do_putcf = myputc; do_putcf = myputc;
out = exec_absmi(TRUE); out = _YAP_exec_absmi(TRUE);
if (out == FALSE) { if (out == FALSE) {
/* cleanup */ /* cleanup */
trust_last(); _YAP_trust_last();
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
@ -729,7 +729,7 @@ YAP_ContinueGoal(void)
int out; int out;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
out = exec_absmi(TRUE); out = _YAP_exec_absmi(TRUE);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return(out); return(out);
@ -767,9 +767,9 @@ YAP_InitConsult(int mode, char *filename)
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
if (mode == YAP_CONSULT_MODE) if (mode == YAP_CONSULT_MODE)
init_consult(FALSE, filename); _YAP_init_consult(FALSE, filename);
else else
init_consult(TRUE, filename); _YAP_init_consult(TRUE, filename);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -779,7 +779,7 @@ YAP_EndConsult(void)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
end_consult(); _YAP_end_consult();
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -794,14 +794,14 @@ YAP_Read(int (*mygetc)(void))
do_getf = mygetc; do_getf = mygetc;
old_TR = TR; old_TR = TR;
tokptr = toktide = tokenizer(do_yap_getc, do_yap_getc); _YAP_tokptr = _YAP_toktide = _YAP_tokenizer(do_yap_getc, do_yap_getc);
if (ErrorMessage) if (_YAP_ErrorMessage)
{ {
TR = old_TR; TR = old_TR;
save_machine_regs(); save_machine_regs();
return(0); return(0);
} }
t = Parse(); t = _YAP_Parse();
TR = old_TR; TR = old_TR;
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
@ -814,7 +814,7 @@ YAP_Write(Term t, void (*myputc)(int), int flags)
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
do_putcf = myputc; do_putcf = myputc;
plwrite (t, do_yap_putc, flags); _YAP_plwrite (t, do_yap_putc, flags);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
@ -822,22 +822,22 @@ YAP_Write(Term t, void (*myputc)(int), int flags)
X_API char * X_API char *
YAP_CompileClause(Term t) YAP_CompileClause(Term t)
{ {
char *ErrorMessage; char *_YAP_ErrorMessage;
CODEADDR codeaddr; CODEADDR codeaddr;
int mod = CurrentModule; int mod = CurrentModule;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
ARG1 = t; ARG1 = t;
codeaddr = cclause (t,0, mod); codeaddr = _YAP_cclause (t,0, mod);
if (codeaddr != NULL) { if (codeaddr != NULL) {
t = Deref(ARG1); /* just in case there was an heap overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */
addclause (t, codeaddr, TRUE, mod); _YAP_addclause (t, codeaddr, TRUE, mod);
} }
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return(ErrorMessage); return(_YAP_ErrorMessage);
} }
/* this routine is supposed to be called from an external program /* this routine is supposed to be called from an external program
@ -850,11 +850,11 @@ YAP_Init(YAP_init_args *yap_init)
CELL Trail = 0, Stack = 0, Heap = 0; CELL Trail = 0, Stack = 0, Heap = 0;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
yap_args = yap_init->Argv; _YAP_argv = yap_init->Argv;
yap_argc = yap_init->Argc; _YAP_argc = yap_init->Argc;
if (yap_init->SavedState != NULL || if (yap_init->SavedState != NULL ||
yap_init->YapPrologBootFile == NULL) { yap_init->YapPrologBootFile == NULL) {
if (SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) { if (_YAP_SavedInfo (yap_init->SavedState, yap_init->YapLibDir, &Trail, &Stack, &Heap) != 1) {
return(YAP_BOOT_FROM_SAVED_ERROR); return(YAP_BOOT_FROM_SAVED_ERROR);
} }
} }
@ -876,18 +876,19 @@ YAP_Init(YAP_init_args *yap_init)
} else { } else {
Heap = yap_init->HeapSize; Heap = yap_init->HeapSize;
} }
InitStacks (Heap, Stack, Trail,
_YAP_InitStacks (Heap, Stack, Trail,
yap_init->NumberWorkers, yap_init->NumberWorkers,
yap_init->SchedulerLoop, yap_init->SchedulerLoop,
yap_init->DelayedReleaseLoad yap_init->DelayedReleaseLoad
); );
InitYaamRegs(); _YAP_InitYaamRegs();
#if HAVE_MPI #if HAVE_MPI
InitMPI (); _YAP_InitMPI ();
#endif #endif
#if HAVE_MPE #if HAVE_MPE
InitMPE (); _YAP_InitMPE ();
#endif #endif
if (yap_init->YapPrologRCFile != NULL) { if (yap_init->YapPrologRCFile != NULL) {
@ -899,7 +900,7 @@ YAP_Init(YAP_init_args *yap_init)
} }
if (yap_init->SavedState != NULL || if (yap_init->SavedState != NULL ||
yap_init->YapPrologBootFile == NULL) { yap_init->YapPrologBootFile == NULL) {
restore_result = Restore(yap_init->SavedState, yap_init->YapLibDir); restore_result = _YAP_Restore(yap_init->SavedState, yap_init->YapLibDir);
} else { } else {
restore_result = FAIL_RESTORE; restore_result = FAIL_RESTORE;
} }
@ -917,12 +918,12 @@ YAP_Init(YAP_init_args *yap_init)
In the SBA we cannot just happily inherit registers In the SBA we cannot just happily inherit registers
from the other workers from the other workers
*/ */
InitYaamRegs(); _YAP_InitYaamRegs();
#endif #endif
/* slaves, waiting for work */ /* slaves, waiting for work */
CurrentModule = 1; CurrentModule = 1;
P = GETWORK_FIRST_TIME; P = GETWORK_FIRST_TIME;
exec_absmi(FALSE); _YAP_exec_absmi(FALSE);
abort_optyap("abstract machine unexpected exit"); abort_optyap("abstract machine unexpected exit");
} }
#endif /* YAPOR */ #endif /* YAPOR */
@ -930,7 +931,7 @@ YAP_Init(YAP_init_args *yap_init)
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
if (yap_init->YapPrologRCFile != NULL) { if (yap_init->YapPrologRCFile != NULL) {
PutValue(FullLookupAtom("$consult_on_boot"), MkAtomTerm(LookupAtom(yap_init->YapPrologRCFile))); _YAP_PutValue(_YAP_FullLookupAtom("$consult_on_boot"), MkAtomTerm(_YAP_LookupAtom(yap_init->YapPrologRCFile)));
/* /*
This must be done again after restore, as yap_flags This must be done again after restore, as yap_flags
has been overwritten .... has been overwritten ....
@ -976,13 +977,13 @@ YAP_FastInit(char saved_state[])
X_API void X_API void
YAP_PutValue(Atom at, Term t) YAP_PutValue(Atom at, Term t)
{ {
PutValue(at, t); _YAP_PutValue(at, t);
} }
X_API Term X_API Term
YAP_GetValue(Atom at) YAP_GetValue(Atom at)
{ {
return(GetValue(at)); return(_YAP_GetValue(at));
} }
X_API int X_API int
@ -995,11 +996,11 @@ YAP_Reset(void)
while (B->cp_b != NULL) while (B->cp_b != NULL)
B = B->cp_b; B = B->cp_b;
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
if (exec_absmi(0) != 0) if (_YAP_exec_absmi(0) != 0)
return(FALSE); return(FALSE);
} }
/* reinitialise the engine */ /* reinitialise the engine */
InitYaamRegs(); _YAP_InitYaamRegs();
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return(TRUE); return(TRUE);
@ -1008,14 +1009,14 @@ YAP_Reset(void)
X_API void X_API void
YAP_Exit(int retval) YAP_Exit(int retval)
{ {
exit_yap(retval); _YAP_exit(retval);
} }
X_API void X_API void
YAP_InitSocks(char *host, long port) YAP_InitSocks(char *host, long port)
{ {
#if USE_SOCKET #if USE_SOCKET
init_socks(host, port); _YAP_init_socks(host, port);
#endif #endif
} }
@ -1030,7 +1031,7 @@ YAP_SetOutputMessage(void)
X_API int X_API int
YAP_StreamToFileNo(Term t) YAP_StreamToFileNo(Term t)
{ {
return(StreamToFileNo(t)); return(_YAP_StreamToFileNo(t));
} }
X_API void X_API void
@ -1038,7 +1039,7 @@ YAP_CloseAllOpenStreams(void)
{ {
BACKUP_H(); BACKUP_H();
CloseStreams(FALSE); _YAP_CloseStreams(FALSE);
RECOVER_H(); RECOVER_H();
} }
@ -1050,7 +1051,7 @@ YAP_OpenStream(void *fh, char *name, Term nm, int flags)
BACKUP_H(); BACKUP_H();
retv = OpenStream((FILE *)fh, name, nm, flags); retv = _YAP_OpenStream((FILE *)fh, name, nm, flags);
RECOVER_H(); RECOVER_H();
return retv; return retv;
@ -1060,14 +1061,14 @@ X_API void
YAP_Throw(Term t) YAP_Throw(Term t)
{ {
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
JumpToEnv(t); _YAP_JumpToEnv(t);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
} }
X_API int X_API int
YAP_LookupModule(Term t) YAP_LookupModule(Term t)
{ {
return(LookupModule(t)); return(_YAP_LookupModule(t));
} }
X_API Term X_API Term
@ -1079,7 +1080,7 @@ YAP_ModuleName(int i)
X_API void X_API void
YAP_Halt(int i) YAP_Halt(int i)
{ {
exit_yap(i); _YAP_exit(i);
} }
X_API CELL * X_API CELL *
@ -1094,7 +1095,7 @@ YAP_Predicate(Atom a, unsigned long int arity, int m)
if (arity == 0) { if (arity == 0) {
return((void *)RepPredProp(PredPropByAtom(a,m))); return((void *)RepPredProp(PredPropByAtom(a,m)));
} else { } else {
Functor f = MkFunctor(a, arity); Functor f = _YAP_MkFunctor(a, arity);
return((void *)RepPredProp(PredPropByFunc(f,m))); return((void *)RepPredProp(PredPropByFunc(f,m)));
} }
} }
@ -1116,14 +1117,14 @@ YAP_PredicateInfo(void *p, Atom* a, unsigned long int* arity, int* m)
X_API void X_API void
YAP_UserCPredicate(char *name, CPredicate def, unsigned long int arity) YAP_UserCPredicate(char *name, CPredicate def, unsigned long int arity)
{ {
InitCPred(name, arity, def, UserCPredFlag); _YAP_InitCPred(name, arity, def, UserCPredFlag);
} }
X_API void X_API void
YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont, YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
unsigned long int arity, unsigned int extra) unsigned long int arity, unsigned int extra)
{ {
InitCPredBack(name, arity, extra, init, cont, UserCPredFlag); _YAP_InitCPredBack(name, arity, extra, init, cont, UserCPredFlag);
} }
X_API void X_API void
@ -1134,9 +1135,9 @@ YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, int m
CurrentModule = mod; CurrentModule = mod;
YAP_UserCPredicate(a,f,arity); YAP_UserCPredicate(a,f,arity);
if (arity == 0) { if (arity == 0) {
pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod)); pe = RepPredProp(PredPropByAtom(_YAP_LookupAtom(a),mod));
} else { } else {
Functor f = MkFunctor(LookupAtom(a), arity); Functor f = _YAP_MkFunctor(_YAP_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod)); pe = RepPredProp(PredPropByFunc(f,mod));
} }
pe->PredFlags |= CArgsPredFlag; pe->PredFlags |= CArgsPredFlag;

605
C/cdmgr.c
View File

File diff suppressed because it is too large Load Diff

153
C/cmppreds.c
View File

@ -98,7 +98,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = IntOfTerm(d0) - LongIntOfTerm(d1); out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP #ifdef USE_GMP
} else if (IsBigIntTerm(d1)) { } else if (IsBigIntTerm(d1)) {
out = -mpz_cmp_si(BigIntOfTerm(d1), IntOfTerm(d0)); out = -mpz_cmp_si(_YAP_BigIntOfTerm(d1), IntOfTerm(d0));
#endif #endif
} else if (IsRefTerm(d1)) } else if (IsRefTerm(d1))
out = 1 ; out = 1 ;
@ -124,7 +124,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = LongIntOfTerm(d0) - LongIntOfTerm(d1); out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP #ifdef USE_GMP
} else if (IsBigIntTerm(d1)) { } else if (IsBigIntTerm(d1)) {
out = -mpz_cmp_si(BigIntOfTerm(d1), LongIntOfTerm(d0)); out = -mpz_cmp_si(_YAP_BigIntOfTerm(d1), LongIntOfTerm(d0));
#endif #endif
} else if (IsRefTerm(d1)) { } else if (IsRefTerm(d1)) {
out = 1 ; out = 1 ;
@ -137,13 +137,13 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
#ifdef USE_GMP #ifdef USE_GMP
else if (IsBigIntTerm(d0)) { else if (IsBigIntTerm(d0)) {
if (IsIntTerm(d1)) if (IsIntTerm(d1))
out = mpz_cmp_si(BigIntOfTerm(d0), IntOfTerm(d1)); out = mpz_cmp_si(_YAP_BigIntOfTerm(d0), IntOfTerm(d1));
else if (IsFloatTerm(d1)) { else if (IsFloatTerm(d1)) {
out = 1; out = 1;
} else if (IsLongIntTerm(d1)) } else if (IsLongIntTerm(d1))
out = mpz_cmp_si(BigIntOfTerm(d0), LongIntOfTerm(d1)); out = mpz_cmp_si(_YAP_BigIntOfTerm(d0), LongIntOfTerm(d1));
else if (IsBigIntTerm(d1)) else if (IsBigIntTerm(d1))
out = mpz_cmp(BigIntOfTerm(d0), BigIntOfTerm(d1)); out = mpz_cmp(_YAP_BigIntOfTerm(d0), _YAP_BigIntOfTerm(d1));
else if (IsRefTerm(d1)) else if (IsRefTerm(d1))
out = 1 ; out = 1 ;
else out = -1; else out = -1;
@ -308,7 +308,7 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
return(IntOfTerm(t1) - LongIntOfTerm(t2)); return(IntOfTerm(t1) - LongIntOfTerm(t2));
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t2)) if (IsBigIntTerm(t2))
return(-mpz_cmp_si(BigIntOfTerm(t2),IntOfTerm(t1))); return(-mpz_cmp_si(_YAP_BigIntOfTerm(t2),IntOfTerm(t1)));
#endif #endif
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return (1); return (1);
@ -331,7 +331,7 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
return (LongIntOfTerm(t1) - LongIntOfTerm(t2)); return (LongIntOfTerm(t1) - LongIntOfTerm(t2));
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t2)) if (IsBigIntTerm(t2))
return(-mpz_cmp_si(BigIntOfTerm(t2), LongIntOfTerm(t1))); return(-mpz_cmp_si(_YAP_BigIntOfTerm(t2), LongIntOfTerm(t1)));
#endif #endif
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return (1); return (1);
@ -340,14 +340,14 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
#ifdef USE_GMP #ifdef USE_GMP
if (IsBigIntTerm(t1)) { if (IsBigIntTerm(t1)) {
if (IsIntTerm(t2)) if (IsIntTerm(t2))
return(mpz_cmp_si(BigIntOfTerm(t1), IntOfTerm(t2))); return(mpz_cmp_si(_YAP_BigIntOfTerm(t1), IntOfTerm(t2)));
if (IsFloatTerm(t2)) { if (IsFloatTerm(t2)) {
return(1); return(1);
} }
if (IsLongIntTerm(t2)) if (IsLongIntTerm(t2))
return(mpz_cmp_si(BigIntOfTerm(t1), LongIntOfTerm(t2))); return(mpz_cmp_si(_YAP_BigIntOfTerm(t1), LongIntOfTerm(t2)));
if (IsBigIntTerm(t2)) if (IsBigIntTerm(t2))
return(mpz_cmp(BigIntOfTerm(t1), BigIntOfTerm(t2))); return(mpz_cmp(_YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2)));
if (IsRefTerm(t2)) if (IsRefTerm(t2))
return(1); return(1);
return(-1); return(-1);
@ -400,12 +400,7 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
} }
} }
int iequ(register CELL d0, register CELL d1) int _YAP_compare_terms(register CELL d0, register CELL d1)
{
return (compare(d0,d1) == 0);
}
int compare_terms(register CELL d0, register CELL d1)
{ {
return (compare(d0,d1)); return (compare(d0,d1));
} }
@ -421,29 +416,29 @@ p_compare(void)
p = AtomGT; p = AtomGT;
else else
p = AtomEQ; p = AtomEQ;
return (unify_constant(ARG1, MkAtomTerm(p))); return (_YAP_unify_constant(ARG1, MkAtomTerm(p)));
} }
inline static int inline static int
int_cmp(Int dif) int_cmp(Int dif)
{ {
if (dif < 0) if (dif < 0)
return(unify_constant(ARG1,MkAtomTerm(AtomLT))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomLT)));
else if (dif > 0) else if (dif > 0)
return(unify_constant(ARG1,MkAtomTerm(AtomGT))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomGT)));
else else
return(unify_constant(ARG1,MkAtomTerm(AtomEQ))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomEQ)));
} }
inline static int inline static int
flt_cmp(Float dif) flt_cmp(Float dif)
{ {
if (dif < 0.0) if (dif < 0.0)
return(unify_constant(ARG1,MkAtomTerm(AtomLT))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomLT)));
else if (dif > 0.0) else if (dif > 0.0)
return(unify_constant(ARG1,MkAtomTerm(AtomGT))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomGT)));
else else
return(unify_constant(ARG1,MkAtomTerm(AtomEQ))); return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomEQ)));
} }
@ -456,11 +451,11 @@ p_acomp(void)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=:=/2"); _YAP_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=:=/2"); _YAP_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
@ -468,12 +463,12 @@ p_acomp(void)
} if (IsFloatTerm(t1) && IsFloatTerm(t2)) { } if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2))); return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)));
} }
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -491,7 +486,7 @@ p_acomp(void)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -510,7 +505,7 @@ p_acomp(void)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -536,23 +531,23 @@ a_eq(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=:=/2"); _YAP_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=:=/2"); _YAP_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) == IntegerOfTerm(t2)); return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) == FloatOfTerm(t2)); return (FloatOfTerm(t1) == FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -570,7 +565,7 @@ a_eq(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -589,7 +584,7 @@ a_eq(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -621,23 +616,23 @@ a_dif(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=\\=/2"); _YAP_Error(INSTANTIATION_ERROR, t1, "=\\=/2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=\\=/2"); _YAP_Error(INSTANTIATION_ERROR, t2, "=\\=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) != IntegerOfTerm(t2)); return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) != FloatOfTerm(t2)); return (FloatOfTerm(t1) != FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -655,7 +650,7 @@ a_dif(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -674,7 +669,7 @@ a_dif(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -706,23 +701,23 @@ a_gt(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, ">/2"); _YAP_Error(INSTANTIATION_ERROR, t1, ">/2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, ">/2"); _YAP_Error(INSTANTIATION_ERROR, t2, ">/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) > IntegerOfTerm(t2)); return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) > FloatOfTerm(t2)); return (FloatOfTerm(t1) > FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -740,7 +735,7 @@ a_gt(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -759,7 +754,7 @@ a_gt(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -791,23 +786,23 @@ a_ge(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, ">=/2"); _YAP_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t1, ">=/2"); _YAP_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2)); return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) >= FloatOfTerm(t2)); return (FloatOfTerm(t1) >= FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -825,7 +820,7 @@ a_ge(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -844,7 +839,7 @@ a_ge(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -876,23 +871,23 @@ a_lt(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "</2"); _YAP_Error(INSTANTIATION_ERROR, t1, "</2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "</2"); _YAP_Error(INSTANTIATION_ERROR, t2, "</2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) < IntegerOfTerm(t2)); return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) < FloatOfTerm(t2)); return (FloatOfTerm(t1) < FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -910,7 +905,7 @@ a_lt(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -929,7 +924,7 @@ a_lt(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -961,23 +956,23 @@ a_le(Term t1, Term t2)
union arith_ret v1; union arith_ret v1;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=</2"); _YAP_Error(INSTANTIATION_ERROR, t1, "=</2");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=</2"); _YAP_Error(INSTANTIATION_ERROR, t2, "=</2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2)); return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) <= FloatOfTerm(t2)); return (FloatOfTerm(t1) <= FloatOfTerm(t2));
bt1 = Eval(t1, &v1); bt1 = _YAP_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -995,7 +990,7 @@ a_le(Term t1, Term t2)
case double_e: case double_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -1014,7 +1009,7 @@ a_le(Term t1, Term t2)
case big_int_e: case big_int_e:
{ {
union arith_ret v2; union arith_ret v2;
blob_type bt2 = Eval(t2, &v2); blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) { switch (bt2) {
case long_int_e: case long_int_e:
@ -1071,19 +1066,19 @@ p_gen_ge(void)
void void
InitCmpPreds(void) _YAP_InitCmpPreds(void)
{ {
InitCmpPred("=:=", 2, a_eq, p_eq, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred("=:=", 2, a_eq, p_eq, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("=\\=", 2, a_dif, p_dif, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred("=\\=", 2, a_dif, p_dif, SafePredFlag | BinaryTestPredFlag);
InitCmpPred(">", 2, a_gt, p_gt, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred(">", 2, a_gt, p_gt, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("=<", 2, a_le, p_le, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred("=<", 2, a_le, p_le, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("<", 2, a_lt, p_lt, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred("<", 2, a_lt, p_lt, SafePredFlag | BinaryTestPredFlag);
InitCmpPred(">=", 2, a_ge, p_ge, SafePredFlag | BinaryTestPredFlag); _YAP_InitCmpPred(">=", 2, a_ge, p_ge, SafePredFlag | BinaryTestPredFlag);
InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag); _YAP_InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag);
InitCPred("\\==", 2, p_noteq, TestPredFlag | SafePredFlag); _YAP_InitCPred("\\==", 2, p_noteq, TestPredFlag | SafePredFlag);
InitCPred("@<", 2, p_gen_lt, TestPredFlag | SafePredFlag); _YAP_InitCPred("@<", 2, p_gen_lt, TestPredFlag | SafePredFlag);
InitCPred("@=<", 2, p_gen_le, TestPredFlag | SafePredFlag); _YAP_InitCPred("@=<", 2, p_gen_le, TestPredFlag | SafePredFlag);
InitCPred("@>", 2, p_gen_gt, TestPredFlag | SafePredFlag); _YAP_InitCPred("@>", 2, p_gen_gt, TestPredFlag | SafePredFlag);
InitCPred("@>=", 2, p_gen_ge, TestPredFlag | SafePredFlag); _YAP_InitCPred("@>=", 2, p_gen_ge, TestPredFlag | SafePredFlag);
InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag); _YAP_InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag);
} }

768
C/compiler.c
View File

File diff suppressed because it is too large Load Diff

193
C/computils.c
View File

@ -41,15 +41,19 @@ STATIC_PROTO (void ShowOp, (char *));
* afterwards * afterwards
*/ */
char *freep, *freep0; static Int arg, rn;
Int arg, rn; static compiler_vm_op ic;
compiler_vm_op ic; static CELL *cptr;
CELL *cptr; #ifdef DEBUG
char _YAP_Option[20];
char * YP_FILE *_YAP_logfile;
#endif
static char *
AllocCMem (int size) AllocCMem (int size)
{ {
char *p; char *p;
@ -62,13 +66,19 @@ AllocCMem (int size)
freep += size; freep += size;
if (ASP <= CellPtr (freep) + 256) { if (ASP <= CellPtr (freep) + 256) {
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch,3); longjmp(_YAP_CompilerBotch,3);
} }
return (p); return (p);
} }
char *
_YAP_AllocCMem (int size)
{
return(AllocCMem(size));
}
int int
is_a_test_pred (Term arg, SMALLUNSGN mod) _YAP_is_a_test_pred (Term arg, SMALLUNSGN mod)
{ {
if (IsVarTerm (arg)) if (IsVarTerm (arg))
return (FALSE); return (FALSE);
@ -93,7 +103,7 @@ is_a_test_pred (Term arg, SMALLUNSGN mod)
} }
void void
emit (compiler_vm_op o, Int r1, CELL r2) _YAP_emit (compiler_vm_op o, Int r1, CELL r2)
{ {
PInstr *p; PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p)); p = (PInstr *) AllocCMem (sizeof (*p));
@ -111,7 +121,7 @@ emit (compiler_vm_op o, Int r1, CELL r2)
} }
void void
emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3) _YAP_emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3)
{ {
PInstr *p; PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p)+sizeof(CELL)); p = (PInstr *) AllocCMem (sizeof (*p)+sizeof(CELL));
@ -130,7 +140,7 @@ emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3)
} }
CELL * CELL *
emit_extra_size (compiler_vm_op o, CELL r1, int size) _YAP_emit_extra_size (compiler_vm_op o, CELL r1, int size)
{ {
PInstr *p; PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p) + size - CellSize); p = (PInstr *) AllocCMem (sizeof (*p) + size - CellSize);
@ -147,7 +157,7 @@ emit_extra_size (compiler_vm_op o, CELL r1, int size)
return (p->arnds); return (p->arnds);
} }
void static void
bip_name(Int op, char *s) bip_name(Int op, char *s)
{ {
switch (op) { switch (op) {
@ -229,6 +239,11 @@ bip_name(Int op, char *s)
} }
} }
void
_YAP_bip_name(Int op, char *s) {
bip_name(op,s);
}
#ifdef DEBUG #ifdef DEBUG
static void static void
@ -243,7 +258,7 @@ ShowOp (f)
{ {
case 'a': case 'a':
case 'n': case 'n':
plwrite ((Term) arg, DebugPutc, 0); _YAP_plwrite ((Term) arg, _YAP_DebugPutc, 0);
break; break;
case 'b': case 'b':
/* write a variable bitmap for a call */ /* write a variable bitmap for a call */
@ -251,32 +266,32 @@ ShowOp (f)
int max = arg/(8*sizeof(CELL)), i; int max = arg/(8*sizeof(CELL)), i;
CELL *ptr = cptr; CELL *ptr = cptr;
for (i = 0; i <= max; i++) { for (i = 0; i <= max; i++) {
plwrite(MkIntegerTerm((Int)(*ptr++)), DebugPutc, 0); _YAP_plwrite(MkIntegerTerm((Int)(*ptr++)), _YAP_DebugPutc, 0);
} }
} }
break; break;
case 'l': case 'l':
plwrite (MkIntTerm (arg), DebugPutc, 0); _YAP_plwrite (MkIntTerm (arg), _YAP_DebugPutc, 0);
break; break;
case 'B': case 'B':
{ {
char s[32]; char s[32];
bip_name(rn,s); bip_name(rn,s);
plwrite (MkAtomTerm(LookupAtom(s)), DebugPutc, 0); _YAP_plwrite (MkAtomTerm(_YAP_LookupAtom(s)), _YAP_DebugPutc, 0);
} }
break; break;
case 'd': case 'd':
plwrite (MkIntTerm (rn), DebugPutc, 0); _YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break; break;
case 'z': case 'z':
plwrite (MkIntTerm (cpc->rnd3), DebugPutc, 0); _YAP_plwrite (MkIntTerm (cpc->rnd3), _YAP_DebugPutc, 0);
break; break;
case 'v': case 'v':
{ {
Ventry *v = (Ventry *) arg; Ventry *v = (Ventry *) arg;
DebugPutc (c_output_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); _YAP_DebugPutc (_YAP_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), DebugPutc, 0); _YAP_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), _YAP_DebugPutc, 0);
} }
break; break;
case 'N': case 'N':
@ -286,14 +301,14 @@ ShowOp (f)
cpc = cpc->nextInst; cpc = cpc->nextInst;
arg = cpc->rnd1; arg = cpc->rnd1;
v = (Ventry *) arg; v = (Ventry *) arg;
DebugPutc (c_output_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); _YAP_DebugPutc (_YAP_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), DebugPutc, 0); _YAP_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), _YAP_DebugPutc, 0);
} }
break; break;
case 'm': case 'm':
plwrite (MkAtomTerm ((Atom) arg), DebugPutc, 0); _YAP_plwrite (MkAtomTerm ((Atom) arg), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite (MkIntTerm (rn), DebugPutc, 0); _YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break; break;
case 'p': case 'p':
{ {
@ -303,14 +318,14 @@ ShowOp (f)
SMALLUNSGN mod = 0; SMALLUNSGN mod = 0;
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred); if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
plwrite (ModuleName[mod], DebugPutc, 0); _YAP_plwrite (ModuleName[mod], _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,':'); _YAP_DebugPutc (_YAP_c_error_stream,':');
if (arity == 0) if (arity == 0)
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0); _YAP_plwrite (MkAtomTerm ((Atom)f), _YAP_DebugPutc, 0);
else else
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (NameOfFunctor (f)), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite (MkIntTerm (arity), DebugPutc, 0); _YAP_plwrite (MkIntTerm (arity), _YAP_DebugPutc, 0);
} }
break; break;
case 'P': case 'P':
@ -321,88 +336,88 @@ ShowOp (f)
SMALLUNSGN mod = 0; SMALLUNSGN mod = 0;
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred); if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
plwrite (ModuleName[mod], DebugPutc, 0); _YAP_plwrite (ModuleName[mod], _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,':'); _YAP_DebugPutc (_YAP_c_error_stream,':');
if (arity == 0) if (arity == 0)
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0); _YAP_plwrite (MkAtomTerm ((Atom)f), _YAP_DebugPutc, 0);
else else
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (NameOfFunctor (f)), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite (MkIntTerm (arity), DebugPutc, 0); _YAP_plwrite (MkIntTerm (arity), _YAP_DebugPutc, 0);
} }
break; break;
case 'f': case 'f':
if (IsExtensionFunctor((Functor)arg)) { if (IsExtensionFunctor((Functor)arg)) {
if ((Functor)arg == FunctorDBRef) { if ((Functor)arg == FunctorDBRef) {
plwrite(MkAtomTerm(LookupAtom("DBRef")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("DBRef")), _YAP_DebugPutc, 0);
} else if ((Functor)arg == FunctorLongInt) { } else if ((Functor)arg == FunctorLongInt) {
plwrite(MkAtomTerm(LookupAtom("LongInt")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("LongInt")), _YAP_DebugPutc, 0);
} else if ((Functor)arg == FunctorDouble) { } else if ((Functor)arg == FunctorDouble) {
plwrite(MkAtomTerm(LookupAtom("Double")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("Double")), _YAP_DebugPutc, 0);
} }
} else { } else {
plwrite(MkAtomTerm(NameOfFunctor ((Functor) arg)), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(NameOfFunctor ((Functor) arg)), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite(MkIntTerm(ArityOfFunctor ((Functor) arg)), DebugPutc, 0); _YAP_plwrite(MkIntTerm(ArityOfFunctor ((Functor) arg)), _YAP_DebugPutc, 0);
} }
break; break;
case 'r': case 'r':
DebugPutc (c_output_stream,'A'); _YAP_DebugPutc (_YAP_c_error_stream,'A');
plwrite (MkIntTerm (rn), DebugPutc, 0); _YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break; break;
case 'h': case 'h':
{ {
CELL my_arg = *cptr++; CELL my_arg = *cptr++;
if (my_arg & 1) if (my_arg & 1)
plwrite (MkIntTerm (my_arg), _YAP_plwrite (MkIntTerm (my_arg),
DebugPutc, 0); _YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE) else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else else
plwrite (MkIntegerTerm ((Int) my_arg), _YAP_plwrite (MkIntegerTerm ((Int) my_arg),
DebugPutc, 0); _YAP_DebugPutc, 0);
} }
break; break;
case 'g': case 'g':
if (arg & 1) if (arg & 1)
plwrite (MkIntTerm (arg), _YAP_plwrite (MkIntTerm (arg),
DebugPutc, 0); _YAP_DebugPutc, 0);
else if (arg == (CELL) FAILCODE) else if (arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else else
plwrite (MkIntegerTerm ((Int) arg), DebugPutc, 0); _YAP_plwrite (MkIntegerTerm ((Int) arg), _YAP_DebugPutc, 0);
break; break;
case 'i': case 'i':
plwrite (MkIntTerm (arg), DebugPutc, 0); _YAP_plwrite (MkIntTerm (arg), _YAP_DebugPutc, 0);
break; break;
case 'j': case 'j':
{ {
Functor fun = (Functor)*cptr++; Functor fun = (Functor)*cptr++;
if (IsExtensionFunctor(fun)) { if (IsExtensionFunctor(fun)) {
if (fun == FunctorDBRef) { if (fun == FunctorDBRef) {
plwrite(MkAtomTerm(LookupAtom("DBRef")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("DBRef")), _YAP_DebugPutc, 0);
} else if (fun == FunctorLongInt) { } else if (fun == FunctorLongInt) {
plwrite(MkAtomTerm(LookupAtom("LongInt")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("LongInt")), _YAP_DebugPutc, 0);
} else if (fun == FunctorDouble) { } else if (fun == FunctorDouble) {
plwrite(MkAtomTerm(LookupAtom("Double")), DebugPutc, 0); _YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("Double")), _YAP_DebugPutc, 0);
} }
} else { } else {
plwrite (MkAtomTerm(NameOfFunctor(fun)), DebugPutc, 0); _YAP_plwrite (MkAtomTerm(NameOfFunctor(fun)), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite (MkIntTerm(ArityOfFunctor(fun)), DebugPutc, 0); _YAP_plwrite (MkIntTerm(ArityOfFunctor(fun)), _YAP_DebugPutc, 0);
} }
} }
break; break;
case 'O': case 'O':
plwrite(AbsAppl(cptr), DebugPutc, 0); _YAP_plwrite(AbsAppl(cptr), _YAP_DebugPutc, 0);
break; break;
case 'x': case 'x':
plwrite (MkIntTerm (rn >> 1), DebugPutc, 0); _YAP_plwrite (MkIntTerm (rn >> 1), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'\t'); _YAP_DebugPutc (_YAP_c_error_stream,'\t');
plwrite (MkIntTerm (rn & 1), DebugPutc, 0); _YAP_plwrite (MkIntTerm (rn & 1), _YAP_DebugPutc, 0);
break; break;
case 'o': case 'o':
plwrite ((Term) * cptr++, DebugPutc, 0); _YAP_plwrite ((Term) * cptr++, _YAP_DebugPutc, 0);
case 'c': case 'c':
{ {
int i; int i;
@ -411,23 +426,23 @@ ShowOp (f)
CELL my_arg; CELL my_arg;
if (*cptr) if (*cptr)
{ {
plwrite ((Term) * cptr++, DebugPutc, 0); _YAP_plwrite ((Term) * cptr++, _YAP_DebugPutc, 0);
} }
else else
{ {
plwrite (MkIntTerm (0), DebugPutc, 0); _YAP_plwrite (MkIntTerm (0), _YAP_DebugPutc, 0);
cptr++; cptr++;
} }
DebugPutc (c_output_stream,'\t'); _YAP_DebugPutc (_YAP_c_error_stream,'\t');
my_arg = *cptr++; my_arg = *cptr++;
if (my_arg & 1) if (my_arg & 1)
plwrite (MkIntTerm (my_arg), _YAP_plwrite (MkIntTerm (my_arg),
DebugPutc, 0); _YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE) else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else else
plwrite (MkIntegerTerm ((Int) my_arg), DebugPutc, 0); _YAP_plwrite (MkIntegerTerm ((Int) my_arg), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'\n'); _YAP_DebugPutc (_YAP_c_error_stream,'\n');
} }
} }
break; break;
@ -439,36 +454,36 @@ ShowOp (f)
CELL my_arg; CELL my_arg;
if (*cptr) if (*cptr)
{ {
plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'/'); _YAP_DebugPutc (_YAP_c_error_stream,'/');
plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), DebugPutc, 0); _YAP_plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), _YAP_DebugPutc, 0);
} }
else else
{ {
plwrite (MkIntTerm (0), DebugPutc, 0); _YAP_plwrite (MkIntTerm (0), _YAP_DebugPutc, 0);
cptr++; cptr++;
} }
DebugPutc (c_output_stream,'\t'); _YAP_DebugPutc (_YAP_c_error_stream,'\t');
my_arg = *cptr++; my_arg = *cptr++;
if (my_arg & 1) if (my_arg & 1)
plwrite (MkIntTerm (my_arg), _YAP_plwrite (MkIntTerm (my_arg),
DebugPutc, 0); _YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE) else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0); _YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else else
plwrite (MkIntegerTerm ((Int) my_arg), DebugPutc, 0); _YAP_plwrite (MkIntegerTerm ((Int) my_arg), _YAP_DebugPutc, 0);
DebugPutc (c_output_stream,'\n'); _YAP_DebugPutc (_YAP_c_error_stream,'\n');
} }
} }
break; break;
default: default:
DebugPutc (c_output_stream,'%'); _YAP_DebugPutc (_YAP_c_error_stream,'%');
DebugPutc (c_output_stream,ch); _YAP_DebugPutc (_YAP_c_error_stream,ch);
} }
else else
DebugPutc (c_output_stream,ch); _YAP_DebugPutc (_YAP_c_error_stream,ch);
} }
DebugPutc (c_output_stream,'\n'); _YAP_DebugPutc (_YAP_c_error_stream,'\n');
} }
static char *opformat[] = static char *opformat[] =
@ -639,7 +654,7 @@ static char *opformat[] =
void void
ShowCode () _YAP_ShowCode ()
{ {
CELL *OldH = H; CELL *OldH = H;
@ -656,7 +671,7 @@ ShowCode ()
ShowOp (opformat[ic]); ShowOp (opformat[ic]);
cpc = cpc->nextInst; cpc = cpc->nextInst;
} }
DebugPutc (c_output_stream,'\n'); _YAP_DebugPutc (_YAP_c_error_stream,'\n');
H = OldH; H = OldH;
} }

120
C/corout.c
View File

@ -164,13 +164,13 @@ UpdateSVarList(sus_record *sl)
/* make sl the new head of the suspension list, and update the list /* make sl the new head of the suspension list, and update the list
to use the old one. Note that the list is only bound once, to use the old one. Note that the list is only bound once,
MutableList is the one variable being updated all the time */ MutableList is the one variable being updated all the time */
return((sus_record *)UpdateTimedVar(MutableList, (CELL)sl)); return((sus_record *)_YAP_UpdateTimedVar(MutableList, (CELL)sl));
} }
inline static sus_record * inline static sus_record *
GetSVarList(void) GetSVarList(void)
{ {
Term t = ReadTimedVar(MutableList); Term t = _YAP_ReadTimedVar(MutableList);
/* just return the start of the list */ /* just return the start of the list */
if (t == TermNil) if (t == TermNil)
return(NULL); return(NULL);
@ -188,9 +188,9 @@ GetSVarList(void)
*/ */
Term static Term
ListOfWokenGoals(void) { ListOfWokenGoals(void) {
sus_record *pt = (sus_record *)ReadTimedVar(WokenGoals); sus_record *pt = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
Term t; Term t;
t = TermNil; t = TermNil;
@ -202,13 +202,19 @@ ListOfWokenGoals(void) {
return(t); return(t);
} }
Term
_YAP_ListOfWokenGoals(void) {
return ListOfWokenGoals();
}
static void ReleaseGoals(sus_record *from) static void ReleaseGoals(sus_record *from)
{ {
/* follow the chain */ /* follow the chain */
sus_record *WGs = (sus_record *)ReadTimedVar(WokenGoals); sus_record *WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
if ((Term)WGs == TermNil) { if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)from); _YAP_UpdateTimedVar(WokenGoals, (CELL)from);
} else { } else {
/* add to the end of the current list of suspended goals */ /* add to the end of the current list of suspended goals */
CELL *where_to = (CELL *)Deref((CELL)WGs); CELL *where_to = (CELL *)Deref((CELL)WGs);
@ -329,14 +335,14 @@ CopySuspendedVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
register sus_tag *sreg = (sus_tag *)orig, *vs; register sus_tag *sreg = (sus_tag *)orig, *vs;
/* add a new suspension */ /* add a new suspension */
vs = (sus_tag *)ReadTimedVar(DelayedVars); vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024) if (H0 - (CELL *)vs < 1024)
return(FALSE); return(FALSE);
RESET_VARIABLE(&(vs->ActiveSus)); RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext; vs->sus_id = susp_ext;
vs->SG = copy_suspended_goals(sreg->SG, to_visit_ptr); vs->SG = copy_suspended_goals(sreg->SG, to_visit_ptr);
*res = (CELL)&(vs->ActiveSus); *res = (CELL)&(vs->ActiveSus);
UpdateTimedVar(DelayedVars, (CELL)(vs+1)); _YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE); return(TRUE);
} }
@ -380,14 +386,14 @@ TermToSuspendedVar(Term gs, Term var)
{ {
register sus_tag *vs; register sus_tag *vs;
/* add a new suspension */ /* add a new suspension */
vs = (sus_tag *)ReadTimedVar(DelayedVars); vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024) if (H0 - (CELL *)vs < 1024)
return(FALSE); return(FALSE);
RESET_VARIABLE(&(vs->ActiveSus)); RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext; vs->sus_id = susp_ext;
vs->SG = terms_to_suspended_goals(gs); vs->SG = terms_to_suspended_goals(gs);
unify(var,(CELL)&(vs->ActiveSus)); _YAP_unify(var,(CELL)&(vs->ActiveSus));
UpdateTimedVar(DelayedVars, (CELL)(vs+1)); _YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE); return(TRUE);
} }
@ -398,10 +404,10 @@ mark_sus_record(sus_record *sg)
if (MARKED(((CELL)(sg->NR)))) if (MARKED(((CELL)(sg->NR))))
return; return;
MARK(((CELL *)&(sg->NR))); MARK(((CELL *)&(sg->NR)));
total_marked++; _YAP_inc_mark_variable();
mark_variable((CELL *)&(sg->SG)); _YAP_mark_variable((CELL *)&(sg->SG));
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
total_marked++; _YAP_inc_mark_variable();
if (!IsAtomTerm((CELL)(sg->NS))) if (!IsAtomTerm((CELL)(sg->NS)))
mark_sus_record(sg->NS); mark_sus_record(sg->NS);
MARK(((CELL *)&(sg->NS))); MARK(((CELL *)&(sg->NS)));
@ -413,12 +419,12 @@ static void mark_suspended_goal(CELL *orig)
register sus_tag *sreg = (sus_tag *)orig; register sus_tag *sreg = (sus_tag *)orig;
mark_sus_record(sreg->SG); mark_sus_record(sreg->SG);
mark_external_reference(((CELL *)&(sreg->SG))); _YAP_mark_external_reference(((CELL *)&(sreg->SG)));
} }
void void
mark_all_suspended_goals(void) _YAP_mark_all_suspended_goals(void)
{ {
sus_record *sg = GetSVarList(); sus_record *sg = GetSVarList();
if (sg == NULL) if (sg == NULL)
@ -468,7 +474,7 @@ Wake(CELL *pt1, CELL reg2)
/* binding two suspended variables, be careful */ /* binding two suspended variables, be careful */
if (susp2->sus_id != susp_ext) { if (susp2->sus_id != susp_ext) {
/* joining two suspensions */ /* joining two suspensions */
Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented"); _YAP_Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented");
return; return;
} }
/* join the two suspended lists */ /* join the two suspended lists */
@ -567,19 +573,19 @@ freeze_goal(Term t, Term g)
id = (exts)(susp->sus_id); id = (exts)(susp->sus_id);
if (id != susp_ext) { if (id != susp_ext) {
/* obtain the term */ /* obtain the term */
Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported"); _YAP_Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported");
return(FALSE); return(FALSE);
} }
AddSuspendedGoal(g, susp->SG); AddSuspendedGoal(g, susp->SG);
return(TRUE); return(TRUE);
} }
vs = (sus_tag *)ReadTimedVar(DelayedVars); vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024) { if (H0 - (CELL *)vs < 1024) {
ARG1 = t; ARG1 = t;
ARG2 = g; ARG2 = g;
if (!growglobal(NULL)) { if (!_YAP_growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage); _YAP_Error(SYSTEM_ERROR, t, _YAP_ErrorMessage);
return FALSE; return FALSE;
} }
t = ARG1; t = ARG1;
@ -597,13 +603,13 @@ freeze_goal(Term t, Term g)
vs->sus_id = susp_ext; vs->sus_id = susp_ext;
vs->SG = gf; vs->SG = gf;
RESET_VARIABLE(&(vs->ActiveSus)); RESET_VARIABLE(&(vs->ActiveSus));
UpdateTimedVar(DelayedVars, (CELL)(vs+1)); _YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
Bind_Global((CELL *)t,(CELL)&(vs->ActiveSus)); Bind_Global((CELL *)t,(CELL)&(vs->ActiveSus));
return(TRUE); return(TRUE);
} }
else { else {
/* Oops, first argument was bound :-( */ /* Oops, first argument was bound :-( */
Error(TYPE_ERROR_VARIABLE, t, "freeze/2"); _YAP_Error(TYPE_ERROR_VARIABLE, t, "freeze/2");
return(FALSE); return(FALSE);
} }
} }
@ -615,7 +621,7 @@ p_read_svar_list(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
return(unify(ARG1, MutableList) && unify(ARG2, AttsMutableList)); return(_YAP_unify(ARG1, MutableList) && _YAP_unify(ARG2, AttsMutableList));
#else #else
return(TRUE); return(TRUE);
#endif #endif
@ -719,7 +725,7 @@ static Int p_frozen_goals(void)
} }
HB = B->cp_h; HB = B->cp_h;
#endif #endif
return(unify(ARG2,t)); return(_YAP_unify(ARG2,t));
} }
/* return a queue with all goals frozen in the system */ /* return a queue with all goals frozen in the system */
@ -727,11 +733,11 @@ static Int p_all_frozen_goals(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
/* initially, we do not know of any goals frozen */ /* initially, we do not know of any goals frozen */
Term t = CurrentAttVars(); Term t = _YAP_CurrentAttVars();
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
sus_record *x = GetSVarList(); sus_record *x = GetSVarList();
if (x == NULL) if (x == NULL)
return(unify(ARG1,t)); return(_YAP_unify(ARG1,t));
/* okay, we are on top of the list of variables. Let's burn rubber! /* okay, we are on top of the list of variables. Let's burn rubber!
*/ */
while ((CELL)x != TermNil) { while ((CELL)x != TermNil) {
@ -739,9 +745,9 @@ static Int p_all_frozen_goals(void)
x = x->NS; x = x->NS;
} }
#endif #endif
return(unify(ARG1,t)); return(_YAP_unify(ARG1,t));
#else #else
return(unify(ARG1,TermNil)); return(_YAP_unify(ARG1,TermNil));
#endif #endif
} }
@ -771,7 +777,7 @@ static int can_unify_complex(register CELL *pt0,
CELL *saved_HB; CELL *saved_HB;
choiceptr saved_B; choiceptr saved_B;
register CELL **to_visit = (CELL **)PreAllocCodeSpace(); register CELL **to_visit = (CELL **)_YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit; CELL **to_visit_base = to_visit;
/* make sure to trail all bindings */ /* make sure to trail all bindings */
@ -872,7 +878,7 @@ static int can_unify_complex(register CELL *pt0,
goto comparison_failed; goto comparison_failed;
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
if (mpz_cmp(BigIntOfTerm(d0),BigIntOfTerm(d1)) == 0) continue; if (mpz_cmp(_YAP_BigIntOfTerm(d0),_YAP_BigIntOfTerm(d1)) == 0) continue;
goto comparison_failed; goto comparison_failed;
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
@ -923,7 +929,7 @@ static int can_unify_complex(register CELL *pt0,
goto loop; goto loop;
} }
/* success */ /* success */
ReleasePreAllocCodeSpace((ADDR)to_visit); _YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
/* restore B, and later HB */ /* restore B, and later HB */
B = saved_B; B = saved_B;
HB = saved_HB; HB = saved_HB;
@ -936,7 +942,7 @@ static int can_unify_complex(register CELL *pt0,
comparison_failed: comparison_failed:
/* failure */ /* failure */
ReleasePreAllocCodeSpace((ADDR)to_visit); _YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > (CELL **)to_visit_base) { while (to_visit > (CELL **)to_visit_base) {
to_visit -= 4; to_visit -= 4;
@ -1009,7 +1015,7 @@ can_unify(Term t1, Term t2, Term *Vars)
return(FALSE); return(FALSE);
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
if (mpz_cmp(BigIntOfTerm(t1),BigIntOfTerm(t2)) == 0) return(TRUE); if (mpz_cmp(_YAP_BigIntOfTerm(t1),_YAP_BigIntOfTerm(t2)) == 0) return(TRUE);
return(FALSE); return(FALSE);
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
@ -1029,7 +1035,7 @@ static int non_ground_complex(register CELL *pt0,
Term *Var) Term *Var)
{ {
register CELL **to_visit = (CELL **)PreAllocCodeSpace(); register CELL **to_visit = (CELL **)_YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit; CELL **to_visit_base = to_visit;
loop: loop:
@ -1107,12 +1113,12 @@ static int non_ground_complex(register CELL *pt0,
} }
/* the term is ground */ /* the term is ground */
ReleasePreAllocCodeSpace((ADDR)to_visit); _YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
return(FALSE); return(FALSE);
var_found: var_found:
/* the term is non-ground */ /* the term is non-ground */
ReleasePreAllocCodeSpace((ADDR)to_visit); _YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > (CELL **)to_visit_base) { while (to_visit > (CELL **)to_visit_base) {
to_visit -= 3; to_visit -= 3;
@ -1159,7 +1165,7 @@ static Int p_can_unify(void)
Term r = TermNil; Term r = TermNil;
if (!can_unify(ARG1, ARG2, &r)) if (!can_unify(ARG1, ARG2, &r))
return(FALSE); return(FALSE);
return (unify(ARG3, r)); return (_YAP_unify(ARG3, r));
#else #else
return(FALSE); return(FALSE);
#endif #endif
@ -1172,7 +1178,7 @@ static Int p_non_ground(void)
Term r; Term r;
if (!non_ground(ARG1, &r)) if (!non_ground(ARG1, &r))
return(FALSE); return(FALSE);
return (unify(ARG2, r)); return (_YAP_unify(ARG2, r));
#else #else
return(FALSE); return(FALSE);
#endif #endif
@ -1192,13 +1198,13 @@ static Int p_coroutining(void)
static Int p_awoken_goals(void) static Int p_awoken_goals(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
Term WGs = ReadTimedVar(WokenGoals); Term WGs = _YAP_ReadTimedVar(WokenGoals);
if (WGs == TermNil) { if (WGs == TermNil) {
return(FALSE); return(FALSE);
} }
WGs = ListOfWokenGoals(); WGs = ListOfWokenGoals();
UpdateTimedVar(WokenGoals, TermNil); _YAP_UpdateTimedVar(WokenGoals, TermNil);
return(unify(ARG1,WGs)); return(_YAP_unify(ARG1,WGs));
#else #else
return(FALSE); return(FALSE);
#endif #endif
@ -1206,7 +1212,7 @@ static Int p_awoken_goals(void)
#ifdef COROUTINING #ifdef COROUTINING
void void
WakeUp(CELL *pt0) { _YAP_WakeUp(CELL *pt0) {
CELL d0 = *pt0; CELL d0 = *pt0;
RESET_VARIABLE(pt0); RESET_VARIABLE(pt0);
TR--; TR--;
@ -1215,7 +1221,7 @@ WakeUp(CELL *pt0) {
#endif #endif
void InitCoroutPreds(void) void _YAP_InitCoroutPreds(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
Atom at; Atom at;
@ -1226,21 +1232,21 @@ void InitCoroutPreds(void)
attas[susp_ext].to_term_op = SuspendedVarToTerm; attas[susp_ext].to_term_op = SuspendedVarToTerm;
attas[susp_ext].term_to_op = TermToSuspendedVar; attas[susp_ext].term_to_op = TermToSuspendedVar;
attas[susp_ext].mark_op = mark_suspended_goal; attas[susp_ext].mark_op = mark_suspended_goal;
at = LookupAtom("$wake_up_goal"); at = _YAP_LookupAtom("$wake_up_goal");
pred = RepPredProp(PredPropByFunc(MkFunctor(at, 2),0)); pred = RepPredProp(PredPropByFunc(_YAP_MkFunctor(at, 2),0));
WakeUpCode = pred; WakeUpCode = pred;
InitAttVarPreds(); _YAP_InitAttVarPreds();
#endif /* COROUTINING */ #endif /* COROUTINING */
InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag); _YAP_InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);
InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag); _YAP_InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag);
InitCPred("$freeze", 2, p_freeze, 0); _YAP_InitCPred("$freeze", 2, p_freeze, 0);
InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag); _YAP_InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag);
InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag); _YAP_InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag);
InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag); _YAP_InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag);
InitCPred("$can_unify", 3, p_can_unify, SafePredFlag); _YAP_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag);
InitCPred("$non_ground", 2, p_non_ground, SafePredFlag); _YAP_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
InitCPred("$coroutining", 0, p_coroutining, SafePredFlag); _YAP_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag);
InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag); _YAP_InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag);
} }

516
C/dbase.c
View File

File diff suppressed because it is too large Load Diff

12
C/depth_bound.c
View File

@ -29,7 +29,7 @@ STD_PROTO(static Int p_set_depth_limit, (void));
static Int p_get_depth_limit(void) static Int p_get_depth_limit(void)
{ {
return(unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2)))); return(_YAP_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
} }
static Int p_set_depth_limit(void) static Int p_set_depth_limit(void)
@ -37,10 +37,10 @@ static Int p_set_depth_limit(void)
Term d = Deref(ARG1); Term d = Deref(ARG1);
if (IsVarTerm(d)) { if (IsVarTerm(d)) {
Error(INSTANTIATION_ERROR, d, "set-depth_limit"); _YAP_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE); return(FALSE);
} else if (!IsIntegerTerm(d)) { } else if (!IsIntegerTerm(d)) {
Error(TYPE_ERROR_INTEGER, d, "set-depth_limit"); _YAP_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE); return(FALSE);
} }
d = MkIntTerm(IntegerOfTerm(d)*2); d = MkIntTerm(IntegerOfTerm(d)*2);
@ -51,10 +51,10 @@ static Int p_set_depth_limit(void)
return(TRUE); return(TRUE);
} }
void InitItDeepenPreds(void) void _YAP_InitItDeepenPreds(void)
{ {
InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag); _YAP_InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag);
InitCPred("$set_depth_limit", 1, p_set_depth_limit, 0); _YAP_InitCPred("$set_depth_limit", 1, p_set_depth_limit, 0);
} }
#endif #endif

567
C/errors.c
View File

File diff suppressed because it is too large Load Diff

95
C/eval.c
View File

@ -27,7 +27,7 @@ static char SccsId[] = "%W% %G%";
#include "Heap.h" #include "Heap.h"
#include "eval.h" #include "eval.h"
yap_error_number YAP_matherror = YAP_NO_ERROR; yap_error_number _YAP_matherror = YAP_NO_ERROR;
#define E_FUNC blob_type #define E_FUNC blob_type
#define E_ARGS arith_retptr o #define E_ARGS arith_retptr o
@ -48,18 +48,18 @@ EvalToTerm(blob_type bt, union arith_ret *res)
return(MkFloatTerm(res->dbl)); return(MkFloatTerm(res->dbl));
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
return(MkBigIntTerm(res->big)); return(_YAP_MkBigIntTerm(res->big));
#endif #endif
default: default:
return(TermNil); return(TermNil);
} }
} }
E_FUNC static E_FUNC
Eval(Term t, E_ARGS) Eval(Term t, E_ARGS)
{ {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,TermNil,"in arithmetic"); _YAP_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} }
@ -72,7 +72,7 @@ Eval(Term t, E_ARGS)
RFLOAT(FloatOfTerm(t)); RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
RBIG(BigIntOfTerm(t)); RBIG(_YAP_BigIntOfTerm(t));
#endif #endif
default: default:
{ {
@ -80,14 +80,14 @@ Eval(Term t, E_ARGS)
Atom name = NameOfFunctor(fun); Atom name = NameOfFunctor(fun);
ExpEntry *p; ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, n)))) { if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, n)))) {
Term ti[2]; Term ti[2];
/* error */ /* error */
ti[0] = t; ti[0] = t;
ti[1] = MkIntegerTerm(n); ti[1] = MkIntegerTerm(n);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti); t = _YAP_MkApplTerm(_YAP_MkFunctor(_YAP_LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t, _YAP_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression", "functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n); RepAtom(name)->StrOfAE,n);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
@ -106,9 +106,72 @@ Eval(Term t, E_ARGS)
Atom name = AtomOfTerm(t); Atom name = AtomOfTerm(t);
ExpEntry *p; ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, 0)))) { if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, 0)))) {
/* error */ /* error */
Error(TYPE_ERROR_EVALUABLE, t, _YAP_Error(TYPE_ERROR_EVALUABLE, t,
"atom %s for arithmetic expression",
RepAtom(name)->StrOfAE);
P = (yamop *)FAILCODE;
RERROR();
}
return(p->FOfEE.constant(USE_E_ARGS));
}
}
E_FUNC
_YAP_Eval(Term t, E_ARGS)
{
if (IsVarTerm(t)) {
_YAP_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE;
RERROR();
}
if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
switch ((CELL)fun) {
case (CELL)FunctorLongInt:
RINT(LongIntOfTerm(t));
case (CELL)FunctorDouble:
RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
RBIG(_YAP_BigIntOfTerm(t));
#endif
default:
{
Int n = ArityOfFunctor(fun);
Atom name = NameOfFunctor(fun);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = _YAP_MkApplTerm(_YAP_MkFunctor(_YAP_LookupAtom("/"),2), 2, ti);
_YAP_Error(TYPE_ERROR_EVALUABLE, t,
"functor %s/%d for arithmetic expression",
RepAtom(name)->StrOfAE,n);
P = (yamop *)FAILCODE;
RERROR();
}
if (n == 1)
return(p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS));
return(p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS));
}
}
} else if (IsPairTerm(t)) {
return(Eval(HeadOfTerm(t), USE_E_ARGS));
} else if (IsIntTerm(t)) {
RINT(IntOfTerm(t));
} else {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, 0)))) {
/* error */
_YAP_Error(TYPE_ERROR_EVALUABLE, t,
"atom %s for arithmetic expression", "atom %s for arithmetic expression",
RepAtom(name)->StrOfAE); RepAtom(name)->StrOfAE);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
@ -125,16 +188,16 @@ p_is(void)
blob_type bt; blob_type bt;
bt = Eval(Deref(ARG2), &res); bt = Eval(Deref(ARG2), &res);
return (unify_constant(ARG1,EvalToTerm(bt,&res))); return (_YAP_unify_constant(ARG1,EvalToTerm(bt,&res)));
} }
void void
InitEval(void) _YAP_InitEval(void)
{ {
/* here are the arithmetical predicates */ /* here are the arithmetical predicates */
InitConstExps(); _YAP_InitConstExps();
InitUnaryExps(); _YAP_InitUnaryExps();
InitBinaryExps(); _YAP_InitBinaryExps();
InitCPred("is", 2, p_is, TestPredFlag | SafePredFlag); _YAP_InitCPred("is", 2, p_is, TestPredFlag | SafePredFlag);
} }

343
C/exec.c
View File

@ -28,6 +28,10 @@ STATIC_PROTO(Int p_execute, (void));
STATIC_PROTO(Int p_execute0, (void)); STATIC_PROTO(Int p_execute0, (void));
STATIC_PROTO(Int p_at_execute, (void)); STATIC_PROTO(Int p_at_execute, (void));
/************ table of C-Predicates *************/
CPredicate _YAP_c_predicates[MAX_C_PREDS];
cmp_entry _YAP_cmp_funcs[MAX_CMP_FUNCS];
static Term static Term
current_cp_as_integer(void) current_cp_as_integer(void)
{ {
@ -48,7 +52,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (do_low_level_trace) if (_YAP_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1); low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
CP = P; CP = P;
@ -75,13 +79,13 @@ CallMetaCall(SMALLUNSGN mod) {
} }
Term Term
ExecuteCallMetaCall(SMALLUNSGN mod) { _YAP_ExecuteCallMetaCall(SMALLUNSGN mod) {
Term ts[4]; Term ts[4];
ts[0] = ARG1; ts[0] = ARG1;
ts[1] = current_cp_as_integer(); /* p_save_cp */ ts[1] = current_cp_as_integer(); /* p_save_cp */
ts[2] = ARG1; ts[2] = ARG1;
ts[3] = ModuleName[mod]; ts[3] = ModuleName[mod];
return(MkApplTerm(PredMetaCall->FunctorOfPred,4,ts)); return(_YAP_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts));
} }
static Int static Int
@ -90,7 +94,7 @@ CallError(yap_error_number err, SMALLUNSGN mod)
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
return(CallMetaCall(mod)); return(CallMetaCall(mod));
} else { } else {
Error(err, ARG1, "call/1"); _YAP_Error(err, ARG1, "call/1");
return(FALSE); return(FALSE);
} }
} }
@ -117,7 +121,7 @@ CallClause(PredEntry *pen, unsigned int arity, Int position)
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (do_low_level_trace) if (_YAP_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1); low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
ENV = YENV; ENV = YENV;
@ -172,7 +176,7 @@ CallClause(PredEntry *pen, unsigned int arity, Int position)
return (Unsigned(pen)); return (Unsigned(pen));
} }
} else { } else {
Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin"); _YAP_Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin");
return (FALSE); return (FALSE);
} }
} }
@ -190,7 +194,7 @@ p_save_cp(void)
BIND((CELL *)t,td,bind_save_cp); BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING #ifdef COROUTINING
DO_TRAIL(CellPtr(t), td); DO_TRAIL(CellPtr(t), td);
if (CellPtr(t) < H0) WakeUp((CELL *)t); if (CellPtr(t) < H0) _YAP_WakeUp((CELL *)t);
bind_save_cp: bind_save_cp:
#endif #endif
return(TRUE); return(TRUE);
@ -199,7 +203,7 @@ p_save_cp(void)
static Int static Int
EnterCreepMode(SMALLUNSGN mod) { EnterCreepMode(SMALLUNSGN mod) {
PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,0)); PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,0));
Term tn = MkApplTerm(MkFunctor(AtomMetaCall,1),1,&ARG1); Term tn = _YAP_MkApplTerm(_YAP_MkFunctor(AtomMetaCall,1),1,&ARG1);
ARG1 = MkPairTerm(ModuleName[mod],tn); ARG1 = MkPairTerm(ModuleName[mod],tn);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
P_before_spy = P; P_before_spy = P;
@ -215,17 +219,17 @@ PushModule(Term t,SMALLUNSGN mod) {
Term ti[2], tf[2]; Term ti[2], tf[2];
ti[0] = tmod; ti[0] = tmod;
ti[1] = ArgOfTerm(1,t); ti[1] = ArgOfTerm(1,t);
tf[0] = MkApplTerm(FunctorModule,2,ti); tf[0] = _YAP_MkApplTerm(FunctorModule,2,ti);
ti[0] = tmod; ti[0] = tmod;
ti[1] = ArgOfTerm(2,t); ti[1] = ArgOfTerm(2,t);
tf[1] = MkApplTerm(FunctorModule,2,ti); tf[1] = _YAP_MkApplTerm(FunctorModule,2,ti);
return(MkApplTerm(f,2,tf)); return(_YAP_MkApplTerm(f,2,tf));
} else { } else {
Term ti[2], tf[1]; Term ti[2], tf[1];
ti[0] = tmod; ti[0] = tmod;
ti[1] = ArgOfTerm(1,t); ti[1] = ArgOfTerm(1,t);
tf[0] = MkApplTerm(FunctorModule,2,ti); tf[0] = _YAP_MkApplTerm(FunctorModule,2,ti);
return(MkApplTerm(f,1,tf)); return(_YAP_MkApplTerm(f,1,tf));
} }
} }
@ -259,7 +263,7 @@ do_execute(Term t, SMALLUNSGN mod)
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
@ -334,7 +338,7 @@ p_execute_within(void)
unsigned int arity; unsigned int arity;
Prop pe; Prop pe;
Atom a; Atom a;
SMALLUNSGN mod = LookupModule(tmod); SMALLUNSGN mod = _YAP_LookupModule(tmod);
#ifdef SBA #ifdef SBA
choiceptr cut_pt = (choiceptr)IntegerOfTerm(Deref(ARG2)); choiceptr cut_pt = (choiceptr)IntegerOfTerm(Deref(ARG2));
#else #else
@ -371,7 +375,7 @@ p_execute_within(void)
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
@ -460,7 +464,7 @@ p_execute_within2(void)
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
@ -553,11 +557,11 @@ p_execute0(void)
Term tmod = Deref(ARG2); Term tmod = Deref(ARG2);
unsigned int arity; unsigned int arity;
Prop pe; Prop pe;
SMALLUNSGN mod = LookupModule(tmod); SMALLUNSGN mod = _YAP_LookupModule(tmod);
restart_exec: restart_exec:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,ARG3,"call/1"); _YAP_Error(INSTANTIATION_ERROR,ARG3,"call/1");
return(FALSE); return(FALSE);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
@ -572,7 +576,7 @@ p_execute0(void)
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
@ -598,7 +602,7 @@ p_execute0(void)
#endif #endif
} }
} else { } else {
Error(TYPE_ERROR_CALLABLE,ARG3,"call/1"); _YAP_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
return(FALSE); return(FALSE);
} }
/* N = arity; */ /* N = arity; */
@ -610,7 +614,7 @@ static Int
p_execute_0(void) p_execute_0(void)
{ /* '$execute_0'(Goal) */ { /* '$execute_0'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG2)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG2));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -623,7 +627,7 @@ p_execute_0(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/1"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/1");
return(FALSE); return(FALSE);
} }
pe = PredPropByFunc(f, mod); pe = PredPropByFunc(f, mod);
@ -635,7 +639,7 @@ p_execute_0(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,2), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,2), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[1] = ptr[0]; XREGS[1] = ptr[0];
XREGS[2] = ptr[1]; XREGS[2] = ptr[1];
@ -647,18 +651,18 @@ static Int
p_execute_1(void) p_execute_1(void)
{ /* '$execute_0'(Goal) */ { /* '$execute_0'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG3)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG3));
Prop pe; Prop pe;
if (!IsAtomTerm(t)) { if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/2"); _YAP_Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/2");
return(FALSE); return(FALSE);
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Atom a; Atom a;
a = AtomOfTerm(t); a = AtomOfTerm(t);
ARG1 = ARG2; ARG1 = ARG2;
pe = PredPropByFunc(MkFunctor(a,1),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,1),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -666,12 +670,12 @@ p_execute_1(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+1), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+1), mod);
XREGS[Arity+1] = ARG2; XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1; ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) { for (i=1;i<=Arity;i++) {
@ -680,7 +684,7 @@ p_execute_1(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,3), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,3), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[3] = ARG2; XREGS[3] = ARG2;
XREGS[1] = ptr[0]; XREGS[1] = ptr[0];
@ -693,7 +697,7 @@ static Int
p_execute_2(void) p_execute_2(void)
{ /* '$execute_2'(Goal) */ { /* '$execute_2'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG4)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG4));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -701,7 +705,7 @@ p_execute_2(void)
a = AtomOfTerm(t); a = AtomOfTerm(t);
ARG1 = ARG2; ARG1 = ARG2;
ARG2 = ARG3; ARG2 = ARG3;
pe = PredPropByFunc(MkFunctor(a,2),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,2),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -709,12 +713,12 @@ p_execute_2(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/3"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/3");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+2), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+2), mod);
XREGS[Arity+2] = ARG3; XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2; XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1; ptr = RepAppl(t)+1;
@ -724,7 +728,7 @@ p_execute_2(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,4), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,4), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[4] = ARG3; XREGS[4] = ARG3;
XREGS[3] = ARG2; XREGS[3] = ARG2;
@ -738,11 +742,11 @@ static Int
p_execute_3(void) p_execute_3(void)
{ /* '$execute_3'(Goal) */ { /* '$execute_3'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG5)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG5));
Prop pe; Prop pe;
if (!IsAtomTerm(t)) { if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/4"); _YAP_Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/4");
return(FALSE); return(FALSE);
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -751,7 +755,7 @@ p_execute_3(void)
ARG1 = ARG2; ARG1 = ARG2;
ARG2 = ARG3; ARG2 = ARG3;
ARG3 = ARG4; ARG3 = ARG4;
pe = PredPropByFunc(MkFunctor(a,3),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,3),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -759,12 +763,12 @@ p_execute_3(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+3), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+3), mod);
XREGS[Arity+3] = ARG4; XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3; XREGS[Arity+2] = ARG3;
XREGS[Arity+1] = ARG2; XREGS[Arity+1] = ARG2;
@ -775,7 +779,7 @@ p_execute_3(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,5), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,5), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[5] = ARG4; XREGS[5] = ARG4;
XREGS[4] = ARG3; XREGS[4] = ARG3;
@ -790,7 +794,7 @@ static Int
p_execute_4(void) p_execute_4(void)
{ /* '$execute_4'(Goal) */ { /* '$execute_4'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG6)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG6));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -800,7 +804,7 @@ p_execute_4(void)
ARG2 = ARG3; ARG2 = ARG3;
ARG3 = ARG4; ARG3 = ARG4;
ARG4 = ARG5; ARG4 = ARG5;
pe = PredPropByFunc(MkFunctor(a,4),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,4),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -808,12 +812,12 @@ p_execute_4(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/5"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/5");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+4), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+4), mod);
XREGS[Arity+4] = ARG5; XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4; XREGS[Arity+3] = ARG4;
XREGS[Arity+2] = ARG3; XREGS[Arity+2] = ARG3;
@ -825,7 +829,7 @@ p_execute_4(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,6), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,6), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[6] = ARG5; XREGS[6] = ARG5;
XREGS[5] = ARG4; XREGS[5] = ARG4;
@ -841,7 +845,7 @@ static Int
p_execute_5(void) p_execute_5(void)
{ /* '$execute_5'(Goal) */ { /* '$execute_5'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG7)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG7));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -852,7 +856,7 @@ p_execute_5(void)
ARG3 = ARG4; ARG3 = ARG4;
ARG4 = ARG5; ARG4 = ARG5;
ARG5 = ARG6; ARG5 = ARG6;
pe = PredPropByFunc(MkFunctor(a,5),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,5),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -860,12 +864,12 @@ p_execute_5(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/6"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/6");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+5), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+5), mod);
XREGS[Arity+5] = ARG6; XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5; XREGS[Arity+4] = ARG5;
XREGS[Arity+3] = ARG4; XREGS[Arity+3] = ARG4;
@ -878,7 +882,7 @@ p_execute_5(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,7), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,7), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[7] = ARG6; XREGS[7] = ARG6;
XREGS[6] = ARG5; XREGS[6] = ARG5;
@ -895,7 +899,7 @@ static Int
p_execute_6(void) p_execute_6(void)
{ /* '$execute_6'(Goal) */ { /* '$execute_6'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG8)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG8));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -907,7 +911,7 @@ p_execute_6(void)
ARG4 = ARG5; ARG4 = ARG5;
ARG5 = ARG6; ARG5 = ARG6;
ARG6 = ARG7; ARG6 = ARG7;
pe = PredPropByFunc(MkFunctor(a,6),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,6),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -915,12 +919,12 @@ p_execute_6(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/7"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/7");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+6), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+6), mod);
XREGS[Arity+6] = ARG7; XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6; XREGS[Arity+5] = ARG6;
XREGS[Arity+4] = ARG5; XREGS[Arity+4] = ARG5;
@ -934,7 +938,7 @@ p_execute_6(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,8), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,8), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[8] = ARG7; XREGS[8] = ARG7;
XREGS[7] = ARG6; XREGS[7] = ARG6;
@ -952,7 +956,7 @@ static Int
p_execute_7(void) p_execute_7(void)
{ /* '$execute_7'(Goal) */ { /* '$execute_7'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG9)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG9));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -965,7 +969,7 @@ p_execute_7(void)
ARG5 = ARG6; ARG5 = ARG6;
ARG6 = ARG7; ARG6 = ARG7;
ARG7 = ARG8; ARG7 = ARG8;
pe = PredPropByFunc(MkFunctor(a,7),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,7),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -973,12 +977,12 @@ p_execute_7(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/8"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/8");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+7), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+7), mod);
XREGS[Arity+7] = ARG8; XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7; XREGS[Arity+6] = ARG7;
XREGS[Arity+5] = ARG6; XREGS[Arity+5] = ARG6;
@ -993,7 +997,7 @@ p_execute_7(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,9), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,9), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[9] = ARG8; XREGS[9] = ARG8;
XREGS[8] = ARG7; XREGS[8] = ARG7;
@ -1012,7 +1016,7 @@ static Int
p_execute_8(void) p_execute_8(void)
{ /* '$execute_8'(Goal) */ { /* '$execute_8'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG10)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG10));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1026,7 +1030,7 @@ p_execute_8(void)
ARG6 = ARG7; ARG6 = ARG7;
ARG7 = ARG8; ARG7 = ARG8;
ARG8 = ARG9; ARG8 = ARG9;
pe = PredPropByFunc(MkFunctor(a,8),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,8),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -1034,12 +1038,12 @@ p_execute_8(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/9"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/9");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+8), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+8), mod);
XREGS[Arity+8] = ARG9; XREGS[Arity+8] = ARG9;
XREGS[Arity+7] = ARG8; XREGS[Arity+7] = ARG8;
XREGS[Arity+6] = ARG7; XREGS[Arity+6] = ARG7;
@ -1055,7 +1059,7 @@ p_execute_8(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,10), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,10), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[10] = ARG9; XREGS[10] = ARG9;
XREGS[9] = ARG8; XREGS[9] = ARG8;
@ -1075,7 +1079,7 @@ static Int
p_execute_9(void) p_execute_9(void)
{ /* '$execute_9'(Goal) */ { /* '$execute_9'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG11)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG11));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1090,7 +1094,7 @@ p_execute_9(void)
ARG7 = ARG8; ARG7 = ARG8;
ARG8 = ARG9; ARG8 = ARG9;
ARG9 = ARG10; ARG9 = ARG10;
pe = PredPropByFunc(MkFunctor(a,9),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,9),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -1098,12 +1102,12 @@ p_execute_9(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/10"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/10");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+9), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+9), mod);
XREGS[Arity+9] = ARG10; XREGS[Arity+9] = ARG10;
XREGS[Arity+8] = ARG9; XREGS[Arity+8] = ARG9;
XREGS[Arity+7] = ARG8; XREGS[Arity+7] = ARG8;
@ -1120,7 +1124,7 @@ p_execute_9(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,11), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,11), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[11] = ARG10; XREGS[11] = ARG10;
XREGS[10] = ARG9; XREGS[10] = ARG9;
@ -1141,7 +1145,7 @@ static Int
p_execute_10(void) p_execute_10(void)
{ /* '$execute_10'(Goal) */ { /* '$execute_10'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG12)); SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG12));
Prop pe; Prop pe;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1157,7 +1161,7 @@ p_execute_10(void)
ARG8 = ARG9; ARG8 = ARG9;
ARG9 = ARG10; ARG9 = ARG10;
ARG10 = ARG11; ARG10 = ARG11;
pe = PredPropByFunc(MkFunctor(a,10),mod); pe = PredPropByFunc(_YAP_MkFunctor(a,10),mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Int Arity, i; Int Arity, i;
@ -1165,12 +1169,12 @@ p_execute_10(void)
CELL *ptr; CELL *ptr;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/11"); _YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/11");
return(FALSE); return(FALSE);
} }
Arity = ArityOfFunctor(f); Arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+10), mod); pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+10), mod);
XREGS[Arity+10] = ARG11; XREGS[Arity+10] = ARG11;
XREGS[Arity+9] = ARG10; XREGS[Arity+9] = ARG10;
XREGS[Arity+8] = ARG9; XREGS[Arity+8] = ARG9;
@ -1188,7 +1192,7 @@ p_execute_10(void)
} else { } else {
CELL *ptr; CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,12), mod); pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,12), mod);
ptr = RepPair(t); ptr = RepPair(t);
XREGS[12] = ARG11; XREGS[12] = ARG11;
XREGS[11] = ARG10; XREGS[11] = ARG10;
@ -1211,9 +1215,9 @@ static Int
p_execute_depth_limit(void) { p_execute_depth_limit(void) {
Term d = Deref(ARG2); Term d = Deref(ARG2);
if (IsVarTerm(d)) { if (IsVarTerm(d)) {
Error(INSTANTIATION_ERROR,d,"depth_bound_call/2"); _YAP_Error(INSTANTIATION_ERROR,d,"depth_bound_call/2");
} else if (!IsIntTerm(d)) { } else if (!IsIntTerm(d)) {
Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2"); _YAP_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return(FALSE); return(FALSE);
} }
DEPTH = MkIntTerm(IntOfTerm(d)*2); DEPTH = MkIntTerm(IntOfTerm(d)*2);
@ -1235,7 +1239,7 @@ p_at_execute(void)
unsigned int arity; unsigned int arity;
Prop pe; Prop pe;
Atom a; Atom a;
SMALLUNSGN mod = LookupModule(tmod); SMALLUNSGN mod = _YAP_LookupModule(tmod);
restart_exec: restart_exec:
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
@ -1252,14 +1256,14 @@ p_at_execute(void)
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
if (IsVarTerm(tmod)) { if (IsVarTerm(tmod)) {
Error(INSTANTIATION_ERROR, ARG1, "calling clause in debugger"); _YAP_Error(INSTANTIATION_ERROR, ARG1, "calling clause in debugger");
} }
Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger"); _YAP_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger");
} }
pe = PredPropByFunc(f,mod); pe = PredPropByFunc(f,mod);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) { if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
@ -1292,16 +1296,16 @@ p_at_execute(void)
return (CallClause(RepPredProp(pe), arity, IntOfTerm(t2))); return (CallClause(RepPredProp(pe), arity, IntOfTerm(t2)));
} }
int static int
exec_absmi(int top) exec_absmi(int top)
{ {
int lval; int lval;
if (top && (lval = sigsetjmp (RestartEnv, 1)) != 0) { if (top && (lval = sigsetjmp (_YAP_RestartEnv, 1)) != 0) {
switch(lval) { switch(lval) {
case 1: case 1:
{ /* restart */ { /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */ /* otherwise, SetDBForThrow will fail entering critical mode */
PrologMode = UserMode; _YAP_PrologMode = UserMode;
/* find out where to cut to */ /* find out where to cut to */
#if defined(__GNUC__) #if defined(__GNUC__)
#if defined(hppa) || defined(__alpha) #if defined(hppa) || defined(__alpha)
@ -1316,18 +1320,18 @@ exec_absmi(int top)
yap_flags[SPY_CREEP_FLAG] = 0; yap_flags[SPY_CREEP_FLAG] = 0;
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
PrologMode = UserMode; _YAP_PrologMode = UserMode;
} }
break; break;
case 2: case 2:
{ {
/* arithmetic exception */ /* arithmetic exception */
/* must be done here, otherwise siglongjmp will clobber all the registers */ /* must be done here, otherwise siglongjmp will clobber all the registers */
Error(YAP_matherror,TermNil,NULL); _YAP_Error(_YAP_matherror,TermNil,NULL);
/* reset the registers so that we don't have trash in abstract machine */ /* reset the registers so that we don't have trash in abstract machine */
set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1); _YAP_set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
PrologMode = UserMode; _YAP_PrologMode = UserMode;
} }
break; break;
case 3: case 3:
@ -1336,12 +1340,12 @@ exec_absmi(int top)
} }
default: default:
/* do nothing */ /* do nothing */
PrologMode = UserMode; _YAP_PrologMode = UserMode;
} }
} else { } else {
PrologMode = UserMode; _YAP_PrologMode = UserMode;
} }
return(absmi(0)); return(_YAP_absmi(0));
} }
static int static int
@ -1392,14 +1396,20 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
YENV[E_CB] = Unsigned (B); YENV[E_CB] = Unsigned (B);
P = (yamop *) CodeAdr; P = (yamop *) CodeAdr;
CP = YESCODE; CP = YESCODE;
S = CellPtr (RepPredProp (PredPropByFunc (MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ S = CellPtr (RepPredProp (PredPropByFunc (_YAP_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
return(exec_absmi(top)); return(exec_absmi(top));
} }
int
_YAP_exec_absmi(int top)
{
return exec_absmi(top);
}
Int Int
execute_goal(Term t, int nargs, SMALLUNSGN mod) _YAP_execute_goal(Term t, int nargs, SMALLUNSGN mod)
{ {
Int out; Int out;
CODEADDR CodeAdr; CODEADDR CodeAdr;
@ -1423,7 +1433,7 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) { if (IsBlobFunctor(f)) {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); _YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
@ -1432,7 +1442,7 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
pt = RepAppl(t)+1; pt = RepAppl(t)+1;
pe = PredPropByFunc(f, mod); pe = PredPropByFunc(f, mod);
} else { } else {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); _YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
ppe = RepPredProp(pe); ppe = RepPredProp(pe);
@ -1498,13 +1508,13 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
HB = PROTECT_FROZEN_H(B); HB = PROTECT_FROZEN_H(B);
return(FALSE); return(FALSE);
} else { } else {
Error(SYSTEM_ERROR,TermNil,"emulator crashed"); _YAP_Error(SYSTEM_ERROR,TermNil,"emulator crashed");
return(FALSE); return(FALSE);
} }
} }
void void
trust_last(void) _YAP_trust_last(void)
{ {
ASP = B->cp_env; ASP = B->cp_env;
P = (yamop *)(B->cp_env[E_CP]); P = (yamop *)(B->cp_env[E_CP]);
@ -1523,7 +1533,7 @@ trust_last(void)
} }
int int
RunTopGoal(Term t) _YAP_RunTopGoal(Term t)
{ {
CODEADDR CodeAdr; CODEADDR CodeAdr;
Prop pe; Prop pe;
@ -1543,13 +1553,13 @@ RunTopGoal(Term t)
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) { if (IsBlobFunctor(f)) {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); _YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t); Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod); mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_runtopgoal; goto restart_runtopgoal;
} }
@ -1557,11 +1567,11 @@ RunTopGoal(Term t)
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
pe = GetPredPropByFunc(f, CurrentModule); pe = _YAP_GetPredPropByFunc(f, CurrentModule);
pt = RepAppl(t)+1; pt = RepAppl(t)+1;
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
} else { } else {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); _YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
ppe = RepPredProp(pe); ppe = RepPredProp(pe);
@ -1576,9 +1586,9 @@ RunTopGoal(Term t)
return(FALSE); return(FALSE);
} }
CodeAdr = ppe->CodeOfPred; CodeAdr = ppe->CodeOfPred;
if (TrailTop - HeapTop < 2048) { if (_YAP_TrailTop - HeapTop < 2048) {
PrologMode = BootMode; _YAP_PrologMode = BootMode;
Error(SYSTEM_ERROR,TermNil, _YAP_Error(SYSTEM_ERROR,TermNil,
"unable to boot because of too little heap space"); "unable to boot because of too little heap space");
} }
goal_out = do_goal(CodeAdr, arity, pt, 0, TRUE); goal_out = do_goal(CodeAdr, arity, pt, 0, TRUE);
@ -1607,7 +1617,7 @@ p_restore_regs(void)
{ {
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"support for coroutining"); _YAP_Error(INSTANTIATION_ERROR,t,"support for coroutining");
return(FALSE); return(FALSE);
} }
if (IsAtomTerm(t)) return(TRUE); if (IsAtomTerm(t)) return(TRUE);
@ -1623,7 +1633,7 @@ p_restore_regs2(void)
Term t = Deref(ARG1), d0; Term t = Deref(ARG1), d0;
choiceptr pt0; choiceptr pt0;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"support for coroutining"); _YAP_Error(INSTANTIATION_ERROR,t,"support for coroutining");
return(FALSE); return(FALSE);
} }
d0 = Deref(ARG2); d0 = Deref(ARG2);
@ -1631,7 +1641,7 @@ p_restore_regs2(void)
restore_regs(t); restore_regs(t);
} }
if (IsVarTerm(d0)) { if (IsVarTerm(d0)) {
Error(INSTANTIATION_ERROR,d0,"support for coroutining"); _YAP_Error(INSTANTIATION_ERROR,d0,"support for coroutining");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(d0)) { if (!IsIntegerTerm(d0)) {
@ -1675,7 +1685,7 @@ p_clean_ifcp(void) {
return(TRUE); return(TRUE);
} }
Int static Int
JumpToEnv(Term t) { JumpToEnv(Term t) {
yamop *pos = (yamop *)(PredDollarCatch->LastClause); yamop *pos = (yamop *)(PredDollarCatch->LastClause);
CELL *env; CELL *env;
@ -1704,9 +1714,9 @@ JumpToEnv(Term t) {
if (B == NULL) { if (B == NULL) {
B = B0; B = B0;
#if PUSH_REGS #if PUSH_REGS
restore_absmi_regs(&standard_regs); restore_absmi_regs(&_YAP_standard_regs);
#endif #endif
siglongjmp(RestartEnv,1); siglongjmp(_YAP_RestartEnv,1);
} }
/* is it a continuation? */ /* is it a continuation? */
env = B->cp_env; env = B->cp_env;
@ -1736,6 +1746,10 @@ JumpToEnv(Term t) {
return(FALSE); return(FALSE);
} }
Int
_YAP_JumpToEnv(Term t) {
return JumpToEnv(t);
}
/* This does very nasty stuff!!!!! */ /* This does very nasty stuff!!!!! */
@ -1744,36 +1758,83 @@ p_jump_env(void) {
return(JumpToEnv(Deref(ARG1))); return(JumpToEnv(Deref(ARG1)));
} }
void
void _YAP_InitYaamRegs(void)
InitExecFs(void)
{ {
InitCPred("$execute", 1, p_execute, 0); #if PUSH_REGS
InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0); /* Guarantee that after a longjmp we go back to the original abstract
InitCPred("$execute_within", 4, p_execute_within, 0); machine registers */
InitCPred("$execute_within", 1, p_execute_within2, 0); _YAP_regp = &_YAP_standard_regs;
InitCPred("$last_execute_within", 1, p_execute_within2, 0); #endif /* PUSH_REGS */
InitCPred("$execute", 3, p_at_execute, 0); _YAP_PutValue (AtomBreak, MkIntTerm (0));
InitCPred("$call_with_args", 2, p_execute_0, 0); _YAP_PutValue (AtomIndex, MkAtomTerm (AtomTrue));
InitCPred("$call_with_args", 3, p_execute_1, 0); AuxSp = (CELL *)AuxTop;
InitCPred("$call_with_args", 4, p_execute_2, 0); TR = (tr_fr_ptr)_YAP_TrailBase;
InitCPred("$call_with_args", 5, p_execute_3, 0); #ifdef COROUTINING
InitCPred("$call_with_args", 6, p_execute_4, 0); H = H0 = ((CELL *) _YAP_GlobalBase)+ 2048;
InitCPred("$call_with_args", 7, p_execute_5, 0); #else
InitCPred("$call_with_args", 8, p_execute_6, 0); H = H0 = (CELL *) _YAP_GlobalBase;
InitCPred("$call_with_args", 9, p_execute_7, 0); #endif
InitCPred("$call_with_args", 10, p_execute_8, 0); LCL0 = ASP = (CELL *) _YAP_LocalBase;
InitCPred("$call_with_args", 11, p_execute_9, 0); /* notice that an initial choice-point and environment
InitCPred("$call_with_args", 12, p_execute_10, 0); *must* be created since for the garbage collector to work */
#ifdef DEPTH_LIMIT B = NULL;
InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0); ENV = NULL;
P = CP = YESCODE;
#ifdef DEPTH_LIMIT
DEPTH = RESET_DEPTH();
#endif
STATIC_PREDICATES_MARKED = FALSE;
#ifdef FROZEN_STACKS
H = HB = H0 = H_FZ = H_BASE;
#ifdef SBA
BSEG =
#endif /* SBA */
BBREG = B_FZ = B_BASE;
TR = TR_FZ = TR_BASE;
#endif /* FROZEN_STACKS */
CreepFlag = CalculateStackGap();
EX = 0L;
/* for slots to work */
*--ASP = MkIntTerm(0);
#if COROUTINING
RESET_VARIABLE((CELL *)_YAP_GlobalBase);
DelayedVars = _YAP_NewTimedVar((CELL)_YAP_GlobalBase);
WokenGoals = _YAP_NewTimedVar(TermNil);
MutableList = _YAP_NewTimedVar(TermNil);
AttsMutableList = _YAP_NewTimedVar(TermNil);
#endif #endif
InitCPred("$execute0", 2, p_execute0, 0); }
InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag); void
InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag); _YAP_InitExecFs(void)
InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag); {
InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag); _YAP_InitCPred("$execute", 1, p_execute, 0);
InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0); _YAP_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
_YAP_InitCPred("$execute_within", 4, p_execute_within, 0);
_YAP_InitCPred("$execute_within", 1, p_execute_within2, 0);
_YAP_InitCPred("$last_execute_within", 1, p_execute_within2, 0);
_YAP_InitCPred("$execute", 3, p_at_execute, 0);
_YAP_InitCPred("$call_with_args", 2, p_execute_0, 0);
_YAP_InitCPred("$call_with_args", 3, p_execute_1, 0);
_YAP_InitCPred("$call_with_args", 4, p_execute_2, 0);
_YAP_InitCPred("$call_with_args", 5, p_execute_3, 0);
_YAP_InitCPred("$call_with_args", 6, p_execute_4, 0);
_YAP_InitCPred("$call_with_args", 7, p_execute_5, 0);
_YAP_InitCPred("$call_with_args", 8, p_execute_6, 0);
_YAP_InitCPred("$call_with_args", 9, p_execute_7, 0);
_YAP_InitCPred("$call_with_args", 10, p_execute_8, 0);
_YAP_InitCPred("$call_with_args", 11, p_execute_9, 0);
_YAP_InitCPred("$call_with_args", 12, p_execute_10, 0);
#ifdef DEPTH_LIMIT
_YAP_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
#endif
_YAP_InitCPred("$execute0", 2, p_execute0, 0);
_YAP_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
_YAP_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
_YAP_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);
_YAP_InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag);
_YAP_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
_YAP_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0);
} }

294
C/grow.c
View File

@ -51,6 +51,7 @@ STATIC_PROTO(Int p_inform_stack_overflows, (void));
/* #define undf7 */ /* #define undf7 */
/* #define undf5 */ /* #define undf5 */
STATIC_PROTO(int growstack, (long));
STATIC_PROTO(void MoveGlobal, (void)); STATIC_PROTO(void MoveGlobal, (void));
STATIC_PROTO(void MoveLocalAndTrail, (void)); STATIC_PROTO(void MoveLocalAndTrail, (void));
STATIC_PROTO(void SetHeapRegs, (void)); STATIC_PROTO(void SetHeapRegs, (void));
@ -59,10 +60,12 @@ STATIC_PROTO(void AdjustTrail, (int));
STATIC_PROTO(void AdjustLocal, (void)); STATIC_PROTO(void AdjustLocal, (void));
STATIC_PROTO(void AdjustGlobal, (void)); STATIC_PROTO(void AdjustGlobal, (void));
STATIC_PROTO(void AdjustGrowStack, (void)); STATIC_PROTO(void AdjustGrowStack, (void));
STATIC_PROTO(int local_growheap, (long,int)); STATIC_PROTO(int static_growheap, (long,int));
STATIC_PROTO(void cpcellsd, (CELL *, CELL *, CELL)); STATIC_PROTO(void cpcellsd, (CELL *, CELL *, CELL));
STATIC_PROTO(CELL AdjustAppl, (CELL)); STATIC_PROTO(CELL AdjustAppl, (CELL));
STATIC_PROTO(CELL AdjustPair, (CELL)); STATIC_PROTO(CELL AdjustPair, (CELL));
STATIC_PROTO(void AdjustStacksAndTrail, (void));
STATIC_PROTO(void AdjustRegs, (int));
static void static void
cpcellsd(register CELL *Dest, register CELL *Org, CELL NOf) cpcellsd(register CELL *Dest, register CELL *Org, CELL NOf)
@ -96,24 +99,24 @@ static void
SetHeapRegs(void) SetHeapRegs(void)
{ {
#ifdef undf7 #ifdef undf7
YP_fprintf(YP_stderr,"HeapBase = %x\tHeapTop=%x\nGlobalBase=%x\tGlobalTop=%x\nLocalBase=%x\tLocatTop=%x\n", HeapBase, HeapTop, GlobalBase, H, LCL0, ASP); fprintf(_YAP_stderr,"HeapBase = %x\tHeapTop=%x\nGlobalBase=%x\tGlobalTop=%x\nLocalBase=%x\tLocatTop=%x\n", _YAP_HeapBase, HeapTop, _YAP_GlobalBase, H, LCL0, ASP);
#endif #endif
/* The old stack pointers */ /* The old stack pointers */
OldLCL0 = LCL0; OldLCL0 = LCL0;
OldASP = ASP; OldASP = ASP;
OldGlobalBase = (CELL *)GlobalBase; OldGlobalBase = (CELL *)_YAP_GlobalBase;
OldH = H; OldH = H;
OldH0 = H0; OldH0 = H0;
OldTrailBase = TrailBase; OldTrailBase = _YAP_TrailBase;
OldTrailTop = TrailTop; OldTrailTop = _YAP_TrailTop;
OldTR = TR; OldTR = TR;
OldHeapBase = HeapBase; OldHeapBase = _YAP_HeapBase;
OldHeapTop = HeapTop; OldHeapTop = HeapTop;
/* Adjust stack addresses */ /* Adjust stack addresses */
TrailBase = TrailAddrAdjust(TrailBase); _YAP_TrailBase = TrailAddrAdjust(_YAP_TrailBase);
TrailTop = TrailAddrAdjust(TrailTop); _YAP_TrailTop = TrailAddrAdjust(_YAP_TrailTop);
GlobalBase = DelayAddrAdjust(GlobalBase); _YAP_GlobalBase = DelayAddrAdjust(_YAP_GlobalBase);
LocalBase = LocalAddrAdjust(LocalBase); _YAP_LocalBase = LocalAddrAdjust(_YAP_LocalBase);
AuxSp = PtoDelayAdjust(AuxSp); AuxSp = PtoDelayAdjust(AuxSp);
AuxTop = DelayAddrAdjust(AuxTop); AuxTop = DelayAddrAdjust(AuxTop);
/* The registers pointing to one of the stacks */ /* The registers pointing to one of the stacks */
@ -152,16 +155,16 @@ SetStackRegs(void)
OldASP = ASP; OldASP = ASP;
OldH = H; OldH = H;
OldH0 = H0; OldH0 = H0;
OldGlobalBase = (CELL *)GlobalBase; OldGlobalBase = (CELL *)_YAP_GlobalBase;
OldTrailTop = TrailTop; OldTrailTop = _YAP_TrailTop;
OldTrailBase = TrailBase; OldTrailBase = _YAP_TrailBase;
OldTR = TR; OldTR = TR;
OldHeapBase = HeapBase; OldHeapBase = _YAP_HeapBase;
OldHeapTop = HeapTop; OldHeapTop = HeapTop;
/* The local and aux stack addresses */ /* The local and aux stack addresses */
TrailBase = TrailAddrAdjust(TrailBase); _YAP_TrailBase = TrailAddrAdjust(_YAP_TrailBase);
TrailTop = TrailAddrAdjust(TrailTop); _YAP_TrailTop = TrailAddrAdjust(_YAP_TrailTop);
LocalBase = LocalAddrAdjust(LocalBase); _YAP_LocalBase = LocalAddrAdjust(_YAP_LocalBase);
TR = PtoTRAdjust(TR); TR = PtoTRAdjust(TR);
/* The registers pointing to the local stack */ /* The registers pointing to the local stack */
ENV = PtoLocAdjust(ENV); ENV = PtoLocAdjust(ENV);
@ -197,7 +200,7 @@ MoveGlobal(void)
* absmi.asm * absmi.asm
*/ */
#if HAVE_MEMMOVE #if HAVE_MEMMOVE
cpcellsd((CELL *)GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase); cpcellsd((CELL *)_YAP_GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
#else #else
cpcellsd(H, OldH, OldH - (CELL *)OldGlobalBase); cpcellsd(H, OldH, OldH - (CELL *)OldGlobalBase);
#endif #endif
@ -233,7 +236,7 @@ AdjustAppl(register CELL t0)
#ifdef DEBUG #ifdef DEBUG
else { else {
/* strange cell */ /* strange cell */
/* YP_fprintf(YP_stderr,"[ garbage appl %lx found in stacks by stack shifter ]\n", t0);*/ /* fprintf(_YAP_stderr,"[ garbage appl %lx found in stacks by stack shifter ]\n", t0);*/
} }
#endif #endif
return(t0); return(t0);
@ -253,7 +256,7 @@ AdjustPair(register CELL t0)
else if (IsHeapP(t)) else if (IsHeapP(t))
return (AbsPair(CellPtoHeapAdjust(t))); return (AbsPair(CellPtoHeapAdjust(t)));
#ifdef DEBUG #ifdef DEBUG
/* YP_fprintf(YP_stderr,"[ garbage pair %lx found in stacks by stack shifter ]\n", t0);*/ /* fprintf(_YAP_stderr,"[ garbage pair %lx found in stacks by stack shifter ]\n", t0);*/
#endif #endif
return(t0); return(t0);
} }
@ -265,7 +268,7 @@ AdjustTrail(int adjusting_heap)
ptt = TR; ptt = TR;
/* moving the trail is simple */ /* moving the trail is simple */
while (ptt != (tr_fr_ptr)TrailBase) { while (ptt != (tr_fr_ptr)_YAP_TrailBase) {
register CELL reg = TrailTerm(ptt-1); register CELL reg = TrailTerm(ptt-1);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
register CELL reg2 = TrailVal(ptt-1); register CELL reg2 = TrailVal(ptt-1);
@ -292,7 +295,7 @@ AdjustTrail(int adjusting_heap)
} }
#ifdef DEBUG #ifdef DEBUG
else else
YP_fprintf(YP_stderr,"[ garbage heap ptr %p to %lx found in trail at %p by stack shifter ]\n", ptr, (unsigned long int)*ptr, ptt); fprintf(_YAP_stderr,"[ garbage heap ptr %p to %lx found in trail at %p by stack shifter ]\n", ptr, (unsigned long int)*ptr, ptt);
#endif #endif
} }
} else if (IsPairTerm(reg)) { } else if (IsPairTerm(reg)) {
@ -364,7 +367,7 @@ AdjustGlobal(void)
* to clean the global now that functors are just variables pointing to * to clean the global now that functors are just variables pointing to
* the code * the code
*/ */
pt = CellPtr(GlobalBase); pt = CellPtr(_YAP_GlobalBase);
while (pt < H) { while (pt < H) {
register CELL reg; register CELL reg;
@ -425,7 +428,7 @@ AdjustGlobal(void)
* to the local; the local stack cells and the X terms pointing to the global * to the local; the local stack cells and the X terms pointing to the global
* (just once) the trail cells pointing both to the global and to the local * (just once) the trail cells pointing both to the global and to the local
*/ */
void static void
AdjustStacksAndTrail(void) AdjustStacksAndTrail(void)
{ {
AdjustTrail(TRUE); AdjustTrail(TRUE);
@ -433,6 +436,12 @@ AdjustStacksAndTrail(void)
AdjustGlobal(); AdjustGlobal();
} }
void
_YAP_AdjustStacksAndTrail(void)
{
AdjustStacksAndTrail();
}
/* /*
* When growing the stack we need to adjust: the local cells pointing to the * When growing the stack we need to adjust: the local cells pointing to the
* local; the trail cells pointing to the local * local; the trail cells pointing to the local
@ -444,7 +453,7 @@ AdjustGrowStack(void)
AdjustLocal(); AdjustLocal();
} }
void static void
AdjustRegs(int n) AdjustRegs(int n)
{ {
int i; int i;
@ -471,26 +480,32 @@ AdjustRegs(int n)
} }
} }
void
_YAP_AdjustRegs(int n)
{
AdjustRegs(n);
}
/* Used by do_goal() when we're short of heap space */ /* Used by do_goal() when we're short of heap space */
static int static int
local_growheap(long size, int fix_code) static_growheap(long size, int fix_code)
{ {
Int start_growth_time, growth_time; Int start_growth_time, growth_time;
int gc_verbose; int gc_verbose;
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
size = AdjustPageSize(size); size = AdjustPageSize(size);
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) { if (!_YAP_ExtendWorkSpace(size)) {
strncat(ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE); strncat(_YAP_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
return(FALSE); return(FALSE);
} }
start_growth_time = cputime(); start_growth_time = _YAP_cputime();
gc_verbose = is_gc_verbose(); gc_verbose = _YAP_is_gc_verbose();
heap_overflows++; heap_overflows++;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[HO] Heap overflow %d\n", heap_overflows); fprintf(_YAP_stderr, "[HO] Heap overflow %d\n", heap_overflows);
YP_fprintf(YP_stderr, "[HO] growing the heap %ld bytes\n", size); fprintf(_YAP_stderr, "[HO] growing the heap %ld bytes\n", size);
} }
ASP -= 256; ASP -= 256;
TrDiff = LDiff = GDiff = DelayDiff = size; TrDiff = LDiff = GDiff = DelayDiff = size;
@ -510,35 +525,35 @@ local_growheap(long size, int fix_code)
AdjustRegs(MaxTemps); AdjustRegs(MaxTemps);
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
ASP += 256; ASP += 256;
growth_time = cputime()-start_growth_time; growth_time = _YAP_cputime()-start_growth_time;
total_heap_overflow_time += growth_time; total_heap_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[HO] took %g sec\n", (double)growth_time/1000); fprintf(_YAP_stderr, "[HO] took %g sec\n", (double)growth_time/1000);
YP_fprintf(YP_stderr, "[HO] Total of %g sec expanding heap \n", (double)total_heap_overflow_time/1000); fprintf(_YAP_stderr, "[HO] Total of %g sec expanding heap \n", (double)total_heap_overflow_time/1000);
} }
return(TRUE); return(TRUE);
} }
/* Used by do_goal() when we're short of heap space */ /* Used by do_goal() when we're short of heap space */
static int static int
local_growglobal(long size, CELL **ptr) static_growglobal(long size, CELL **ptr)
{ {
Int start_growth_time, growth_time; Int start_growth_time, growth_time;
int gc_verbose; int gc_verbose;
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
size = AdjustPageSize(size); size = AdjustPageSize(size);
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) { if (!_YAP_ExtendWorkSpace(size)) {
strncat(ErrorMessage,": global crashed against local", MAX_ERROR_MSG_SIZE); strncat(_YAP_ErrorMessage,": global crashed against local", MAX_ERROR_MSG_SIZE);
return(FALSE); return(FALSE);
} }
start_growth_time = cputime(); start_growth_time = _YAP_cputime();
gc_verbose = is_gc_verbose(); gc_verbose = _YAP_is_gc_verbose();
delay_overflows++; delay_overflows++;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[DO] Delay overflow %d\n", delay_overflows); fprintf(_YAP_stderr, "[DO] Delay overflow %d\n", delay_overflows);
YP_fprintf(YP_stderr, "[DO] growing the stacks %ld bytes\n", size); fprintf(_YAP_stderr, "[DO] growing the stacks %ld bytes\n", size);
} }
ASP -= 256; ASP -= 256;
TrDiff = LDiff = GDiff = size; TrDiff = LDiff = GDiff = size;
@ -553,23 +568,23 @@ local_growglobal(long size, CELL **ptr)
*ptr = PtoLocAdjust(*ptr); *ptr = PtoLocAdjust(*ptr);
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
ASP += 256; ASP += 256;
growth_time = cputime()-start_growth_time; growth_time = _YAP_cputime()-start_growth_time;
total_delay_overflow_time += growth_time; total_delay_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[DO] took %g sec\n", (double)growth_time/1000); fprintf(_YAP_stderr, "[DO] took %g sec\n", (double)growth_time/1000);
YP_fprintf(YP_stderr, "[DO] Total of %g sec expanding stacks \n", (double)total_delay_overflow_time/1000); fprintf(_YAP_stderr, "[DO] Total of %g sec expanding stacks \n", (double)total_delay_overflow_time/1000);
} }
return(TRUE); return(TRUE);
} }
static void static void
fix_compiler_instructions(PInstr *cpc) fix_compiler_instructions(PInstr *pcpc)
{ {
while (cpc != NULL) { while (pcpc != NULL) {
PInstr *ncpc = cpc->nextInst; PInstr *ncpc = pcpc->nextInst;
switch(cpc->op) { switch(pcpc->op) {
/* check c_var for functions that point at variables */ /* check c_var for functions that point at variables */
case get_var_op: case get_var_op:
case get_val_op: case get_val_op:
@ -589,17 +604,17 @@ fix_compiler_instructions(PInstr *cpc)
case save_appl_op: case save_appl_op:
case save_b_op: case save_b_op:
case comit_b_op: case comit_b_op:
cpc->rnd1 = GlobalAdjust(cpc->rnd1); pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
break; break;
default: default:
/* hopefully nothing to do */ /* hopefully nothing to do */
break; break;
} }
if (ncpc != NULL) { if (ncpc != NULL) {
ncpc = (PInstr *)GlobalAddrAdjust((ADDR)(cpc->nextInst)); ncpc = (PInstr *)GlobalAddrAdjust((ADDR)(pcpc->nextInst));
cpc->nextInst = ncpc; pcpc->nextInst = ncpc;
} }
cpc = ncpc; pcpc = ncpc;
} }
} }
@ -629,7 +644,7 @@ fix_tabling_info(void)
#endif /* TABLING */ #endif /* TABLING */
int int
growheap(int fix_code) _YAP_growheap(int fix_code)
{ {
unsigned long size = sizeof(CELL) * 16 * 1024L; unsigned long size = sizeof(CELL) * 16 * 1024L;
int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows); int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows);
@ -637,28 +652,28 @@ growheap(int fix_code)
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot grow Heap: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
if (SizeOfOverflow > sz) if (SizeOfOverflow > sz)
sz = AdjustPageSize(SizeOfOverflow); sz = AdjustPageSize(SizeOfOverflow);
while(sz >= sizeof(CELL) * 16 * 1024L && !local_growheap(sz, fix_code)) { while(sz >= sizeof(CELL) * 16 * 1024L && !static_growheap(sz, fix_code)) {
size = size/2; size = size/2;
sz = size << shift_factor; sz = size << shift_factor;
} }
/* we must fix an instruction chain */ /* we must fix an instruction chain */
if (fix_code) { if (fix_code) {
PInstr *cpc = CodeStart; PInstr *pcpc = CodeStart;
if (cpc != NULL) { if (pcpc != NULL) {
CodeStart = cpc = (PInstr *)GlobalAddrAdjust((ADDR)cpc); CodeStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
} }
fix_compiler_instructions(cpc); fix_compiler_instructions(pcpc);
cpc = BlobsStart; pcpc = BlobsStart;
if (cpc != NULL) { if (pcpc != NULL) {
BlobsStart = cpc = (PInstr *)GlobalAddrAdjust((ADDR)cpc); BlobsStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
} }
fix_compiler_instructions(cpc); fix_compiler_instructions(pcpc);
freep = (char *)GlobalAddrAdjust((ADDR)freep); freep = (char *)GlobalAddrAdjust((ADDR)freep);
label_offset = (int *)GlobalAddrAdjust((ADDR)label_offset); label_offset = (int *)GlobalAddrAdjust((ADDR)label_offset);
} }
@ -673,17 +688,17 @@ growheap(int fix_code)
} }
int int
growglobal(CELL **ptr) _YAP_growglobal(CELL **ptr)
{ {
unsigned long sz = sizeof(CELL) * 16 * 1024L; unsigned long sz = sizeof(CELL) * 16 * 1024L;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot grow Global: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot grow Global: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
if (!local_growglobal(sz, ptr)) if (!static_growglobal(sz, ptr))
return(FALSE); return(FALSE);
#ifdef TABLING #ifdef TABLING
fix_tabling_info(); fix_tabling_info();
@ -693,7 +708,7 @@ growglobal(CELL **ptr)
/* Used by do_goal() when we're short of stack space */ /* Used by do_goal() when we're short of stack space */
int static int
growstack(long size) growstack(long size)
{ {
Int start_growth_time, growth_time; Int start_growth_time, growth_time;
@ -701,27 +716,27 @@ growstack(long size)
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot grow Local: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot grow Local: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
size = AdjustPageSize(size); size = AdjustPageSize(size);
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) { if (!_YAP_ExtendWorkSpace(size)) {
strncat(ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE); strncat(_YAP_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE); return(FALSE);
} }
start_growth_time = cputime(); start_growth_time = _YAP_cputime();
gc_verbose = is_gc_verbose(); gc_verbose = _YAP_is_gc_verbose();
stack_overflows++; stack_overflows++;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[SO] Stack Overflow %d\n", stack_overflows); fprintf(_YAP_stderr, "[SO] Stack Overflow %d\n", stack_overflows);
YP_fprintf(YP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)GlobalBase),GlobalBase,H); fprintf(_YAP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)_YAP_GlobalBase),_YAP_GlobalBase,H);
YP_fprintf(YP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(_YAP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
YP_fprintf(YP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n", fprintf(_YAP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)_YAP_TrailBase),_YAP_TrailBase,TR);
YP_fprintf(YP_stderr, "[SO] growing the stacks %ld bytes\n", size); fprintf(_YAP_stderr, "[SO] growing the stacks %ld bytes\n", size);
} }
TrDiff = LDiff = size; TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0; XDiff = HDiff = GDiff = DelayDiff = 0;
@ -737,15 +752,21 @@ growstack(long size)
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
ASP += 256; ASP += 256;
growth_time = cputime()-start_growth_time; growth_time = _YAP_cputime()-start_growth_time;
total_stack_overflow_time += growth_time; total_stack_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[SO] took %g sec\n", (double)growth_time/1000); fprintf(_YAP_stderr, "[SO] took %g sec\n", (double)growth_time/1000);
YP_fprintf(YP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000); fprintf(_YAP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
} }
return(TRUE); return(TRUE);
} }
int
_YAP_growstack(long size)
{
return growstack(size);
}
static void static void
AdjustVarTable(VarEntry *ves) AdjustVarTable(VarEntry *ves)
{ {
@ -798,9 +819,9 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep)
ves = *vep = (VarEntry *)TrailAddrAdjust((ADDR)ves); ves = *vep = (VarEntry *)TrailAddrAdjust((ADDR)ves);
AdjustVarTable(ves); AdjustVarTable(ves);
} }
ves = AnonVarTable; ves = _YAP_AnonVarTable;
if (ves != NULL) { if (ves != NULL) {
ves = AnonVarTable = VarEntryAdjust(ves); ves = _YAP_AnonVarTable = VarEntryAdjust(ves);
} }
while (ves != NULL) { while (ves != NULL) {
VarEntry *vetmp = ves->VarLeft; VarEntry *vetmp = ves->VarLeft;
@ -815,35 +836,35 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep)
/* Used by parser when we're short of stack space */ /* Used by parser when we're short of stack space */
int int
growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep) _YAP_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
{ {
Int start_growth_time, growth_time; Int start_growth_time, growth_time;
int gc_verbose; int gc_verbose;
long size = sizeof(CELL)*(LCL0-(CELL *)GlobalBase); long size = sizeof(CELL)*(LCL0-(CELL *)_YAP_GlobalBase);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot grow Parser Stack: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot grow Parser Stack: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
size = AdjustPageSize(size); size = AdjustPageSize(size);
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) { if (!_YAP_ExtendWorkSpace(size)) {
strncat(ErrorMessage,": parser stack overflowed", MAX_ERROR_MSG_SIZE); strncat(_YAP_ErrorMessage,": parser stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE); return(FALSE);
} }
start_growth_time = cputime(); start_growth_time = _YAP_cputime();
gc_verbose = is_gc_verbose(); gc_verbose = _YAP_is_gc_verbose();
stack_overflows++; stack_overflows++;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[SO] Stack overflow %d\n", stack_overflows); fprintf(_YAP_stderr, "[SO] Stack overflow %d\n", stack_overflows);
YP_fprintf(YP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)GlobalBase),(CELL *)GlobalBase,H); fprintf(_YAP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)_YAP_GlobalBase),(CELL *)_YAP_GlobalBase,H);
YP_fprintf(YP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(_YAP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
YP_fprintf(YP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n", fprintf(_YAP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)_YAP_TrailBase),_YAP_TrailBase,TR);
YP_fprintf(YP_stderr, "[SO] growing the stacks %ld bytes\n", size); fprintf(_YAP_stderr, "[SO] growing the stacks %ld bytes\n", size);
} }
TrDiff = LDiff = size; TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0; XDiff = HDiff = GDiff = DelayDiff = 0;
@ -864,11 +885,11 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
ASP += 256; ASP += 256;
growth_time = cputime()-start_growth_time; growth_time = _YAP_cputime()-start_growth_time;
total_stack_overflow_time += growth_time; total_stack_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[SO] took %g sec\n", (double)growth_time/1000); fprintf(_YAP_stderr, "[SO] took %g sec\n", (double)growth_time/1000);
YP_fprintf(YP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000); fprintf(_YAP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
} }
return(TRUE); return(TRUE);
} }
@ -876,14 +897,14 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
/* Used by do_goal() when we're short of stack space */ /* Used by do_goal() when we're short of stack space */
int int
growtrail(long size) _YAP_growtrail(long size)
{ {
Int start_growth_time = cputime(), growth_time; Int start_growth_time = _YAP_cputime(), growth_time;
int gc_verbose = is_gc_verbose(); int gc_verbose = _YAP_is_gc_verbose();
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot grow trail: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot grow trail: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
@ -891,22 +912,22 @@ growtrail(long size)
size = AdjustPageSize(size); size = AdjustPageSize(size);
trail_overflows++; trail_overflows++;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[TO] Trail overflow %d\n", trail_overflows); fprintf(_YAP_stderr, "[TO] Trail overflow %d\n", trail_overflows);
YP_fprintf(YP_stderr, "[TO] growing the trail %ld bytes\n", size); fprintf(_YAP_stderr, "[TO] growing the trail %ld bytes\n", size);
} }
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) { if (!_YAP_ExtendWorkSpace(size)) {
strncat(ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE); strncat(_YAP_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE); return(FALSE);
} }
YAPEnterCriticalSection(); YAPEnterCriticalSection();
TrailTop += size; _YAP_TrailTop += size;
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
growth_time = cputime()-start_growth_time; growth_time = _YAP_cputime()-start_growth_time;
total_trail_overflow_time += growth_time; total_trail_overflow_time += growth_time;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[TO] took %g sec\n", (double)growth_time/1000); fprintf(_YAP_stderr, "[TO] took %g sec\n", (double)growth_time/1000);
YP_fprintf(YP_stderr, "[TO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000); fprintf(_YAP_stderr, "[TO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
} }
return(TRUE); return(TRUE);
} }
@ -918,7 +939,7 @@ p_inform_trail_overflows(void)
Term tn = MkIntTerm(trail_overflows); Term tn = MkIntTerm(trail_overflows);
Term tt = MkIntegerTerm(total_trail_overflow_time); Term tt = MkIntegerTerm(total_trail_overflow_time);
return(unify(tn, ARG1) && unify(tt, ARG2)); return(_YAP_unify(tn, ARG1) && _YAP_unify(tt, ARG2));
} }
/* :- grow_heap(Size) */ /* :- grow_heap(Size) */
@ -929,17 +950,17 @@ p_growheap(void)
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "grow_heap/1"); _YAP_Error(INSTANTIATION_ERROR, t1, "grow_heap/1");
return(FALSE); return(FALSE);
} else if (!IsIntTerm(t1)) { } else if (!IsIntTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1, "grow_heap/1"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "grow_heap/1");
return(FALSE); return(FALSE);
} }
diff = IntOfTerm(t1); diff = IntOfTerm(t1);
if (diff < 0) { if (diff < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t1, "grow_heap/1"); _YAP_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t1, "grow_heap/1");
} }
return(local_growheap(diff, FALSE)); return(static_growheap(diff, FALSE));
} }
static Int static Int
@ -948,7 +969,7 @@ p_inform_heap_overflows(void)
Term tn = MkIntTerm(heap_overflows); Term tn = MkIntTerm(heap_overflows);
Term tt = MkIntegerTerm(total_heap_overflow_time); Term tt = MkIntegerTerm(total_heap_overflow_time);
return(unify(tn, ARG1) && unify(tt, ARG2)); return(_YAP_unify(tn, ARG1) && _YAP_unify(tt, ARG2));
} }
/* :- grow_stack(Size) */ /* :- grow_stack(Size) */
@ -959,15 +980,15 @@ p_growstack(void)
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "grow_stack/1"); _YAP_Error(INSTANTIATION_ERROR, t1, "grow_stack/1");
return(FALSE); return(FALSE);
} else if (!IsIntTerm(t1)) { } else if (!IsIntTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1, "grow_stack/1"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "grow_stack/1");
return(FALSE); return(FALSE);
} }
diff = IntOfTerm(t1); diff = IntOfTerm(t1);
if (diff < 0) { if (diff < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t1, "grow_stack/1"); _YAP_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t1, "grow_stack/1");
} }
return(growstack(diff)); return(growstack(diff));
} }
@ -978,11 +999,12 @@ p_inform_stack_overflows(void)
Term tn = MkIntTerm(stack_overflows); Term tn = MkIntTerm(stack_overflows);
Term tt = MkIntegerTerm(total_stack_overflow_time); Term tt = MkIntegerTerm(total_stack_overflow_time);
return(unify(tn, ARG1) && unify(tt, ARG2)); return(_YAP_unify(tn, ARG1) && _YAP_unify(tt, ARG2));
} }
Int total_stack_shift_time(void) Int
_YAP_total_stack_shift_time(void)
{ {
return(total_heap_overflow_time+ return(total_heap_overflow_time+
total_stack_overflow_time+ total_stack_overflow_time+
@ -990,13 +1012,13 @@ Int total_stack_shift_time(void)
} }
void void
InitGrowPreds(void) _YAP_InitGrowPreds(void)
{ {
InitCPred("$grow_heap", 1, p_growheap, SafePredFlag); _YAP_InitCPred("$grow_heap", 1, p_growheap, SafePredFlag);
InitCPred("$grow_stack", 1, p_growstack, SafePredFlag); _YAP_InitCPred("$grow_stack", 1, p_growstack, SafePredFlag);
InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag); _YAP_InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag);
InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag); _YAP_InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag);
InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag); _YAP_InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag);
init_gc(); _YAP_init_gc();
init_agc(); _YAP_init_agc();
} }

273
C/heapgc.c
View File

@ -41,7 +41,7 @@ static Int tot_gc_time = 0; /* total time spent in GC */
static Int tot_gc_recovered = 0; /* number of heap objects in all garbage collections */ static Int tot_gc_recovered = 0; /* number of heap objects in all garbage collections */
/* in a single gc */ /* in a single gc */
Int total_marked; /* number of heap objects marked */ static Int total_marked; /* number of heap objects marked */
struct gc_ma_h_entry *live_list; struct gc_ma_h_entry *live_list;
@ -77,6 +77,7 @@ STATIC_PROTO(void sweep_choicepoints, (choiceptr));
STATIC_PROTO(choiceptr update_B_H, (choiceptr, CELL *, CELL *, CELL *)); STATIC_PROTO(choiceptr update_B_H, (choiceptr, CELL *, CELL *, CELL *));
STATIC_PROTO(void compact_heap, (void)); STATIC_PROTO(void compact_heap, (void));
STATIC_PROTO(void update_relocation_chain, (CELL *, CELL *)); STATIC_PROTO(void update_relocation_chain, (CELL *, CELL *));
STATIC_PROTO(int is_gc_verbose, (void));
STATIC_PROTO(int is_gc_very_verbose, (void)); STATIC_PROTO(int is_gc_very_verbose, (void));
#include "heapgc.h" #include "heapgc.h"
@ -103,8 +104,8 @@ PUSH_CONTINUATION(CELL *v, int nof) {
if (nof == 0) return; if (nof == 0) return;
x = cont_top; x = cont_top;
x++; x++;
if ((ADDR)x > TrailTop-1024) if ((ADDR)x > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
x->v = v; x->v = v;
x->nof = nof; x->nof = nof;
cont_top = x; cont_top = x;
@ -287,8 +288,8 @@ static inline struct gc_ma_h_entry *
GC_ALLOC_NEW_MASPACE(void) GC_ALLOC_NEW_MASPACE(void)
{ {
gc_ma_h_inner_struct *new = gc_ma_h_top; gc_ma_h_inner_struct *new = gc_ma_h_top;
if ((char *)gc_ma_h_top > TrailTop-1024) if ((char *)gc_ma_h_top > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
gc_ma_h_top++; gc_ma_h_top++;
cont_top = (cont *)gc_ma_h_top; cont_top = (cont *)gc_ma_h_top;
#ifdef EASY_SHUNTING #ifdef EASY_SHUNTING
@ -385,8 +386,8 @@ push_registers(Int num_regs, yamop *nextop)
for (i = 1; i <= num_regs; i++) for (i = 1; i <= num_regs; i++)
TrailTerm(TR++) = (CELL) XREGS[i]; TrailTerm(TR++) = (CELL) XREGS[i];
/* push any live registers we might have hanging around */ /* push any live registers we might have hanging around */
if (nextop->opc == opcode(_move_back) || if (nextop->opc == _YAP_opcode(_move_back) ||
nextop->opc == opcode(_skip)) { nextop->opc == _YAP_opcode(_skip)) {
CELL *lab = (CELL *)(nextop->u.l.l); CELL *lab = (CELL *)(nextop->u.l.l);
CELL max = lab[0]; CELL max = lab[0];
Int curr = lab[1]; Int curr = lab[1];
@ -436,8 +437,8 @@ pop_registers(Int num_regs, yamop *nextop)
for (i = 1; i <= num_regs; i++) for (i = 1; i <= num_regs; i++)
XREGS[i] = TrailTerm(ptr++); XREGS[i] = TrailTerm(ptr++);
/* pop any live registers we might have hanging around */ /* pop any live registers we might have hanging around */
if (nextop->opc == opcode(_move_back) || if (nextop->opc == _YAP_opcode(_move_back) ||
nextop->opc == opcode(_skip)) { nextop->opc == _YAP_opcode(_skip)) {
CELL *lab = (CELL *)(nextop->u.l.l); CELL *lab = (CELL *)(nextop->u.l.l);
CELL max = lab[0]; CELL max = lab[0];
Int curr = lab[1]; Int curr = lab[1];
@ -495,10 +496,10 @@ store_ref_in_dbtable(DBRef entry)
dbentry parent = db_vec0; dbentry parent = db_vec0;
dbentry new = db_vec; dbentry new = db_vec;
if ((ADDR)new > TrailTop-1024) if ((ADDR)new > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
new->val = entry; new->val = entry;
new->lim = (CELL *)((CODEADDR)entry+SizeOfBlock((CODEADDR)entry)); new->lim = (CELL *)((CODEADDR)entry+_YAP_SizeOfBlock((CODEADDR)entry));
new->left = new->right = NULL; new->left = new->right = NULL;
if (db_vec == db_vec0) { if (db_vec == db_vec0) {
db_vec++; db_vec++;
@ -531,10 +532,10 @@ store_cl_in_dbtable(Clause *cl)
dbentry parent = db_vec0; dbentry parent = db_vec0;
dbentry new = db_vec; dbentry new = db_vec;
if ((ADDR)new > TrailTop-1024) if ((ADDR)new > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
new->val = (DBRef)cl; new->val = (DBRef)cl;
new->lim = (CELL *)((CODEADDR)cl + SizeOfBlock((CODEADDR)cl)); new->lim = (CELL *)((CODEADDR)cl + _YAP_SizeOfBlock((CODEADDR)cl));
new->left = new->right = NULL; new->left = new->right = NULL;
if (db_vec == db_vec0) { if (db_vec == db_vec0) {
db_vec++; db_vec++;
@ -592,7 +593,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
Clause *cl = DeadClauses; Clause *cl = DeadClauses;
db_vec0 = db_vec = (dbentry)TR; db_vec0 = db_vec = (dbentry)TR;
while (trail_ptr > (tr_fr_ptr)TrailBase) { while (trail_ptr > (tr_fr_ptr)_YAP_TrailBase) {
register CELL trail_cell; register CELL trail_cell;
trail_ptr--; trail_ptr--;
@ -611,7 +612,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
#ifdef SBA #ifdef SBA
(ADDR) pt0 >= HeapTop (ADDR) pt0 >= HeapTop
#else #else
(ADDR) pt0 >= TrailBase (ADDR) pt0 >= _YAP_TrailBase
#endif #endif
) { ) {
continue; continue;
@ -690,17 +691,17 @@ inc_vars_of_type(CELL *curr,gc_types val) {
static void static void
put_type_info(unsigned long total) put_type_info(unsigned long total)
{ {
YP_fprintf(YP_stderr,"[GC] type info for %lu cells\n", total); fprintf(_YAP_stderr,"[GC] type info for %lu cells\n", total);
YP_fprintf(YP_stderr,"[GC] %lu vars\n", vars[gc_var]); fprintf(_YAP_stderr,"[GC] %lu vars\n", vars[gc_var]);
YP_fprintf(YP_stderr,"[GC] %lu refs\n", vars[gc_ref]); fprintf(_YAP_stderr,"[GC] %lu refs\n", vars[gc_ref]);
YP_fprintf(YP_stderr,"[GC] %lu references from env\n", env_vars); fprintf(_YAP_stderr,"[GC] %lu references from env\n", env_vars);
YP_fprintf(YP_stderr,"[GC] %lu atoms\n", vars[gc_atom]); fprintf(_YAP_stderr,"[GC] %lu atoms\n", vars[gc_atom]);
YP_fprintf(YP_stderr,"[GC] %lu small ints\n", vars[gc_int]); fprintf(_YAP_stderr,"[GC] %lu small ints\n", vars[gc_int]);
YP_fprintf(YP_stderr,"[GC] %lu other numbers\n", vars[gc_num]); fprintf(_YAP_stderr,"[GC] %lu other numbers\n", vars[gc_num]);
YP_fprintf(YP_stderr,"[GC] %lu lists\n", vars[gc_list]); fprintf(_YAP_stderr,"[GC] %lu lists\n", vars[gc_list]);
YP_fprintf(YP_stderr,"[GC] %lu compound terms\n", vars[gc_appl]); fprintf(_YAP_stderr,"[GC] %lu compound terms\n", vars[gc_appl]);
YP_fprintf(YP_stderr,"[GC] %lu functors\n", vars[gc_func]); fprintf(_YAP_stderr,"[GC] %lu functors\n", vars[gc_func]);
YP_fprintf(YP_stderr,"[GC] %lu suspensions\n", vars[gc_susp]); fprintf(_YAP_stderr,"[GC] %lu suspensions\n", vars[gc_susp]);
} }
static void static void
@ -821,7 +822,7 @@ check_global(void) {
/* mark a heap object and all heap objects accessible from it */ /* mark a heap object and all heap objects accessible from it */
void static void
mark_variable(CELL_PTR current) mark_variable(CELL_PTR current)
{ {
CELL_PTR next; CELL_PTR next;
@ -893,7 +894,7 @@ mark_variable(CELL_PTR current)
} }
#ifdef DEBUG #ifdef DEBUG
else if (next < (CELL *)AtomBase || next < (CELL *)HeapTop) else if (next < (CELL *)AtomBase || next < (CELL *)HeapTop)
YP_fprintf(YP_stderr, "ooops while marking %lx, %p at %p\n", (unsigned long int)ccur, current, next); fprintf(_YAP_stderr, "ooops while marking %lx, %p at %p\n", (unsigned long int)ccur, current, next);
#endif #endif
#ifdef INSTRUMENT_GC #ifdef INSTRUMENT_GC
else else
@ -1004,7 +1005,13 @@ mark_variable(CELL_PTR current)
POP_CONTINUATION(); POP_CONTINUATION();
} }
void void
_YAP_mark_variable(CELL_PTR current)
{
mark_variable(current);
}
static void
mark_external_reference(CELL *ptr) { mark_external_reference(CELL *ptr) {
CELL reg = *ptr; CELL reg = *ptr;
@ -1076,6 +1083,11 @@ mark_external_reference(CELL *ptr) {
* general purpose registers) * general purpose registers)
*/ */
void
_YAP_mark_external_reference(CELL *ptr) {
mark_external_reference(ptr);
}
static void static void
mark_regs(tr_fr_ptr old_TR) mark_regs(tr_fr_ptr old_TR)
{ {
@ -1092,7 +1104,7 @@ mark_regs(tr_fr_ptr old_TR)
static void static void
mark_delays(CELL *max) mark_delays(CELL *max)
{ {
CELL *ptr = (CELL *)GlobalBase; CELL *ptr = (CELL *)_YAP_GlobalBase;
for (; ptr < max; ptr++) { for (; ptr < max; ptr++) {
mark_external_reference(ptr); mark_external_reference(ptr);
} }
@ -1113,7 +1125,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
#ifdef DEBUG #ifdef DEBUG
if (size < 0 || size > 512) if (size < 0 || size > 512)
YP_fprintf(YP_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size); fprintf(_YAP_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size);
#endif #endif
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) { if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) {
cl->ClFlags |= GcFoundMask; cl->ClFlags |= GcFoundMask;
@ -1182,12 +1194,12 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
#if 0 #if 0
if (size < 0) { if (size < 0) {
PredEntry *pe = EnvPreg(gc_ENV[E_CP]); PredEntry *pe = EnvPreg(gc_ENV[E_CP]);
op_numbers op = op_from_opcode(ENV_ToOp(gc_ENV[E_CP])); op_numbers op = _YAP_op_from_opcode(ENV_ToOp(gc_ENV[E_CP]));
YP_fprintf(YP_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, op_names[op]); fprintf(_YAP_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, op_names[op]);
if (pe->ArityOfPE) if (pe->ArityOfPE)
YP_fprintf(YP_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE); fprintf(_YAP_stderr," %s/%d\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE);
else else
YP_fprintf(YP_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE); fprintf(_YAP_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE);
} }
#endif #endif
gc_ENV = (CELL_PTR) gc_ENV[E_E]; /* link to prev gc_ENV = (CELL_PTR) gc_ENV[E_E]; /* link to prev
@ -1249,7 +1261,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
/* I decided to allow pointers from the Heap back into the trail. /* I decided to allow pointers from the Heap back into the trail.
The point of doing so is to have dynamic arrays */ The point of doing so is to have dynamic arrays */
mark_external_reference(hp); mark_external_reference(hp);
} else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)TrailBase) { } else if ((hp < (CELL *)gc_B && hp >= gc_H) || hp > (CELL *)_YAP_TrailBase) {
/* clean the trail, avoid dangling pointers! */ /* clean the trail, avoid dangling pointers! */
RESET_VARIABLE(&TrailTerm(trail_ptr)); RESET_VARIABLE(&TrailTerm(trail_ptr));
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
@ -1268,8 +1280,8 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
tr_fr_ptr nsTR = (tr_fr_ptr)cont_top0; tr_fr_ptr nsTR = (tr_fr_ptr)cont_top0;
CELL *cptr = (CELL *)trail_cell; CELL *cptr = (CELL *)trail_cell;
if ((ADDR)nsTR > TrailTop-1024) if ((ADDR)nsTR > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
TrailTerm(nsTR) = (CELL)NULL; TrailTerm(nsTR) = (CELL)NULL;
TrailTerm(nsTR+1) = *hp; TrailTerm(nsTR+1) = *hp;
TrailTerm(nsTR+2) = trail_cell; TrailTerm(nsTR+2) = trail_cell;
@ -1444,7 +1456,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
#endif #endif
{ {
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = _YAP_op_from_opcode(op);
} }
if (very_verbose) { if (very_verbose) {
switch (opnum) { switch (opnum) {
@ -1469,13 +1481,13 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
Atom at; Atom at;
Int arity; Int arity;
SMALLUNSGN mod; SMALLUNSGN mod;
if (PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod)) { if (_YAP_PredForCode((CODEADDR)gc_B->cp_ap, &at, &arity, &mod)) {
if (arity) if (arity)
YP_fprintf(YP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
else else
YP_fprintf(YP_stderr,"[GC] %s marked %d (%s)\n", RepAtom(at)->StrOfAE, total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] %s marked %d (%s)\n", RepAtom(at)->StrOfAE, total_marked, op_names[opnum]);
} else } else
YP_fprintf(YP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
} }
break; break;
#ifdef TABLING #ifdef TABLING
@ -1483,12 +1495,12 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _table_answer_resolution: case _table_answer_resolution:
{ {
PredEntry *pe = ENV_ToP(gc_B->cp_cp); PredEntry *pe = ENV_ToP(gc_B->cp_cp);
op_numbers caller_op = op_from_opcode(ENV_ToOp(gc_B->cp_cp)); op_numbers caller_op = _YAP_op_from_opcode(ENV_ToOp(gc_B->cp_cp));
/* first condition checks if this was a meta-call */ /* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) { if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
YP_fprintf(YP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
} else } else
YP_fprintf(YP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
} }
break; break;
case _trie_retry_var: case _trie_retry_var:
@ -1501,19 +1513,19 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trie_trust_list: case _trie_trust_list:
case _trie_retry_struct: case _trie_retry_struct:
case _trie_trust_struct: case _trie_trust_struct:
YP_fprintf(YP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
break; break;
#endif #endif
default: default:
{ {
PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p; PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
if (pe == NULL) { if (pe == NULL) {
YP_fprintf(YP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] marked %d (%s)\n", total_marked, op_names[opnum]);
} else } else
if (pe->ArityOfPE) if (pe->ArityOfPE)
YP_fprintf(YP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] %s/%d marked %d (%s)\n", RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, total_marked, op_names[opnum]);
else else
YP_fprintf(YP_stderr,"[GC] %s marked %d (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]); fprintf(_YAP_stderr,"[GC] %s marked %d (%s)\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, total_marked, op_names[opnum]);
} }
} }
} }
@ -1600,7 +1612,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _count_retry: case _count_retry:
rtp = NEXTOP(rtp,l); rtp = NEXTOP(rtp,l);
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = _YAP_op_from_opcode(op);
goto restart_cp; goto restart_cp;
case _trust_fail: case _trust_fail:
nargs = 0; nargs = 0;
@ -1740,7 +1752,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
nargs = rtp->u.ld.s; nargs = rtp->u.ld.s;
break; break;
default: default:
YP_fprintf(YP_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum); fprintf(_YAP_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum);
nargs = 0; nargs = 0;
#else #else
default: default:
@ -1791,7 +1803,7 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
*next = AbsAppl((CELL *) *next = AbsAppl((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current)); ((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
} else { } else {
YP_fprintf(YP_stderr," OH MY GOD !!!!!!!!!!!!\n"); fprintf(_YAP_stderr," OH MY GOD !!!!!!!!!!!!\n");
} }
#else #else
CELL current_tag; CELL current_tag;
@ -1826,11 +1838,11 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
we don't compress TR if we have freeze. we don't compress TR if we have freeze.
*/ */
{ {
Int size = old_TR-(tr_fr_ptr)TrailBase; Int size = old_TR-(tr_fr_ptr)_YAP_TrailBase;
size -= discard_trail_entries; size -= discard_trail_entries;
while (gc_B != NULL) { while (gc_B != NULL) {
size -= (UInt)(gc_B->cp_tr); size -= (UInt)(gc_B->cp_tr);
gc_B->cp_tr = (tr_fr_ptr)TrailBase+size; gc_B->cp_tr = (tr_fr_ptr)_YAP_TrailBase+size;
gc_B = gc_B->cp_b; gc_B = gc_B->cp_b;
} }
} }
@ -1848,7 +1860,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
} }
/* next, follows the real trail entries */ /* next, follows the real trail entries */
trail_ptr = (tr_fr_ptr)TrailBase; trail_ptr = (tr_fr_ptr)_YAP_TrailBase;
dest = trail_ptr; dest = trail_ptr;
while (trail_ptr < old_TR) { while (trail_ptr < old_TR) {
register CELL trail_cell; register CELL trail_cell;
@ -1910,7 +1922,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
#ifdef SBA #ifdef SBA
(ADDR) pt0 >= HeapTop (ADDR) pt0 >= HeapTop
#else #else
(ADDR) pt0 >= TrailBase (ADDR) pt0 >= _YAP_TrailBase
#endif #endif
) { ) {
trail_ptr++; trail_ptr++;
@ -1941,7 +1953,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
dbr->Flags &= ~InUseMask; dbr->Flags &= ~InUseMask;
DEC_DBREF_COUNT(dbr); DEC_DBREF_COUNT(dbr);
if (dbr->Flags & ErasedMask) { if (dbr->Flags & ErasedMask) {
ErDBE(dbr); _YAP_ErDBE(dbr);
} }
} else { } else {
Clause *cl = ClauseFlagsToClause((CELL)pt0); Clause *cl = ClauseFlagsToClause((CELL)pt0);
@ -1956,7 +1968,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
if (erase) { if (erase) {
/* at this point, /* at this point,
no one is accessing the clause */ no one is accessing the clause */
ErCl(cl); _YAP_ErCl(cl);
} }
} }
RESET_VARIABLE(&TrailTerm(dest)); RESET_VARIABLE(&TrailTerm(dest));
@ -2017,27 +2029,27 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
} }
new_TR = dest; new_TR = dest;
if (is_gc_verbose()) { if (is_gc_verbose()) {
if (old_TR != (tr_fr_ptr)TrailBase) if (old_TR != (tr_fr_ptr)_YAP_TrailBase)
YP_fprintf(YP_stderr, fprintf(_YAP_stderr,
"[GC] Trail: discarded %d (%ld%%) cells out of %ld\n", "[GC] Trail: discarded %d (%ld%%) cells out of %ld\n",
discard_trail_entries, discard_trail_entries,
(unsigned long int)(discard_trail_entries*100/(old_TR-(tr_fr_ptr)TrailBase)), (unsigned long int)(discard_trail_entries*100/(old_TR-(tr_fr_ptr)_YAP_TrailBase)),
(unsigned long int)(old_TR-(tr_fr_ptr)TrailBase)); (unsigned long int)(old_TR-(tr_fr_ptr)_YAP_TrailBase));
#ifdef DEBUG #ifdef DEBUG
if (hp_entrs > 0) if (hp_entrs > 0)
YP_fprintf(YP_stderr, fprintf(_YAP_stderr,
"[GC] Trail: unmarked %ld dbentries (%ld%%) out of %ld\n", "[GC] Trail: unmarked %ld dbentries (%ld%%) out of %ld\n",
(long int)hp_not_in_use, (long int)hp_not_in_use,
(long int)(hp_not_in_use*100/hp_entrs), (long int)(hp_not_in_use*100/hp_entrs),
(long int)hp_entrs); (long int)hp_entrs);
if (hp_in_use_erased > 0 && hp_erased > 0) if (hp_in_use_erased > 0 && hp_erased > 0)
YP_fprintf(YP_stderr, fprintf(_YAP_stderr,
"[GC] Trail: deleted %ld dbentries (%ld%%) out of %ld\n", "[GC] Trail: deleted %ld dbentries (%ld%%) out of %ld\n",
(long int)hp_erased, (long int)hp_erased,
(long int)(hp_erased*100/(hp_erased+hp_in_use_erased)), (long int)(hp_erased*100/(hp_erased+hp_in_use_erased)),
(long int)(hp_erased+hp_in_use_erased)); (long int)(hp_erased+hp_in_use_erased));
#endif #endif
YP_fprintf(YP_stderr, fprintf(_YAP_stderr,
"[GC] Heap: recovered %ld bytes (%ld%%) out of %ld\n", "[GC] Heap: recovered %ld bytes (%ld%%) out of %ld\n",
(unsigned long int)(OldHeapUsed-HeapUsed), (unsigned long int)(OldHeapUsed-HeapUsed),
(unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)), (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)),
@ -2050,7 +2062,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
char *ocl = (char *)cl; char *ocl = (char *)cl;
cl = cl->u.NextCl; cl = cl->u.NextCl;
*cptr = cl; *cptr = cl;
FreeCodeSpace(ocl); _YAP_FreeCodeSpace(ocl);
} else { } else {
cl->ClFlags &= ~GcFoundMask; cl->ClFlags &= ~GcFoundMask;
cptr = &(cl->u.NextCl); cptr = &(cl->u.NextCl);
@ -2168,12 +2180,12 @@ sweep_choicepoints(choiceptr gc_B)
#endif #endif
{ {
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = _YAP_op_from_opcode(op);
} }
restart_cp: restart_cp:
/* /*
* YP_fprintf(YP_stderr,"sweeping cps: %x, %x, %x\n", * fprintf(_YAP_stderr,"sweeping cps: %x, %x, %x\n",
* *gc_B,CP_Extra(gc_B),CP_Nargs(gc_B)); * *gc_B,CP_Extra(gc_B),CP_Nargs(gc_B));
*/ */
/* any choice point */ /* any choice point */
@ -2211,7 +2223,7 @@ sweep_choicepoints(choiceptr gc_B)
case _count_retry: case _count_retry:
rtp = NEXTOP(rtp,l); rtp = NEXTOP(rtp,l);
op = rtp->opc; op = rtp->opc;
opnum = op_from_opcode(op); opnum = _YAP_op_from_opcode(op);
goto restart_cp; goto restart_cp;
#ifdef TABLING #ifdef TABLING
case _table_answer_resolution: case _table_answer_resolution:
@ -2453,7 +2465,7 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
} }
#ifdef DEBUG #ifdef DEBUG
else { else {
Error(SYSTEM_ERROR, TermNil, "ATOMIC in a GC relocation chain"); _YAP_Error(SYSTEM_ERROR, TermNil, "ATOMIC in a GC relocation chain");
} }
#endif #endif
} }
@ -2589,7 +2601,7 @@ compact_heap(void)
#ifdef DEBUG #ifdef DEBUG
if (total_marked != found_marked) if (total_marked != found_marked)
YP_fprintf(YP_stderr,"[GC] Upward (%d): %ld total against %ld found\n", fprintf(_YAP_stderr,"[GC] Upward (%d): %ld total against %ld found\n",
gc_calls, gc_calls,
(unsigned long int)total_marked, (unsigned long int)total_marked,
(unsigned long int)found_marked); (unsigned long int)found_marked);
@ -2647,7 +2659,7 @@ compact_heap(void)
} }
#ifdef DEBUG #ifdef DEBUG
if (total_marked != found_marked) if (total_marked != found_marked)
YP_fprintf(YP_stderr,"[GC] Downward (%d): %ld total against %ld found\n", fprintf(_YAP_stderr,"[GC] Downward (%d): %ld total against %ld found\n",
gc_calls, gc_calls,
(unsigned long int)total_marked, (unsigned long int)total_marked,
(unsigned long int)found_marked); (unsigned long int)found_marked);
@ -2690,7 +2702,7 @@ adjust_cp_hbs(void)
gc_B->cp_h = H0; gc_B->cp_h = H0;
break; break;
} else { } else {
Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector"); _YAP_Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector");
return; return;
} }
} }
@ -2781,7 +2793,7 @@ icompact_heap(void)
#ifdef DEBUG #ifdef DEBUG
if (total_marked != found_marked) if (total_marked != found_marked)
YP_fprintf(YP_stderr,"[GC] Upward (%d): %ld total against %ld found\n", fprintf(_YAP_stderr,"[GC] Upward (%d): %ld total against %ld found\n",
gc_calls, gc_calls,
(unsigned long int)total_marked, (unsigned long int)total_marked,
(unsigned long int)found_marked); (unsigned long int)found_marked);
@ -2836,7 +2848,7 @@ icompact_heap(void)
} }
#ifdef DEBUG #ifdef DEBUG
if (total_marked != found_marked) if (total_marked != found_marked)
YP_fprintf(YP_stderr,"[GC] Downward (%d): %ld total against %ld found\n", fprintf(_YAP_stderr,"[GC] Downward (%d): %ld total against %ld found\n",
gc_calls, gc_calls,
(unsigned long int)total_marked, (unsigned long int)total_marked,
(unsigned long int)found_marked); (unsigned long int)found_marked);
@ -2891,7 +2903,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
/* These two must be marked first so that our trail optimisation won't lose /* These two must be marked first so that our trail optimisation won't lose
values */ values */
#ifdef COROUTINING #ifdef COROUTINING
mark_all_suspended_goals(); _YAP_mark_all_suspended_goals();
#endif #endif
mark_regs(old_TR); /* active registers & trail */ mark_regs(old_TR); /* active registers & trail */
#ifdef COROUTINING #ifdef COROUTINING
@ -2909,7 +2921,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
static void static void
sweep_delays(CELL *max) sweep_delays(CELL *max)
{ {
CELL *ptr = (CELL *)GlobalBase; CELL *ptr = (CELL *)_YAP_GlobalBase;
while (ptr < max) { while (ptr < max) {
if (MARKED(*ptr)) { if (MARKED(*ptr)) {
UNMARK(ptr); UNMARK(ptr);
@ -2940,12 +2952,12 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
#ifdef HYBRID_SCHEME #ifdef HYBRID_SCHEME
#ifdef DEBUG #ifdef DEBUG
if (total_marked != iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024) if (total_marked != iptop-(CELL_PTR *)H && iptop < (CELL_PTR *)ASP -1024)
YP_fprintf(YP_stderr,"[GC] Oops on iptop-H (%d) vs %d\n", iptop-(CELL_PTR *)H, total_marked); fprintf(_YAP_stderr,"[GC] Oops on iptop-H (%d) vs %d\n", iptop-(CELL_PTR *)H, total_marked);
#endif #endif
if (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0) { if (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0) {
#ifdef INSTRUMENT_GC #ifdef INSTRUMENT_GC
int effectiveness = (((H-H0)-total_marked)*100)/(H-H0); int effectiveness = (((H-H0)-total_marked)*100)/(H-H0);
YP_fprintf(YP_stderr,"[GC] using pointers (%d)\n", effectiveness); fprintf(_YAP_stderr,"[GC] using pointers (%d)\n", effectiveness);
#endif #endif
quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1); quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
adjust_cp_hbs(); adjust_cp_hbs();
@ -2971,7 +2983,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
tr_fr_ptr old_TR; tr_fr_ptr old_TR;
Int m_time, c_time, time_start, gc_time; Int m_time, c_time, time_start, gc_time;
#if COROUTINING #if COROUTINING
CELL *max = (CELL *)ReadTimedVar(DelayedVars); CELL *max = (CELL *)_YAP_ReadTimedVar(DelayedVars);
#else #else
CELL *max = NULL; CELL *max = NULL;
#endif #endif
@ -2980,8 +2992,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#if COROUTINING #if COROUTINING
if (H0 - max < 1024+(2*NUM_OF_ATTS)) { if (H0 - max < 1024+(2*NUM_OF_ATTS)) {
if (!growglobal(&current_env)) { if (!_YAP_growglobal(&current_env)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return FALSE; return FALSE;
} }
} }
@ -3009,40 +3021,40 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#ifdef DEBUG #ifdef DEBUG
check_global(); check_global();
#endif #endif
if (GetValue(AtomGcTrace) != TermNil) if (_YAP_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1; gc_trace = 1;
/* sanity check: can we still do garbage_collection ? */ /* sanity check: can we still do garbage_collection ? */
if ((CELL)TrailTop & (MBIT|RBIT)) { if ((CELL)_YAP_TrailTop & (MBIT|RBIT)) {
/* oops, we can't */ /* oops, we can't */
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] TrailTop at %p clashes with gc bits: %lx\n", TrailTop, (MBIT|RBIT)); fprintf(_YAP_stderr, "[GC] TrailTop at %p clashes with gc bits: %lx\n", _YAP_TrailTop, (unsigned long int)(MBIT|RBIT));
YP_fprintf(YP_stderr, "[GC] garbage collection disallowed\n"); fprintf(_YAP_stderr, "[GC] garbage collection disallowed\n");
} }
return(0); return(0);
} }
gc_calls++; gc_calls++;
if (gc_trace) { if (gc_trace) {
YP_fprintf(YP_stderr, "[gc]\n"); fprintf(_YAP_stderr, "[gc]\n");
} else if (gc_verbose) { } else if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] Start of garbage collection %d:\n", gc_calls); fprintf(_YAP_stderr, "[GC] Start of garbage collection %d:\n", gc_calls);
#ifndef EARLY_RESET #ifndef EARLY_RESET
YP_fprintf(YP_stderr, "[GC] no early reset in trail\n"); fprintf(_YAP_stderr, "[GC] no early reset in trail\n");
#endif #endif
YP_fprintf(YP_stderr, "[GC] Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H); fprintf(_YAP_stderr, "[GC] Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H);
YP_fprintf(YP_stderr, "[GC] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP); fprintf(_YAP_stderr, "[GC] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
YP_fprintf(YP_stderr, "[GC] Trail:%8ld cells (%p-%p)\n", fprintf(_YAP_stderr, "[GC] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR); (unsigned long int)(TR-(tr_fr_ptr)_YAP_TrailBase),_YAP_TrailBase,TR);
} }
if (HeapTop >= GlobalBase - MinHeapGap) { if (HeapTop >= _YAP_GlobalBase - MinHeapGap) {
*--ASP = (CELL)current_env; *--ASP = (CELL)current_env;
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
current_env = (CELL *)*ASP; current_env = (CELL *)*ASP;
ASP++; ASP++;
} }
time_start = cputime(); time_start = _YAP_cputime();
total_marked = 0; total_marked = 0;
discard_trail_entries = 0; discard_trail_entries = 0;
#ifdef HYBRID_SCHEME #ifdef HYBRID_SCHEME
@ -3053,26 +3065,26 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
old_TR = TR; old_TR = TR;
push_registers(predarity, nextop); push_registers(predarity, nextop);
marking_phase(old_TR, current_env, nextop, max); marking_phase(old_TR, current_env, nextop, max);
m_time = cputime(); m_time = _YAP_cputime();
gc_time = m_time-time_start; gc_time = m_time-time_start;
if (heap_cells) if (heap_cells)
effectiveness = ((heap_cells-total_marked)*100)/heap_cells; effectiveness = ((heap_cells-total_marked)*100)/heap_cells;
else else
effectiveness = 0; effectiveness = 0;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] Mark: Recovered %ld cells of %ld (%ld%%) in %g sec\n", fprintf(_YAP_stderr, "[GC] Mark: Recovered %ld cells of %ld (%ld%%) in %g sec\n",
(long int)(heap_cells-total_marked), (long int)heap_cells, (long int)effectiveness, (double)(m_time-time_start)/1000); (long int)(heap_cells-total_marked), (long int)heap_cells, (long int)effectiveness, (double)(m_time-time_start)/1000);
#ifdef INSTRUMENT_GC #ifdef INSTRUMENT_GC
{ {
int i; int i;
for (i=0; i<16; i++) { for (i=0; i<16; i++) {
if (chain[i]) { if (chain[i]) {
YP_fprintf(YP_stderr, "[GC] chain[%d]=%lu\n", i, chain[i]); fprintf(_YAP_stderr, "[GC] chain[%d]=%lu\n", i, chain[i]);
} }
} }
put_type_info((unsigned long int)total_marked); put_type_info((unsigned long int)total_marked);
YP_fprintf(YP_stderr,"[GC] %lu/%ld before and %lu/%ld after\n", old_vars, (unsigned long int)(B->cp_h-H0), new_vars, (unsigned long int)(H-B->cp_h)); fprintf(_YAP_stderr,"[GC] %lu/%ld before and %lu/%ld after\n", old_vars, (unsigned long int)(B->cp_h-H0), new_vars, (unsigned long int)(H-B->cp_h));
YP_fprintf(YP_stderr,"[GC] %ld choicepoints\n", num_bs); fprintf(_YAP_stderr,"[GC] %ld choicepoints\n", num_bs);
} }
#endif #endif
} }
@ -3082,41 +3094,48 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
pop_registers(predarity, nextop); pop_registers(predarity, nextop);
TR = new_TR; TR = new_TR;
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
c_time = cputime(); c_time = _YAP_cputime();
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] Compress: took %g sec\n", (double)(c_time-time_start)/1000); fprintf(_YAP_stderr, "[GC] Compress: took %g sec\n", (double)(c_time-time_start)/1000);
} }
gc_time += (c_time-time_start); gc_time += (c_time-time_start);
tot_gc_time += gc_time; tot_gc_time += gc_time;
tot_gc_recovered += heap_cells-total_marked; tot_gc_recovered += heap_cells-total_marked;
if (gc_verbose) { if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] GC %d took %g sec, total of %g sec doing GC so far.\n", gc_calls, (double)gc_time/1000, (double)tot_gc_time/1000); fprintf(_YAP_stderr, "[GC] GC %d took %g sec, total of %g sec doing GC so far.\n", gc_calls, (double)gc_time/1000, (double)tot_gc_time/1000);
YP_fprintf(YP_stderr, "[GC] Left %ld cells free in stacks.\n", fprintf(_YAP_stderr, "[GC] Left %ld cells free in stacks.\n",
(unsigned long int)(ASP-H)); (unsigned long int)(ASP-H));
} }
check_global(); check_global();
return(effectiveness); return(effectiveness);
} }
int static int
is_gc_verbose(void) is_gc_verbose(void)
{ {
#ifdef INSTRUMENT_GC #ifdef INSTRUMENT_GC
/* always give info when we are debugging gc */ /* always give info when we are debugging gc */
return(TRUE); return(TRUE);
#else #else
return(GetValue(AtomGcVerbose) != TermNil || return(_YAP_GetValue(AtomGcVerbose) != TermNil ||
GetValue(AtomGcVeryVerbose) != TermNil); _YAP_GetValue(AtomGcVeryVerbose) != TermNil);
#endif #endif
} }
int
_YAP_is_gc_verbose(void)
{
return is_gc_verbose();
}
static int static int
is_gc_very_verbose(void) is_gc_very_verbose(void)
{ {
return(GetValue(AtomGcVeryVerbose) != TermNil); return(_YAP_GetValue(AtomGcVeryVerbose) != TermNil);
} }
Int total_gc_time(void) Int
_YAP_total_gc_time(void)
{ {
return(tot_gc_time); return(tot_gc_time);
} }
@ -3128,13 +3147,13 @@ p_inform_gc(void)
Term tt = MkIntegerTerm(gc_calls); Term tt = MkIntegerTerm(gc_calls);
Term ts = MkIntegerTerm((tot_gc_recovered*sizeof(CELL))); Term ts = MkIntegerTerm((tot_gc_recovered*sizeof(CELL)));
return(unify(tn, ARG2) && unify(tt, ARG1) && unify(ts, ARG3)); return(_YAP_unify(tn, ARG2) && _YAP_unify(tt, ARG1) && _YAP_unify(ts, ARG3));
} }
int int
gc(Int predarity, CELL *current_env, yamop *nextop) _YAP_gc(Int predarity, CELL *current_env, yamop *nextop)
{ {
Int gc_margin = 128; Int gc_margin = 128;
Term Tgc_margin; Term Tgc_margin;
@ -3143,13 +3162,13 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot perform garbage collection: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot perform garbage collection: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
if (GetValue(AtomGc) != TermNil) if (_YAP_GetValue(AtomGc) != TermNil)
gc_on = TRUE; gc_on = TRUE;
if (IsIntTerm(Tgc_margin = GetValue(AtomGcMargin))) if (IsIntTerm(Tgc_margin = _YAP_GetValue(AtomGcMargin)))
gc_margin = IntOfTerm(Tgc_margin); gc_margin = IntOfTerm(Tgc_margin);
else { else {
if (gc_calls < 8) if (gc_calls < 8)
@ -3176,14 +3195,14 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
gc_margin = ((gc_margin >> 16) + 1) << 16; gc_margin = ((gc_margin >> 16) + 1) << 16;
if (gc_margin < gap) if (gc_margin < gap)
gc_margin = gap; gc_margin = gap;
while (gc_margin >= gap && !growstack(gc_margin)) while (gc_margin >= gap && !_YAP_growstack(gc_margin))
gc_margin = gc_margin/2; gc_margin = gc_margin/2;
check_global(); check_global();
return(gc_margin >= gap); return(gc_margin >= gap);
} }
/* /*
* debug for(save_total=1; save_total<=N; ++save_total) * debug for(save_total=1; save_total<=N; ++save_total)
* plwrite(XREGS[save_total],DebugPutc,0); * plwrite(XREGS[save_total],_YAP_DebugPutc,0);
*/ */
return ( TRUE ); return ( TRUE );
} }
@ -3197,8 +3216,14 @@ p_gc(void)
} }
void void
init_gc(void) _YAP_init_gc(void)
{ {
InitCPred("$gc", 0, p_gc, 0); _YAP_InitCPred("$gc", 0, p_gc, 0);
InitCPred("$inform_gc", 3, p_inform_gc, 0); _YAP_InitCPred("$inform_gc", 3, p_inform_gc, 0);
}
void
_YAP_inc_mark_variable()
{
total_marked++;
} }

140
C/index.c
View File

@ -40,8 +40,6 @@ static char SccsId[] = "%W% %G%";
#define NULL (void *)0 #define NULL (void *)0
#endif #endif
int IPredArity;
STATIC_PROTO(int clause_has_cut, (yamop *)); STATIC_PROTO(int clause_has_cut, (yamop *));
STATIC_PROTO(int followed_by_cut, (yamop *)); STATIC_PROTO(int followed_by_cut, (yamop *));
STATIC_PROTO(void emit_tr, (compiler_vm_op, yamop *, int, int)); STATIC_PROTO(void emit_tr, (compiler_vm_op, yamop *, int, int));
@ -128,33 +126,33 @@ static int followed_by_cut(yamop * code)
register yamop *p = code; register yamop *p = code;
while (TRUE) while (TRUE)
{ {
if (p->opc == opcode(_get_x_var)) if (p->opc == _YAP_opcode(_get_x_var))
p = NEXTOP(p,xx); p = NEXTOP(p,xx);
if (p->opc == opcode(_get_y_var)) if (p->opc == _YAP_opcode(_get_y_var))
p = NEXTOP(p,yx); p = NEXTOP(p,yx);
else if (p->opc == opcode(_allocate)) else if (p->opc == _YAP_opcode(_allocate))
p = NEXTOP(p,e); p = NEXTOP(p,e);
else if (p->opc == opcode(_unify_x_var)) else if (p->opc == _YAP_opcode(_unify_x_var))
p = NEXTOP(p,ox); p = NEXTOP(p,ox);
else if (p->opc == opcode(_unify_y_var)) else if (p->opc == _YAP_opcode(_unify_y_var))
p = NEXTOP(p,oy); p = NEXTOP(p,oy);
else if (p->opc == opcode(_unify_l_x_var)) else if (p->opc == _YAP_opcode(_unify_l_x_var))
p = NEXTOP(p,ox); p = NEXTOP(p,ox);
else if (p->opc == opcode(_unify_l_y_var)) else if (p->opc == _YAP_opcode(_unify_l_y_var))
p = NEXTOP(p,oy); p = NEXTOP(p,oy);
else if (p->opc == opcode(_unify_void)) else if (p->opc == _YAP_opcode(_unify_void))
p = NEXTOP(p,o); p = NEXTOP(p,o);
else if (p->opc == opcode(_unify_n_voids)) else if (p->opc == _YAP_opcode(_unify_n_voids))
p = NEXTOP(p,os); p = NEXTOP(p,os);
else if (p->opc == opcode(_unify_l_void)) else if (p->opc == _YAP_opcode(_unify_l_void))
p = NEXTOP(p,o); p = NEXTOP(p,o);
else if (p->opc == opcode(_unify_l_n_voids)) else if (p->opc == _YAP_opcode(_unify_l_n_voids))
p = NEXTOP(p,os); p = NEXTOP(p,os);
else if (p->opc == opcode(_cut)) else if (p->opc == _YAP_opcode(_cut))
return(TRUE); return(TRUE);
else if (p->opc == opcode(_cut_t)) else if (p->opc == _YAP_opcode(_cut_t))
return(TRUE); return(TRUE);
else if (p->opc == opcode(_cut_e)) else if (p->opc == _YAP_opcode(_cut_e))
return(TRUE); return(TRUE);
else return(FALSE); else return(FALSE);
} }
@ -167,7 +165,7 @@ static int followed_by_cut(yamop * code)
inline static void inline static void
emit_tr(compiler_vm_op op, yamop * Address, int NClauses, int HasCut) emit_tr(compiler_vm_op op, yamop * Address, int NClauses, int HasCut)
{ {
emit(op, Unsigned(Address), (NClauses << 1) + HasCut); _YAP_emit(op, Unsigned(Address), (NClauses << 1) + HasCut);
} }
/* emits an opcode followed by an adress */ /* emits an opcode followed by an adress */
@ -182,7 +180,7 @@ emit_try(compiler_vm_op op, int op_offset, yamop * Address, int NClauses, int Ha
return; return;
} }
} }
emit((compiler_vm_op)((int)op + op_offset), Unsigned(Address), (NClauses << 1) + HasCut); _YAP_emit((compiler_vm_op)((int)op + op_offset), Unsigned(Address), (NClauses << 1) + HasCut);
} }
/* /*
@ -202,7 +200,7 @@ inline static yamop *
SecB(yamop * Arg) SecB(yamop * Arg)
{ {
yamop *pc = NEXTOP(Arg,ld); yamop *pc = NEXTOP(Arg,ld);
if (pc->opc == opcode(_get_struct)) if (pc->opc == _YAP_opcode(_get_struct))
return (NEXTOP(pc,xf)); return (NEXTOP(pc,xf));
else else
return (NEXTOP(pc,xc)); return (NEXTOP(pc,xc));
@ -227,7 +225,7 @@ inline static yamop *
ThiB(yamop * Arg) ThiB(yamop * Arg)
{ {
yamop *pc = NEXTOP(NEXTOP(Arg,ld),x); yamop *pc = NEXTOP(NEXTOP(Arg,ld),x);
if (pc->opc == opcode(_unify_struct)) if (pc->opc == _YAP_opcode(_unify_struct))
return (NEXTOP(pc,of)); return (NEXTOP(pc,of));
else else
return (NEXTOP(pc,oc)); return (NEXTOP(pc,oc));
@ -251,9 +249,9 @@ emit_cp_inst(compiler_vm_op op, yamop * Address, int Flag, int NClausesAfter)
indexed_code_for_cut = NIL; indexed_code_for_cut = NIL;
if (op != try_op && profiling) if (op != try_op && profiling)
emit(retry_profiled_op, Unsigned(CurrentPred), Zero); _YAP_emit(retry_profiled_op, Unsigned(CurrentPred), Zero);
else if (op != try_op && call_counting) else if (op != try_op && call_counting)
emit(count_retry_op, Unsigned(CurrentPred), Zero); _YAP_emit(count_retry_op, Unsigned(CurrentPred), Zero);
if (NGroups == 1) if (NGroups == 1)
Flag = Flag | LoneGroup; Flag = Flag | LoneGroup;
else if (Flag & LastGroup) { else if (Flag & LastGroup) {
@ -348,8 +346,8 @@ static CELL
emit_space(compiler_vm_op op, int space, int nof) emit_space(compiler_vm_op op, int space, int nof)
{ {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
StorePoint = emit_extra_size(op, Unsigned(nof), space); StorePoint = _YAP_emit_extra_size(op, Unsigned(nof), space);
return (labelno); return (labelno);
} }
@ -358,11 +356,11 @@ static CELL
emit_go(int Gender, Term Name) emit_go(int Gender, Term Name)
{ {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
if (Gender == ApplCl) if (Gender == ApplCl)
StorePoint = emit_extra_size(go_f_op, Zero, 3 * CellSize); StorePoint = _YAP_emit_extra_size(go_f_op, Zero, 3 * CellSize);
else else
StorePoint = emit_extra_size(go_c_op, Zero, 3 * CellSize); StorePoint = _YAP_emit_extra_size(go_c_op, Zero, 3 * CellSize);
*StorePoint++ = Unsigned(Name); *StorePoint++ = Unsigned(Name);
StorePoint[1] = (CELL)FailAddress; StorePoint[1] = (CELL)FailAddress;
return (labelno); return (labelno);
@ -373,7 +371,7 @@ emit_go(int Gender, Term Name)
static void static void
emit_if_not(Term T1, CELL Ad1, CELL Ad2) emit_if_not(Term T1, CELL Ad1, CELL Ad2)
{ {
StorePoint = emit_extra_size(if_not_op, Zero, 3 * CellSize); StorePoint = _YAP_emit_extra_size(if_not_op, Zero, 3 * CellSize);
*StorePoint++ = Unsigned(T1); *StorePoint++ = Unsigned(T1);
*StorePoint++ = Unsigned(Ad1); *StorePoint++ = Unsigned(Ad1);
StorePoint[0] = Unsigned(Ad2); StorePoint[0] = Unsigned(Ad2);
@ -472,8 +470,8 @@ NGroupsIn(PredEntry *ap)
if (y != PresentGroup) { if (y != PresentGroup) {
Group++->Last = (ActualCl - 1)->Code; Group++->Last = (ActualCl - 1)->Code;
NGroups++; NGroups++;
if ((ADDR)Group > TrailTop-1024) if ((ADDR)Group > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
Group->First = q; Group->First = q;
Group->Start = ActualCl; Group->Start = ActualCl;
Group->NCl = 0; Group->NCl = 0;
@ -504,7 +502,7 @@ NGroupsIn(PredEntry *ap)
if (ASP <= CellPtr (ActualCl) + 256) { if (ASP <= CellPtr (ActualCl) + 256) {
freep = (char *)ActualCl; freep = (char *)ActualCl;
save_machine_regs(); save_machine_regs();
longjmp(CompilerBotch, 3); longjmp(_YAP_CompilerBotch, 3);
} }
(Group->Type[x])++; (Group->Type[x])++;
(Group->NCl)++; (Group->NCl)++;
@ -600,7 +598,7 @@ BuildHash(CELL *WhereTo, int NOfEntries, int TableSize, int Gend)
} }
#ifdef DEBUG #ifdef DEBUG
#ifdef CLASHES #ifdef CLASHES
YP_fprintf(YP_stderr,"hash table clashes: %d %d\n", clashes, NOfEntries); fprintf(_YAP_stderr,"hash table clashes: %d %d\n", clashes, NOfEntries);
#endif /* CLASHES */ #endif /* CLASHES */
#endif /* DEBUG */ #endif /* DEBUG */
} }
@ -629,7 +627,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
/* last group, meaning we already have a choice point set */ /* last group, meaning we already have a choice point set */
register yamop * k = (Entrance->First)->Code; register yamop * k = (Entrance->First)->Code;
labelno += 2; labelno += 2;
emit(label_op, Entrance->Code = labelno, Zero); _YAP_emit(label_op, Entrance->Code = labelno, Zero);
if (PositionFlag & HeadIndex) { if (PositionFlag & HeadIndex) {
emit_tr(trust_op, ThiB(k), 1, clause_has_cut(k)); emit_tr(trust_op, ThiB(k), 1, clause_has_cut(k));
} else { } else {
@ -643,7 +641,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
/* a single alternative and a catchall clause */ /* a single alternative and a catchall clause */
register yamop * k = (Entrance->First)->Code; register yamop * k = (Entrance->First)->Code;
labelno += 2; labelno += 2;
emit(label_op, Entrance->Code = labelno, Zero); _YAP_emit(label_op, Entrance->Code = labelno, Zero);
/* if we are in a list */ /* if we are in a list */
if (PositionFlag & HeadIndex) { if (PositionFlag & HeadIndex) {
/* we cannot emit to SecLB because switch might have already /* we cannot emit to SecLB because switch might have already
@ -685,7 +683,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
nofalts = Gr->NofClausesAfter+nofentries; nofalts = Gr->NofClausesAfter+nofentries;
k = Entrance->First; k = Entrance->First;
labelno += 2; labelno += 2;
emit(label_op, (Entrance->Code = labelno), Zero); _YAP_emit(label_op, (Entrance->Code = labelno), Zero);
emit_cp_inst(try_op, k->Code, PositionFlag, nofalts); emit_cp_inst(try_op, k->Code, PositionFlag, nofalts);
nofalts--; nofalts--;
if (indexed_code_for_cut != NIL) { if (indexed_code_for_cut != NIL) {
@ -698,7 +696,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
emit_cp_inst(trust_op, k->Code, PositionFlag, nofalts); emit_cp_inst(trust_op, k->Code, PositionFlag, nofalts);
/* emit a jump with the place to jump to after finishing this group */ /* emit a jump with the place to jump to after finishing this group */
if (NGroups > 1 && !(PositionFlag & LastGroup) && !ExtendedSingle) if (NGroups > 1 && !(PositionFlag & LastGroup) && !ExtendedSingle)
emit(jump_op, (CELL)((Gr+1)->First), Zero); _YAP_emit(jump_op, (CELL)((Gr+1)->First), Zero);
} }
} }
} }
@ -727,8 +725,8 @@ DealFixed(ClauseDef *j, int Gender, compiler_vm_op op, int Flag, GroupDef *Gr)
while (l < NDiffTerms && Entry->Class != HeadName) while (l < NDiffTerms && Entry->Class != HeadName)
Entry++, l++; Entry++, l++;
if (l == NDiffTerms) { if (l == NDiffTerms) {
if ((ADDR)Entry > TrailTop-1024) if ((ADDR)Entry > _YAP_TrailTop-1024)
growtrail(64 * 1024L); _YAP_growtrail(64 * 1024L);
Entry->Class = HeadName; Entry->Class = HeadName;
Entry->Last = Entry->First = j; Entry->Last = Entry->First = j;
NDiffTerms++; NDiffTerms++;
@ -786,7 +784,7 @@ DealFixedWithBips(ClauseDef *j, int NClauses, int Flag, GroupDef *Gr)
labelno += 2; labelno += 2;
my_labelno = labelno; my_labelno = labelno;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
#ifdef AGRESSIVE_BIPS #ifdef AGRESSIVE_BIPS
if (j->Name != 0x0 && j->Next->Name != 0x0) { if (j->Name != 0x0 && j->Next->Name != 0x0) {
/* /*
@ -811,7 +809,7 @@ DealFixedWithBips(ClauseDef *j, int NClauses, int Flag, GroupDef *Gr)
while (j->Name != 0x0) i++, j = j->Next; while (j->Name != 0x0) i++, j = j->Next;
Gr->NofClausesAfter = old_NAlts + G->NCl - i; Gr->NofClausesAfter = old_NAlts + G->NCl - i;
DealFixed(j0, AtCl, switch_c_op, FirstIndex | IsAtom, Gr); DealFixed(j0, AtCl, switch_c_op, FirstIndex | IsAtom, Gr);
emit(label_op, old_labelno, Zero); _YAP_emit(label_op, old_labelno, Zero);
FailAddress = old_FailAddress; FailAddress = old_FailAddress;
ExtendedSingle = old_ExtendedSingle; ExtendedSingle = old_ExtendedSingle;
Gr->NofClausesAfter = old_NAlts; Gr->NofClausesAfter = old_NAlts;
@ -838,7 +836,7 @@ DealFixedWithBips(ClauseDef *j, int NClauses, int Flag, GroupDef *Gr)
emit_cp_inst(trust_op, j->Code, Flag, nofalts); emit_cp_inst(trust_op, j->Code, Flag, nofalts);
/* emit a jump with the place to jump to after finishing this group */ /* emit a jump with the place to jump to after finishing this group */
if (NGroups > 1 && !(Flag & LastGroup) && !ExtendedSingle) if (NGroups > 1 && !(Flag & LastGroup) && !ExtendedSingle)
emit(jump_op, (CELL)((Gr+1)->First), Zero); _YAP_emit(jump_op, (CELL)((Gr+1)->First), Zero);
return(my_labelno); return(my_labelno);
} }
@ -852,14 +850,14 @@ DealCons(int i)
if (FinalGr(i)) { if (FinalGr(i)) {
yamop * Cl = FindFirst(i, AtCl); yamop * Cl = FindFirst(i, AtCl);
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(trust_op, Cl, 1, clause_has_cut(Cl)); emit_tr(trust_op, Cl, 1, clause_has_cut(Cl));
return (labelno); return (labelno);
} else if (ExtendedSingle) { } else if (ExtendedSingle) {
yamop * Cl = FindFirst(i, AtCl); yamop * Cl = FindFirst(i, AtCl);
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(try_op, Cl, 2, clause_has_cut(Cl)); emit_tr(try_op, Cl, 2, clause_has_cut(Cl));
emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress)); emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno); return (labelno);
@ -897,13 +895,13 @@ DealAppl(int i)
if (FinalGr(i)) { if (FinalGr(i)) {
yamop * Cl = FindFirst(i, ApplCl); yamop * Cl = FindFirst(i, ApplCl);
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(trust_op, Cl, 1, clause_has_cut(Cl)); emit_tr(trust_op, Cl, 1, clause_has_cut(Cl));
return (labelno); return (labelno);
} else if (ExtendedSingle) { } else if (ExtendedSingle) {
yamop * Cl = FindFirst(i, ApplCl); yamop * Cl = FindFirst(i, ApplCl);
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(try_op, Cl, 2, clause_has_cut(Cl)); emit_tr(try_op, Cl, 2, clause_has_cut(Cl));
emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress)); emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno); return (labelno);
@ -931,12 +929,12 @@ StartList(int i)
j++; j++;
if (FinalGr(i)) { if (FinalGr(i)) {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(trust_op, SecLB(j->Code), 1, clause_has_cut(j->Code)); emit_tr(trust_op, SecLB(j->Code), 1, clause_has_cut(j->Code));
return (labelno); return (labelno);
} else if (ExtendedSingle) { } else if (ExtendedSingle) {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_tr(try_op, SecLB(j->Code), 2, clause_has_cut(j->Code)); emit_tr(try_op, SecLB(j->Code), 2, clause_has_cut(j->Code));
emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress)); emit_tr(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno); return (labelno);
@ -980,7 +978,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
else if (NOfClauses == 1) { else if (NOfClauses == 1) {
if (FinalGr(NG)) { if (FinalGr(NG)) {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
if (PositionFlag & FirstIndex) if (PositionFlag & FirstIndex)
emit_tr(trust_op, SecLB(j->Code), 1, clause_has_cut(j->Code)); emit_tr(trust_op, SecLB(j->Code), 1, clause_has_cut(j->Code));
else else
@ -988,7 +986,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
return (labelno); return (labelno);
} else if (ExtendedSingle) { } else if (ExtendedSingle) {
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
if (PositionFlag & FirstIndex) if (PositionFlag & FirstIndex)
emit_tr(try_op, SecLB(j->Code), 2, clause_has_cut(j->Code)); emit_tr(try_op, SecLB(j->Code), 2, clause_has_cut(j->Code));
else else
@ -1003,7 +1001,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
if (FinalGr(NG)) if (FinalGr(NG))
PositionFlag |= LastGroup; PositionFlag |= LastGroup;
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
nofalts = Groups[NG].NofClausesAfter+NOfClauses; nofalts = Groups[NG].NofClausesAfter+NOfClauses;
emit_cp_inst(try_op, j->Code, PositionFlag, nofalts); emit_cp_inst(try_op, j->Code, PositionFlag, nofalts);
nofalts--; nofalts--;
@ -1019,7 +1017,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
emit_cp_inst(trust_op, j->Code, PositionFlag, nofalts); emit_cp_inst(trust_op, j->Code, PositionFlag, nofalts);
/* emit a jump with the place to jump to after finishing this group */ /* emit a jump with the place to jump to after finishing this group */
if (NGroups > 1 && !(PositionFlag & LastGroup) && !ExtendedSingle) if (NGroups > 1 && !(PositionFlag & LastGroup) && !ExtendedSingle)
emit(jump_op, (CELL)(Groups[NG+1].First), Zero); _YAP_emit(jump_op, (CELL)(Groups[NG+1].First), Zero);
return (labelno); return (labelno);
} }
} }
@ -1097,7 +1095,7 @@ DealList(int i)
else else
VFlags = FirstIndex | LastFoundList; VFlags = FirstIndex | LastFoundList;
labelno += 2; labelno += 2;
emit(label_op, labelno, Zero); _YAP_emit(label_op, labelno, Zero);
emit_cp_inst(try_op, j->Code, VFlags, nofalts); emit_cp_inst(try_op, j->Code, VFlags, nofalts);
nofalts--; nofalts--;
if (indexed_code_for_cut != NIL) { if (indexed_code_for_cut != NIL) {
@ -1112,7 +1110,7 @@ DealList(int i)
emit_cp_inst(trust_op, j->Code, VFlags, nofalts); emit_cp_inst(trust_op, j->Code, VFlags, nofalts);
/* emit a jump with the place to jump to after finishing this group */ /* emit a jump with the place to jump to after finishing this group */
if (NGroups > 1 && !(VFlags & LastGroup) && !ExtendedSingle) if (NGroups > 1 && !(VFlags & LastGroup) && !ExtendedSingle)
emit(jump_op, (CELL)(Groups[i+1].First), Zero); _YAP_emit(jump_op, (CELL)(Groups[i+1].First), Zero);
return (labelno); return (labelno);
} }
} }
@ -1241,11 +1239,11 @@ IndexVarGr(int Count)
Cla++; Cla++;
nofalts--; nofalts--;
} else if (Count == NGroups - 1 && Gr->NCl == 1) { } else if (Count == NGroups - 1 && Gr->NCl == 1) {
emit(label_op, Unsigned(Gr->First), Zero); _YAP_emit(label_op, Unsigned(Gr->First), Zero);
emit_tr(trust_op, Body((Cla)->Code), 1, clause_has_cut(Cla->Code)); emit_tr(trust_op, Body((Cla)->Code), 1, clause_has_cut(Cla->Code));
return; return;
} else { } else {
emit(label_op, Unsigned(Gr->First), Zero); _YAP_emit(label_op, Unsigned(Gr->First), Zero);
emit_tr(retry_op, Body((Cla)->Code), nofalts, clause_has_cut(Cla->Code)); emit_tr(retry_op, Body((Cla)->Code), nofalts, clause_has_cut(Cla->Code));
Cla++; Cla++;
nofalts--; nofalts--;
@ -1279,7 +1277,7 @@ ComplexCase(void)
if (IsExtendedSingle(0)) if (IsExtendedSingle(0))
return (SimpleCase()); return (SimpleCase());
emit(jump_v_op, (CELL) FirstCl, Zero); _YAP_emit(jump_v_op, (CELL) FirstCl, Zero);
if (Groups[0].Type[VarCl] == 0) if (Groups[0].Type[VarCl] == 0)
i = 0; i = 0;
else { else {
@ -1319,19 +1317,19 @@ SpecialCases(void)
} }
CODEADDR CODEADDR
PredIsIndexable(PredEntry *ap) _YAP_PredIsIndexable(PredEntry *ap)
{ {
int NGr, Indexable = 0; int NGr, Indexable = 0;
CODEADDR indx_out = NIL; CODEADDR indx_out = NIL;
log_update = 0; log_update = 0;
if (setjmp(CompilerBotch) == 3) { if (setjmp(_YAP_CompilerBotch) == 3) {
/* just duplicate the stack */ /* just duplicate the stack */
restore_machine_regs(); restore_machine_regs();
gc(ap->ArityOfPE, ENV, CP); _YAP_gc(ap->ArityOfPE, ENV, CP);
} }
restart_index: restart_index:
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
labelno = 1; labelno = 1;
RemovedCl = FALSE; RemovedCl = FALSE;
FirstCl = (yamop *)(ap->FirstClause); FirstCl = (yamop *)(ap->FirstClause);
@ -1353,7 +1351,7 @@ PredIsIndexable(PredEntry *ap)
Entries = (EntryDef *) (Groups + NGroups); Entries = (EntryDef *) (Groups + NGroups);
CodeStart = cpc = NIL; CodeStart = cpc = NIL;
freep = (char *) (ArOfCl + NClauses); freep = (char *) (ArOfCl + NClauses);
if (ErrorMessage != NULL) { if (_YAP_ErrorMessage != NULL) {
return (NIL); return (NIL);
} }
if (CurrentPred->PredFlags & LogUpdatePredFlag) { if (CurrentPred->PredFlags & LogUpdatePredFlag) {
@ -1372,7 +1370,7 @@ PredIsIndexable(PredEntry *ap)
Indexable = SpecialCases(); Indexable = SpecialCases();
} }
if (CellPtr(freep) >= ASP) { if (CellPtr(freep) >= ASP) {
Error(SYSTEM_ERROR, TermNil, "out of stack space while indexing"); _YAP_Error(SYSTEM_ERROR, TermNil, "out of stack space while indexing");
return(NIL); return(NIL);
} }
if (log_update && NClauses > 1) { if (log_update && NClauses > 1) {
@ -1380,8 +1378,8 @@ PredIsIndexable(PredEntry *ap)
Clause *cl; Clause *cl;
Indexable = TRUE; Indexable = TRUE;
emit(label_op, log_update, Zero); _YAP_emit(label_op, log_update, Zero);
emit(try_op, Unsigned(Body(ArOfCl[0].Code)), Zero); _YAP_emit(try_op, Unsigned(Body(ArOfCl[0].Code)), Zero);
cl = ClauseCodeToClause(ArOfCl[0].Code); cl = ClauseCodeToClause(ArOfCl[0].Code);
if (cl->ClFlags & LogUpdRuleMask) { if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++; cl->u2.ClExt->u.EC.ClRefs++;
@ -1389,7 +1387,7 @@ PredIsIndexable(PredEntry *ap)
cl->u2.ClUse++; cl->u2.ClUse++;
} }
for (i = 1; i < NClauses-1; i++) { for (i = 1; i < NClauses-1; i++) {
emit(retry_op, Unsigned(Body(ArOfCl[i].Code)), Zero); _YAP_emit(retry_op, Unsigned(Body(ArOfCl[i].Code)), Zero);
cl = ClauseCodeToClause(ArOfCl[0].Code); cl = ClauseCodeToClause(ArOfCl[0].Code);
if (cl->ClFlags & LogUpdRuleMask) { if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++; cl->u2.ClExt->u.EC.ClRefs++;
@ -1397,7 +1395,7 @@ PredIsIndexable(PredEntry *ap)
cl->u2.ClUse++; cl->u2.ClUse++;
} }
} }
emit(trust_op, Unsigned(Body(ArOfCl[i].Code)), Zero); _YAP_emit(trust_op, Unsigned(Body(ArOfCl[i].Code)), Zero);
cl = ClauseCodeToClause(ArOfCl[i].Code); cl = ClauseCodeToClause(ArOfCl[i].Code);
if (cl->ClFlags & LogUpdRuleMask) { if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++; cl->u2.ClExt->u.EC.ClRefs++;
@ -1409,13 +1407,13 @@ PredIsIndexable(PredEntry *ap)
return (NIL); return (NIL);
} else { } else {
#ifdef DEBUG #ifdef DEBUG
if (Option['i' - 'a' + 1]) { if (_YAP_Option['i' - 'a' + 1]) {
ShowCode(); _YAP_ShowCode();
} }
#endif #endif
if ((indx_out = assemble(ASSEMBLING_INDEX)) == NIL) { if ((indx_out = _YAP_assemble(ASSEMBLING_INDEX)) == NIL) {
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto restart_index; goto restart_index;

801
C/init.c
View File

File diff suppressed because it is too large Load Diff

1376
C/iopreds.c
View File

File diff suppressed because it is too large Load Diff

25
C/load_aix.c
View File

@ -27,7 +27,7 @@
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
} }
@ -36,7 +36,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
Int static Int
LoadForeign(StringList ofiles, StringList libs, LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
@ -45,28 +45,35 @@ LoadForeign(StringList ofiles, StringList libs,
/* load wants to follow the LIBRARY_PATH */ /* load wants to follow the LIBRARY_PATH */
if (ofiles->next != NULL || libs != NULL) { if (ofiles->next != NULL || libs != NULL) {
strcpy(LoadMsg," Load Failed: in AIX you must load a single object file"); strcpy(_YAP_ErrorSay," Load Failed: in AIX you must load a single object file");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) { if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(LoadMsg, " Trying to open unexisting file in LoadForeign "); strcpy(_YAP_ErrorSay, " Trying to open unexisting file in LoadForeign ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* In AIX, just call load and everything will go in */ /* In AIX, just call load and everything will go in */
if ((*init_proc=((YapInitProc *)load(FileNameBuf,0,NULL))) == NULL) { if ((*init_proc=((YapInitProc *)load(_YAP_FileNameBuf,0,NULL))) == NULL) {
strcpy(LoadMsg,sys_errlist[errno]); strcpy(_YAP_ErrorSay,sys_errlist[errno]);
return LOAD_FAILLED; return LOAD_FAILLED;
} }
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

57
C/load_aout.c
View File

@ -55,7 +55,7 @@ static char YapExecutable[YAP_FILE_MAX];
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
register char *cp, *cp2; register char *cp, *cp2;
struct stat stbuf; struct stat stbuf;
@ -64,10 +64,10 @@ YAP_FindExecutable(char *name)
cp = (char *)getenv("PATH"); cp = (char *)getenv("PATH");
if (cp == NULL) if (cp == NULL)
cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin"; cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin";
if (*yap_args[0] == '/') { if (*_YAP_argv[0] == '/') {
if (oktox(yap_args[0])) { if (oktox(_YAP_argv[0])) {
strcpy(FileNameBuf, yap_args[0]); strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return; return;
} }
} }
@ -79,24 +79,24 @@ YAP_FindExecutable(char *name)
* argv[0] * argv[0]
*/ */
for (cp2 = FileNameBuf; (*cp) != 0 && (*cp) != ':';) for (cp2 = _YAP_FileNameBuf; (*cp) != 0 && (*cp) != ':';)
*cp2++ = *cp++; *cp2++ = *cp++;
*cp2++ = '/'; *cp2++ = '/';
strcpy(cp2, yap_args[0]); strcpy(cp2, _YAP_argv[0]);
if (*cp) if (*cp)
cp++; cp++;
if (!oktox(FileNameBuf)) if (!oktox(_YAP_FileNameBuf))
continue; continue;
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return; return;
} }
/* one last try for dual systems */ /* one last try for dual systems */
strcpy(FileNameBuf, yap_args[0]); strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
if (oktox(YapExecutable)) if (oktox(YapExecutable))
return; return;
else else
Error(SYSTEM_ERROR,MkAtomTerm(LookupAtom(YapExecutable)), _YAP_Error(SYSTEM_ERROR,MkAtomTerm(_YAP_LookupAtom(YapExecutable)),
"cannot find file being executed"); "cannot find file being executed");
} }
@ -105,7 +105,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
int static int
LoadForeign(StringList ofiles, LoadForeign(StringList ofiles,
StringList libs, StringList libs,
char *proc_name, char *proc_name,
@ -156,7 +156,7 @@ LoadForeign(StringList ofiles,
/* prepare the magic */ /* prepare the magic */
if (strlen(o_files) + strlen(l_files) + strlen(proc_name) + if (strlen(o_files) + strlen(l_files) + strlen(proc_name) +
strlen(YapExecutable) > 2*MAXPATHLEN) { strlen(YapExecutable) > 2*MAXPATHLEN) {
strcpy(LoadMsg, " too many parameters in load_foreign/3 "); strcpy(_YAP_ErrorSay, " too many parameters in load_foreign/3 ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
sprintf(command, "/usr/bin/ld -N -A %s -o %s -u _%s %s %s -lc", sprintf(command, "/usr/bin/ld -N -A %s -o %s -u _%s %s %s -lc",
@ -165,12 +165,12 @@ LoadForeign(StringList ofiles,
/* now, do the magic */ /* now, do the magic */
if (system(command) != 0) { if (system(command) != 0) {
unlink(tfile); unlink(tfile);
strcpy(LoadMsg," ld returned error status in load_foreign_files "); strcpy(_YAP_ErrorSay," ld returned error status in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* now check the music has played */ /* now check the music has played */
if ((fildes = open(tfile, O_RDONLY)) < 0) { if ((fildes = open(tfile, O_RDONLY)) < 0) {
strcpy(LoadMsg," unable to open temp file in load_foreign_files "); strcpy(_YAP_ErrorSay," unable to open temp file in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* it did, get the mice */ /* it did, get the mice */
@ -184,8 +184,8 @@ LoadForeign(StringList ofiles,
/* keep this copy */ /* keep this copy */
firstloadImSz = loadImageSize; firstloadImSz = loadImageSize;
/* now fetch the space we need */ /* now fetch the space we need */
if (!(FCodeBase = AllocCodeSpace((int) loadImageSize))) { if (!(FCodeBase = _YAP_AllocCodeSpace((int) loadImageSize))) {
strcpy(LoadMsg," unable to allocate space for external code "); strcpy(_YAP_ErrorSay," unable to allocate space for external code ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* now, a new incantation to load the new foreign code */ /* now, a new incantation to load the new foreign code */
@ -196,17 +196,17 @@ LoadForeign(StringList ofiles,
/* and do it */ /* and do it */
if (system(command) != 0) { if (system(command) != 0) {
unlink(tfile); unlink(tfile);
strcpy(LoadMsg," ld returned error status in load_foreign_files "); strcpy(_YAP_ErrorSay," ld returned error status in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if ((fildes = open(tfile, O_RDONLY)) < 0) { if ((fildes = open(tfile, O_RDONLY)) < 0) {
strcpy(LoadMsg," unable to open temp file in load_foreign_files "); strcpy(_YAP_ErrorSay," unable to open temp file in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
read(fildes, (char *) &header, sizeof(header)); read(fildes, (char *) &header, sizeof(header));
loadImageSize = header.a_text + header.a_data + header.a_bss; loadImageSize = header.a_text + header.a_data + header.a_bss;
if (firstloadImSz < loadImageSize) { if (firstloadImSz < loadImageSize) {
strcpy(LoadMsg," miscalculation in load_foreign/3 "); strcpy(_YAP_ErrorSay," miscalculation in load_foreign/3 ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* now search for our init function */ /* now search for our init function */
@ -217,11 +217,11 @@ LoadForeign(StringList ofiles,
func_info[0].n_un.n_name = entry_fun; func_info[0].n_un.n_name = entry_fun;
func_info[1].n_un.n_name = NULL; func_info[1].n_un.n_name = NULL;
if (nlist(tfile, func_info) == -1) { if (nlist(tfile, func_info) == -1) {
strcpy(LoadMsg," in nlist(3) "); strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if (func_info[0].n_type == 0) { if (func_info[0].n_type == 0) {
strcpy(LoadMsg," in nlist(3) "); strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
*init_proc = (YapInitProc)(func_info[0].n_value); *init_proc = (YapInitProc)(func_info[0].n_value);
@ -241,13 +241,20 @@ LoadForeign(StringList ofiles,
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

59
C/load_coff.c
View File

@ -53,7 +53,7 @@ static char YapExecutable[YAP_FILE_MAX];
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
register char *cp, *cp2; register char *cp, *cp2;
struct stat stbuf; struct stat stbuf;
@ -62,10 +62,10 @@ YAP_FindExecutable(char *name)
cp = (char *)getenv("PATH"); cp = (char *)getenv("PATH");
if (cp == NULL) if (cp == NULL)
cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin"; cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin";
if (*yap_args[0] == '/') { if (*_YAP_argv[0] == '/') {
if (oktox(yap_args[0])) { if (oktox(_YAP_argv[0])) {
strcpy(FileNameBuf, yap_args[0]); strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return; return;
} }
} }
@ -77,24 +77,24 @@ YAP_FindExecutable(char *name)
* argv[0] * argv[0]
*/ */
for (cp2 = FileNameBuf; (*cp) != 0 && (*cp) != ':';) for (cp2 = _YAP_FileNameBuf; (*cp) != 0 && (*cp) != ':';)
*cp2++ = *cp++; *cp2++ = *cp++;
*cp2++ = '/'; *cp2++ = '/';
strcpy(cp2, yap_args[0]); strcpy(cp2, _YAP_argv[0]);
if (*cp) if (*cp)
cp++; cp++;
if (!oktox(FileNameBuf)) if (!oktox(_YAP_FileNameBuf))
continue; continue;
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return; return;
} }
/* one last try for dual systems */ /* one last try for dual systems */
strcpy(FileNameBuf, yap_args[0]); strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE); _YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
if (oktox(YapExecutable)) if (oktox(YapExecutable))
return; return;
else else
Error(SYSTEM_ERROR,MkAtomTerm(LookupAtom(YapExecutable)), _YAP_Error(SYSTEM_ERROR,MkAtomTerm(_YAP_LookupAtom(YapExecutable)),
"cannot find file being executed"); "cannot find file being executed");
} }
@ -103,7 +103,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
int static Int
LoadForeign(StringList ofiles, LoadForeign(StringList ofiles,
StringList libs, StringList libs,
char *proc_name, char *proc_name,
@ -157,7 +157,7 @@ LoadForeign(StringList ofiles,
/* prepare the magic */ /* prepare the magic */
if (strlen(o_files) + strlen(l_files) + strlen(proc_name) + if (strlen(o_files) + strlen(l_files) + strlen(proc_name) +
strlen(YapExecutable) > 2*MAXPATHLEN) { strlen(YapExecutable) > 2*MAXPATHLEN) {
strcpy(LoadMsg, " too many parameters in load_foreign/3 "); strcpy(_YAP_ErrorSay, " too many parameters in load_foreign/3 ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
sprintf(command, "/usr/bin/ld -N -A %s -o %s %s %s -lc", sprintf(command, "/usr/bin/ld -N -A %s -o %s %s %s -lc",
@ -166,12 +166,12 @@ LoadForeign(StringList ofiles,
/* now, do the magic */ /* now, do the magic */
if (system(command) != 0) { if (system(command) != 0) {
unlink(tfile); unlink(tfile);
strcpy(LoadMsg," ld returned error status in load_foreign_files "); strcpy(_YAP_ErrorSay," ld returned error status in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* now check the music has played */ /* now check the music has played */
if ((fildes = open(tfile, O_RDONLY)) < 0) { if ((fildes = open(tfile, O_RDONLY)) < 0) {
strcpy(LoadMsg," unable to open temp file in load_foreign_files "); strcpy(_YAP_ErrorSay," unable to open temp file in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* it did, get the mice */ /* it did, get the mice */
@ -196,12 +196,12 @@ LoadForeign(StringList ofiles,
/* keep this copy */ /* keep this copy */
firstloadImSz = loadImageSize; firstloadImSz = loadImageSize;
/* now fetch the space we need */ /* now fetch the space we need */
if (!(FCodeBase = AllocCodeSpace((int) loadImageSize)) if (!(FCodeBase = _YAP_AllocCodeSpace((int) loadImageSize))
#ifdef pyr #ifdef pyr
|| activate_code(ForeignCodeBase, u1) || activate_code(ForeignCodeBase, u1)
#endif /* pyr */ #endif /* pyr */
) { ) {
strcpy(LoadMsg," unable to allocate space for external code "); strcpy(_YAP_ErrorSay," unable to allocate space for external code ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
#ifdef mips #ifdef mips
@ -215,7 +215,7 @@ LoadForeign(StringList ofiles,
sprintf(command, "ld -x -A %s -T %lx -o %s -u %s %s %s -lc", sprintf(command, "ld -x -A %s -T %lx -o %s -u %s %s %s -lc",
ostabf, ostabf,
((unsigned long) (((unsigned long) (ForeignCodeBase)) & ((unsigned long) (((unsigned long) (ForeignCodeBase)) &
((unsigned long) (~HeapBase)) ((unsigned long) (~_YAP_HeapBase))
) )
), tfile, entry_point, o_files, l_files); ), tfile, entry_point, o_files, l_files);
#else #else
@ -234,11 +234,11 @@ LoadForeign(StringList ofiles,
/* and do it */ /* and do it */
if (system(command) != 0) { if (system(command) != 0) {
unlink(tfile); unlink(tfile);
strcpy(LoadMsg," ld returned error status in load_foreign_files "); strcpy(_YAP_ErrorSay," ld returned error status in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if ((fildes = open(tfile, O_RDONLY)) < 0) { if ((fildes = open(tfile, O_RDONLY)) < 0) {
strcpy(LoadMsg," unable to open temp file in load_foreign_files "); strcpy(_YAP_ErrorSay," unable to open temp file in load_foreign_files ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
read(fildes, (char *) &fileHeader, sizeof(fileHeader)); read(fildes, (char *) &fileHeader, sizeof(fileHeader));
@ -250,7 +250,7 @@ LoadForeign(StringList ofiles,
} }
loadImageSize = sysHeader.tsize + sysHeader.dsize + sysHeader.bsize; loadImageSize = sysHeader.tsize + sysHeader.dsize + sysHeader.bsize;
if (firstloadImSz < loadImageSize) { if (firstloadImSz < loadImageSize) {
strcpy(LoadMsg," miscalculation in load_foreign/3 "); strcpy(_YAP_ErrorSay," miscalculation in load_foreign/3 ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
/* now search for our init function */ /* now search for our init function */
@ -266,11 +266,11 @@ LoadForeign(StringList ofiles,
func_info[0].n_name = entry_fun; func_info[0].n_name = entry_fun;
func_info[1].n_name = NULL; func_info[1].n_name = NULL;
if (nlist(tfile, func_info) == -1) { if (nlist(tfile, func_info) == -1) {
strcpy(LoadMsg," in nlist(3) "); strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if (func_info[0].n_type == 0) { if (func_info[0].n_type == 0) {
strcpy(LoadMsg," in nlist(3) "); strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
*init_proc = (YapInitProc)(func_info[0].n_value); *init_proc = (YapInitProc)(func_info[0].n_value);
@ -290,13 +290,20 @@ LoadForeign(StringList ofiles,
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

43
C/load_dl.c
View File

@ -30,7 +30,7 @@
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
} }
@ -39,7 +39,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
Int static Int
LoadForeign(StringList ofiles, StringList libs, LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
@ -48,18 +48,18 @@ LoadForeign(StringList ofiles, StringList libs,
void *handle; void *handle;
/* dlopen wants to follow the LD_CONFIG_PATH */ /* dlopen wants to follow the LD_CONFIG_PATH */
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) { if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(LoadMsg, "[ Trying to open unexisting file in LoadForeign ]"); strcpy(_YAP_ErrorSay, "[ Trying to open unexisting file in LoadForeign ]");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
#ifdef __osf__ #ifdef __osf__
if((handle=dlopen(FileNameBuf,RTLD_LAZY)) == 0) if((handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY)) == 0)
#else #else
if((handle=dlopen(FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0) if((handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0)
#endif #endif
{ {
fprintf(stderr,"calling dlopen with error %s\n", dlerror()); fprintf(stderr,"dlopen of %s failed with error %s\n", _YAP_FileNameBuf, dlerror());
/* strcpy(LoadMsg,dlerror());*/ /* strcpy(_YAP_ErrorSay,dlerror());*/
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -72,7 +72,7 @@ LoadForeign(StringList ofiles, StringList libs,
} }
if(! *init_proc) { if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine"); strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -81,20 +81,20 @@ LoadForeign(StringList ofiles, StringList libs,
while (libs) { while (libs) {
if (libs->s[0] == '-') { if (libs->s[0] == '-') {
strcpy(FileNameBuf,"lib"); strcpy(_YAP_FileNameBuf,"lib");
strcat(FileNameBuf,libs->s+2); strcat(_YAP_FileNameBuf,libs->s+2);
strcat(FileNameBuf,".so"); strcat(_YAP_FileNameBuf,".so");
} else { } else {
strcpy(FileNameBuf,libs->s); strcpy(_YAP_FileNameBuf,libs->s);
} }
#ifdef __osf__ #ifdef __osf__
if((libs->handle=dlopen(FileNameBuf,RTLD_LAZY)) == NULL) if((libs->handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY)) == NULL)
#else #else
if((libs->handle=dlopen(FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL) if((libs->handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL)
#endif #endif
{ {
strcpy(LoadMsg,dlerror()); strcpy(_YAP_ErrorSay,dlerror());
return LOAD_FAILLED; return LOAD_FAILLED;
} }
libs = libs->next; libs = libs->next;
@ -102,8 +102,15 @@ LoadForeign(StringList ofiles, StringList libs,
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
ForeignObj *f_code; ForeignObj *f_code;
@ -128,7 +135,7 @@ ShutdownLoadForeign(void)
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

23
C/load_dld.c
View File

@ -28,7 +28,7 @@ static char YapExecutable[YAP_FILE_MAX];
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
/* use dld_find_executable */ /* use dld_find_executable */
char *res; char *res;
@ -44,7 +44,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
int static int
LoadForeign(StringList ofiles, StringList libs, LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
@ -54,7 +54,7 @@ LoadForeign(StringList ofiles, StringList libs,
if(firstTime) { if(firstTime) {
error = dld_init(YapExecutable); error = dld_init(YapExecutable);
if(error) { if(error) {
strcpy(LoadMsg,dld_strerror(error)); strcpy(_YAP_ErrorSay,dld_strerror(error));
return LOAD_FAILLED; return LOAD_FAILLED;
} }
firstTime=0; firstTime=0;
@ -62,7 +62,7 @@ LoadForeign(StringList ofiles, StringList libs,
while (ofiles) { while (ofiles) {
if((error=dld_link(ofiles->s)) !=0) { if((error=dld_link(ofiles->s)) !=0) {
strcpy(LoadMsg,dld_strerror(error)); strcpy(_YAP_ErrorSay,dld_strerror(error));
return LOAD_FAILLED; return LOAD_FAILLED;
} }
ofiles = ofiles->next; ofiles = ofiles->next;
@ -72,14 +72,14 @@ LoadForeign(StringList ofiles, StringList libs,
/* TODO: handle libs */ /* TODO: handle libs */
*init_proc = (YapInitProc) dld_get_func(proc_name); *init_proc = (YapInitProc) dld_get_func(proc_name);
if(! *init_proc) { if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine"); strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if(!dld_function_executable_p(proc_name)) { if(!dld_function_executable_p(proc_name)) {
char **undefs = dld_list_undefined_sym(); char **undefs = dld_list_undefined_sym();
char **p = undefs; char **p = undefs;
int k = dld_undefined_sym_count; int k = dld_undefined_sym_count;
strcpy(LoadMsg,"Could not resolve all symbols"); strcpy(_YAP_ErrorSay,"Could not resolve all symbols");
while(k) { while(k) {
YP_printf("[undefined symbol %s]\n",*p++); YP_printf("[undefined symbol %s]\n",*p++);
--k; --k;
@ -91,13 +91,20 @@ LoadForeign(StringList ofiles, StringList libs,
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

31
C/load_dll.c
View File

@ -28,7 +28,7 @@
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
} }
@ -37,7 +37,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
Int static Int
LoadForeign(StringList ofiles, StringList libs, LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
@ -45,8 +45,8 @@ LoadForeign(StringList ofiles, StringList libs,
while (ofiles) { while (ofiles) {
HINSTANCE handle; HINSTANCE handle;
if (TrueFileName(ofiles->s, FileNameBuf, TRUE) && if (_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE) &&
(handle=LoadLibrary(FileNameBuf)) != 0) (handle=LoadLibrary(_YAP_FileNameBuf)) != 0)
{ {
if (*init_proc == NULL) if (*init_proc == NULL)
*init_proc = (YapInitProc)GetProcAddress((HMODULE)handle, proc_name); *init_proc = (YapInitProc)GetProcAddress((HMODULE)handle, proc_name);
@ -60,15 +60,15 @@ LoadForeign(StringList ofiles, StringList libs,
HINSTANCE handle; HINSTANCE handle;
if (libs->s[0] == '-') { if (libs->s[0] == '-') {
strcat(FileNameBuf,libs->s+2); strcat(_YAP_FileNameBuf,libs->s+2);
strcat(FileNameBuf,".dll"); strcat(_YAP_FileNameBuf,".dll");
} else { } else {
strcpy(FileNameBuf,libs->s); strcpy(_YAP_FileNameBuf,libs->s);
} }
if((handle=LoadLibrary(FileNameBuf)) == 0) if((handle=LoadLibrary(_YAP_FileNameBuf)) == 0)
{ {
/* strcpy(LoadMsg,dlerror());*/ /* strcpy(_YAP_ErrorSay,dlerror());*/
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -79,20 +79,27 @@ LoadForeign(StringList ofiles, StringList libs,
} }
if(*init_proc == NULL) { if(*init_proc == NULL) {
strcpy(LoadMsg,"Could not locate initialization routine"); strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

37
C/load_dyld.c
View File

@ -63,7 +63,7 @@ mydlerror(void)
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
} }
@ -113,7 +113,7 @@ mydlclose(void *handle)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign * LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
Int static Int
LoadForeign(StringList ofiles, StringList libs, LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
@ -122,14 +122,14 @@ LoadForeign(StringList ofiles, StringList libs,
void *handle; void *handle;
/* mydlopen wants to follow the LD_CONFIG_PATH */ /* mydlopen wants to follow the LD_CONFIG_PATH */
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) { if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(LoadMsg, "[ Trying to open unexisting file in LoadForeign ]"); strcpy(_YAP_ErrorSay, "[ Trying to open unexisting file in LoadForeign ]");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
if((handle=mydlopen(FileNameBuf)) == 0) if((handle=mydlopen(_YAP_FileNameBuf)) == 0)
{ {
fprintf(stderr,"calling dlopen with error %s\n", mydlerror()); fprintf(stderr,"calling dlopen with error %s\n", mydlerror());
/* strcpy(LoadMsg,dlerror());*/ /* strcpy(_YAP_ErrorSay,dlerror());*/
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -142,16 +142,16 @@ LoadForeign(StringList ofiles, StringList libs,
while (libs) { while (libs) {
if (libs->s[0] == '-') { if (libs->s[0] == '-') {
strcpy(FileNameBuf,"lib"); strcpy(_YAP_FileNameBuf,"lib");
strcat(FileNameBuf,libs->s+2); strcat(_YAP_FileNameBuf,libs->s+2);
strcat(FileNameBuf,".so"); strcat(_YAP_FileNameBuf,".so");
} else { } else {
strcpy(FileNameBuf,libs->s); strcpy(_YAP_FileNameBuf,libs->s);
} }
if((libs->handle=mydlopen(FileNameBuf)) == NULL) if((libs->handle=mydlopen(_YAP_FileNameBuf)) == NULL)
{ {
strcpy(LoadMsg,mydlerror()); strcpy(_YAP_ErrorSay,mydlerror());
return LOAD_FAILLED; return LOAD_FAILLED;
} }
libs = libs->next; libs = libs->next;
@ -160,15 +160,22 @@ LoadForeign(StringList ofiles, StringList libs,
*init_proc = (YapInitProc) mydlsym(proc_name); *init_proc = (YapInitProc) mydlsym(proc_name);
if(! *init_proc) { if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine"); strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
return LOAD_SUCCEEDED; return LOAD_SUCCEEDED;
} }
Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
ForeignObj *f_code; ForeignObj *f_code;
@ -193,7 +200,7 @@ ShutdownLoadForeign(void)
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

32
C/load_foreign.c
View File

@ -28,14 +28,12 @@ static char SccsId[] = "%W% %G%.2";
#include "Foreign.h" #include "Foreign.h"
#if _WIN32 #if _WIN32 || defined(__CYGWIN__)
#ifndef SHLIB_SUFFIX #ifndef SHLIB_SUFFIX
#define SHLIB_SUFFIX "dll" #define SHLIB_SUFFIX "dll"
#endif #endif
#endif #endif
char LoadMsg[512];
STD_PROTO(Int p_load_foreign, (void)); STD_PROTO(Int p_load_foreign, (void));
Int Int
@ -49,7 +47,7 @@ p_load_foreign(void)
StringList new; StringList new;
Int returncode = FALSE; Int returncode = FALSE;
strcpy(LoadMsg,"Invalid arguments"); strcpy(_YAP_ErrorSay,"Invalid arguments");
/* collect the list of object files */ /* collect the list of object files */
t = Deref(ARG1); t = Deref(ARG1);
@ -57,7 +55,7 @@ p_load_foreign(void)
if (t == TermNil) break; if (t == TermNil) break;
t1 = HeadOfTerm(t); t1 = HeadOfTerm(t);
t = TailOfTerm(t); t = TailOfTerm(t);
new = (StringList) AllocCodeSpace(sizeof(StringListItem)); new = (StringList) _YAP_AllocCodeSpace(sizeof(StringListItem));
new->next = ofiles; new->next = ofiles;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE; new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
ofiles = new; ofiles = new;
@ -69,7 +67,7 @@ p_load_foreign(void)
if (t == TermNil) break; if (t == TermNil) break;
t1 = HeadOfTerm(t); t1 = HeadOfTerm(t);
t = TailOfTerm(t); t = TailOfTerm(t);
new = (StringList) AllocCodeSpace(sizeof(StringListItem)); new = (StringList) _YAP_AllocCodeSpace(sizeof(StringListItem));
new->next = libs; new->next = libs;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE; new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
libs = new; libs = new;
@ -82,14 +80,14 @@ p_load_foreign(void)
/* call the OS specific function for dynamic loading */ /* call the OS specific function for dynamic loading */
if(LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) { if(_YAP_LoadForeign(ofiles,libs,InitProcName,&InitProc)==LOAD_SUCCEEDED) {
(*InitProc)(); (*InitProc)();
returncode = TRUE; returncode = TRUE;
} }
/* I should recover space if load foreign fails */ /* I should recover space if load foreign fails */
if (returncode == TRUE) { if (returncode == TRUE) {
ForeignObj *f_code = (ForeignObj *)AllocCodeSpace(sizeof(ForeignObj)); ForeignObj *f_code = (ForeignObj *)_YAP_AllocCodeSpace(sizeof(ForeignObj));
f_code->objs = ofiles; f_code->objs = ofiles;
f_code->libs = libs; f_code->libs = libs;
f_code->f = InitProcName; f_code->f = InitProcName;
@ -102,22 +100,22 @@ p_load_foreign(void)
static Int static Int
p_obj_suffix(void) { p_obj_suffix(void) {
return(unify(StringToList(SHLIB_SUFFIX),ARG1)); return(_YAP_unify(_YAP_StringToList(SHLIB_SUFFIX),ARG1));
} }
void void
InitLoadForeign(void) _YAP_InitLoadForeign(void)
{ {
if (yap_args == NULL) if (_YAP_argv == NULL)
YAP_FindExecutable("yap"); _YAP_FindExecutable("yap");
else else
YAP_FindExecutable(yap_args[0]); _YAP_FindExecutable(_YAP_argv[0]);
InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag); _YAP_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag);
} }
void void
ReOpenLoadForeign(void) _YAP_ReOpenLoadForeign(void)
{ {
ForeignObj *f_code = ForeignCodeLoaded; ForeignObj *f_code = ForeignCodeLoaded;
SMALLUNSGN OldModule = CurrentModule; SMALLUNSGN OldModule = CurrentModule;
@ -125,7 +123,7 @@ ReOpenLoadForeign(void)
while (f_code != NULL) { while (f_code != NULL) {
CurrentModule = f_code->module; CurrentModule = f_code->module;
if(ReLoadForeign(f_code->objs,f_code->libs,f_code->f,&InitProc)==LOAD_SUCCEEDED) { if(_YAP_ReLoadForeign(f_code->objs,f_code->libs,f_code->f,&InitProc)==LOAD_SUCCEEDED) {
(*InitProc)(); (*InitProc)();
} }
f_code = f_code->next; f_code = f_code->next;

10
C/load_none.c
View File

@ -26,7 +26,7 @@
* locate the executable of Yap * locate the executable of Yap
*/ */
void void
YAP_FindExecutable(char *name) _YAP_FindExecutable(char *name)
{ {
} }
@ -36,20 +36,20 @@ YAP_FindExecutable(char *name)
* code file and locates an initialization routine * code file and locates an initialization routine
*/ */
Int Int
LoadForeign(StringList ofiles, StringList libs, _YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
strcpy(LoadMsg,"load_foreign not supported in this version of Yap"); strcpy(_YAP_ErrorSay,"load_foreign not supported in this version of Yap");
return LOAD_FAILLED; return LOAD_FAILLED;
} }
void void
ShutdownLoadForeign(void) _YAP_ShutdownLoadForeign(void)
{ {
} }
Int Int
ReLoadForeign(StringList ofiles, StringList libs, _YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
return(LoadForeign(ofiles,libs, proc_name, init_proc)); return(LoadForeign(ofiles,libs, proc_name, init_proc));

34
C/load_shl.c
View File

@ -16,7 +16,7 @@
* locate the executable of Yap * locate the executable of Yap
*/ */
void YAP_FindExecutable(char *name) void _YAP_FindExecutable(char *name)
{ {
} }
@ -26,7 +26,8 @@ void YAP_FindExecutable(char *name)
* code files and libraries and locates an initialization routine * code files and libraries and locates an initialization routine
*/ */
Int LoadForeign( StringList ofiles, StringList libs, static Int
LoadForeign( StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc ) char *proc_name, YapInitProc *init_proc )
{ {
@ -40,17 +41,17 @@ Int LoadForeign( StringList ofiles, StringList libs,
int valid_fname; int valid_fname;
/* shl_load wants to follow the LD_CONFIG_PATH */ /* shl_load wants to follow the LD_CONFIG_PATH */
valid_fname = TrueFileName( ofiles->s, FileNameBuf, TRUE ); valid_fname = _YAP_TrueFileName( ofiles->s, FileNameBuf, TRUE );
if( !valid_fname ) { if( !valid_fname ) {
strcpy( LoadMsg, "[ Trying to open non-existing file in LoadForeign ]" ); strcpy( _YAP_ErrorSay, "[ Trying to open non-existing file in LoadForeign ]" );
return LOAD_FAILLED; return LOAD_FAILLED;
} }
ofiles->handle = AllocCodeSpace( sizeof(shl_t) ); ofiles->handle = _YAP_AllocCodeSpace( sizeof(shl_t) );
*(shl_t *)ofiles->handle = shl_load( FileNameBuf, BIND_DEFERRED, 0 ); *(shl_t *)ofiles->handle = shl_load( FileNameBuf, BIND_DEFERRED, 0 );
if( *(shl_t *)ofiles->handle == NULL ) { if( *(shl_t *)ofiles->handle == NULL ) {
strncpy( LoadMsg, strerror(errno), 512 ); strncpy( _YAP_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE );
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -63,7 +64,7 @@ Int LoadForeign( StringList ofiles, StringList libs,
} }
if( init_missing ) { if( init_missing ) {
strcpy( LoadMsg, "Could not locate initialization routine" ); strcpy( _YAP_ErrorSay, "Could not locate initialization routine" );
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -80,7 +81,7 @@ Int LoadForeign( StringList ofiles, StringList libs,
*(shl_t *)libs->handle = shl_load( FileNameBuf, BIND_DEFERRED, 0 ); *(shl_t *)libs->handle = shl_load( FileNameBuf, BIND_DEFERRED, 0 );
if( *(shl_t *)libs->handle == NULL ) { if( *(shl_t *)libs->handle == NULL ) {
strncpy( LoadMsg, strerror(errno), 512 ); strncpy( _YAP_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE );
return LOAD_FAILLED; return LOAD_FAILLED;
} }
@ -91,7 +92,15 @@ Int LoadForeign( StringList ofiles, StringList libs,
} }
void ShutdownLoadForeign( void ) Int
_YAP_LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
return LoadForeign(ofiles, libs, proc_name, init_proc);
}
void
_YAP_ShutdownLoadForeign( void )
{ {
ForeignObj *f_code; ForeignObj *f_code;
int err; int err;
@ -108,7 +117,7 @@ void ShutdownLoadForeign( void )
perror( NULL ); perror( NULL );
return; return;
} }
FreeCodeSpace( objs->handle ); _YAP_FreeCodeSpace( objs->handle );
objs = objs->next; objs = objs->next;
} }
@ -120,14 +129,15 @@ void ShutdownLoadForeign( void )
perror( NULL ); perror( NULL );
return; return;
} }
FreeCodeSpace( libs->handle ); _YAP_FreeCodeSpace( libs->handle );
libs = libs->next; libs = libs->next;
} }
f_code = f_code->next; f_code = f_code->next;
} }
} }
Int ReLoadForeign(StringList ofiles, StringList libs, Int
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc) char *proc_name, YapInitProc *init_proc)
{ {
ShutdownLoadForeign(); ShutdownLoadForeign();

83
C/mavar.c
View File

@ -35,32 +35,32 @@ p_setarg(void)
CELL ti = Deref(ARG1), ts = Deref(ARG2); CELL ti = Deref(ARG1), ts = Deref(ARG2);
Int i; Int i;
if (IsVarTerm(ti)) { if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"setarg/3"); _YAP_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return(FALSE); return(FALSE);
} else { } else {
if (IsIntTerm(ti)) if (IsIntTerm(ti))
i = IntOfTerm(ti); i = IntOfTerm(ti);
else { else {
union arith_ret v; union arith_ret v;
if (Eval(ti, &v) == long_int_e) { if (_YAP_Eval(ti, &v) == long_int_e) {
i = v.Int; i = v.Int;
} else { } else {
Error(TYPE_ERROR_INTEGER,ti,"setarg/3"); _YAP_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return(FALSE); return(FALSE);
} }
} }
} }
if (IsVarTerm(ts)) { if (IsVarTerm(ts)) {
Error(INSTANTIATION_ERROR,ts,"setarg/3"); _YAP_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) { } else if(IsApplTerm(ts)) {
CELL *pt; CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) { if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); _YAP_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return(FALSE); return(FALSE);
} }
if (i < 0 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) { if (i < 0 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0) if (i<0)
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); _YAP_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return(FALSE); return(FALSE);
} }
pt = RepAppl(ts)+i; pt = RepAppl(ts)+i;
@ -70,14 +70,14 @@ p_setarg(void)
CELL *pt; CELL *pt;
if (i != 1 || i != 2) { if (i != 1 || i != 2) {
if (i<0) if (i<0)
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3"); _YAP_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return(FALSE); return(FALSE);
} }
pt = RepPair(ts)+i-1; pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */ /* the evil deed is to be done now */
MaBind(pt, Deref(ARG3)); MaBind(pt, Deref(ARG3));
} else { } else {
Error(TYPE_ERROR_COMPOUND,ts,"setarg/3"); _YAP_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return(FALSE); return(FALSE);
} }
return(TRUE); return(TRUE);
@ -112,7 +112,7 @@ static void
CreateTimedVar(Term val) CreateTimedVar(Term val)
{ {
timed_var *tv = (timed_var *)H; timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase); tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)_YAP_TrailBase);
if (B->cp_tr == TR) { if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before /* we run the risk of not making non-determinate bindings before
the end of the night */ the end of the night */
@ -127,7 +127,7 @@ static void
CreateEmptyTimedVar(void) CreateEmptyTimedVar(void)
{ {
timed_var *tv = (timed_var *)H; timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)TrailBase); tv->clock = MkIntegerTerm(B->cp_tr-(tr_fr_ptr)_YAP_TrailBase);
if (B->cp_tr == TR) { if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before /* we run the risk of not making non-determinate bindings before
the end of the night */ the end of the night */
@ -139,7 +139,8 @@ CreateEmptyTimedVar(void)
} }
#endif #endif
Term NewTimedVar(CELL val) static Term
NewTimedVar(CELL val)
{ {
Term out = AbsAppl(H); Term out = AbsAppl(H);
#if FROZEN_STACKS #if FROZEN_STACKS
@ -156,7 +157,14 @@ Term NewTimedVar(CELL val)
return(out); return(out);
} }
Term NewEmptyTimedVar(void) Term
_YAP_NewTimedVar(CELL val)
{
return NewTimedVar(val);
}
Term
_YAP_NewEmptyTimedVar(void)
{ {
Term out = AbsAppl(H); Term out = AbsAppl(H);
#if FROZEN_STACKS #if FROZEN_STACKS
@ -173,20 +181,28 @@ Term NewEmptyTimedVar(void)
return(out); return(out);
} }
Term ReadTimedVar(Term inv) static Term
ReadTimedVar(Term inv)
{ {
timed_var *tv = (timed_var *)(RepAppl(inv)+1); timed_var *tv = (timed_var *)(RepAppl(inv)+1);
return(tv->value); return(tv->value);
} }
Term
_YAP_ReadTimedVar(Term inv)
{
return ReadTimedVar(inv);
}
/* update a timed var with a new value */ /* update a timed var with a new value */
Term UpdateTimedVar(Term inv, Term new) static Term
UpdateTimedVar(Term inv, Term new)
{ {
timed_var *tv = (timed_var *)(RepAppl(inv)+1); timed_var *tv = (timed_var *)(RepAppl(inv)+1);
CELL t = tv->value; CELL t = tv->value;
#if FROZEN_STACKS #if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)TrailBase + IntegerOfTerm(tv->clock); tr_fr_ptr timestmp = (tr_fr_ptr)_YAP_TrailBase + IntegerOfTerm(tv->clock);
if (B->cp_tr <= timestmp && timestmp <= TR) { if (B->cp_tr <= timestmp && timestmp <= TR) {
/* last assignment more recent than last B */ /* last assignment more recent than last B */
@ -203,7 +219,7 @@ Term UpdateTimedVar(Term inv, Term new)
} else { } else {
Term nclock; Term nclock;
MaBind(&(tv->value), new); MaBind(&(tv->value), new);
nclock = MkIntegerTerm(TR-(tr_fr_ptr)TrailBase); nclock = MkIntegerTerm(TR-(tr_fr_ptr)_YAP_TrailBase);
MaBind(&(tv->clock), nclock); MaBind(&(tv->clock), nclock);
} }
#else #else
@ -228,11 +244,18 @@ Term UpdateTimedVar(Term inv, Term new)
return(t); return(t);
} }
/* update a timed var with a new value */
Term
_YAP_UpdateTimedVar(Term inv, Term new)
{
return UpdateTimedVar(inv, new);
}
static Int static Int
p_create_mutable(void) p_create_mutable(void)
{ {
Term t = NewTimedVar(Deref(ARG1)); Term t = NewTimedVar(Deref(ARG1));
return(unify(ARG2,t)); return(_YAP_unify(ARG2,t));
} }
static Int static Int
@ -240,19 +263,19 @@ p_get_mutable(void)
{ {
Term t = Deref(ARG2); Term t = Deref(ARG2);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "get_mutable/3"); _YAP_Error(INSTANTIATION_ERROR, t, "get_mutable/3");
return(FALSE); return(FALSE);
} }
if (!IsApplTerm(t)) { if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3"); _YAP_Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
return(FALSE); return(FALSE);
} }
if (FunctorOfTerm(t) != FunctorMutable) { if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3"); _YAP_Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
return(FALSE); return(FALSE);
} }
t = ReadTimedVar(t); t = ReadTimedVar(t);
return(unify(ARG1, t)); return(_YAP_unify(ARG1, t));
} }
static Int static Int
@ -260,15 +283,15 @@ p_update_mutable(void)
{ {
Term t = Deref(ARG2); Term t = Deref(ARG2);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "update_mutable/3"); _YAP_Error(INSTANTIATION_ERROR, t, "update_mutable/3");
return(FALSE); return(FALSE);
} }
if (!IsApplTerm(t)) { if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3"); _YAP_Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
return(FALSE); return(FALSE);
} }
if (FunctorOfTerm(t) != FunctorMutable) { if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3"); _YAP_Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
return(FALSE); return(FALSE);
} }
UpdateTimedVar(t, Deref(ARG1)); UpdateTimedVar(t, Deref(ARG1));
@ -294,14 +317,14 @@ p_is_mutable(void)
#endif #endif
void void
InitMaVarCPreds(void) _YAP_InitMaVarCPreds(void)
{ {
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
/* The most famous contributions of SICStus to the Prolog language */ /* The most famous contributions of SICStus to the Prolog language */
InitCPred("setarg", 3, p_setarg, SafePredFlag); _YAP_InitCPred("setarg", 3, p_setarg, SafePredFlag);
InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag); _YAP_InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag); _YAP_InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag); _YAP_InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag); _YAP_InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
#endif #endif
} }

38
C/modules.c
View File

@ -24,11 +24,10 @@ static char SccsId[] = "%W% %G%";
STATIC_PROTO(Int p_current_module, (void)); STATIC_PROTO(Int p_current_module, (void));
STATIC_PROTO(Int p_current_module1, (void)); STATIC_PROTO(Int p_current_module1, (void));
STD_PROTO(void InitModules, (void));
#define ByteAdr(X) ((char *) &(X)) #define ByteAdr(X) ((char *) &(X))
Term Term
Module_Name(CODEADDR cap) _YAP_Module_Name(CODEADDR cap)
{ {
PredEntry *ap = (PredEntry *)cap; PredEntry *ap = (PredEntry *)cap;
@ -46,7 +45,7 @@ Module_Name(CODEADDR cap)
} }
} }
SMALLUNSGN static SMALLUNSGN
LookupModule(Term a) LookupModule(Term a)
{ {
unsigned int i; unsigned int i;
@ -56,18 +55,23 @@ LookupModule(Term a)
return (i); return (i);
ModuleName[i = NoOfModules++] = a; ModuleName[i = NoOfModules++] = a;
if (NoOfModules == MaxModules) { if (NoOfModules == MaxModules) {
Error(SYSTEM_ERROR,a,"number of modules overflowed"); _YAP_Error(SYSTEM_ERROR,a,"number of modules overflowed");
} }
return (i); return (i);
} }
SMALLUNSGN
_YAP_LookupModule(Term a)
{
return(LookupModule(a));
}
static Int static Int
p_current_module(void) p_current_module(void)
{ /* $current_module(Old,New) */ { /* $current_module(Old,New) */
Term t; Term t;
unsigned int i; unsigned int i;
if (!unify_constant(ARG1, ModuleName[CurrentModule])) if (!_YAP_unify_constant(ARG1, ModuleName[CurrentModule]))
return (0); return (0);
t = Deref(ARG2); t = Deref(ARG2);
if (IsVarTerm(t) || !IsAtomTerm(t)) if (IsVarTerm(t) || !IsAtomTerm(t))
@ -85,7 +89,7 @@ p_current_module(void)
static Int static Int
p_current_module1(void) p_current_module1(void)
{ /* $current_module(Old) */ { /* $current_module(Old) */
if (!unify_constant(ARG1, ModuleName[CurrentModule])) if (!_YAP_unify_constant(ARG1, ModuleName[CurrentModule]))
return (0); return (0);
return (1); return (1);
} }
@ -104,10 +108,10 @@ p_module_number(void)
Term tname = Deref(ARG1); Term tname = Deref(ARG1);
Term t; Term t;
if (IsVarTerm(tname)) { if (IsVarTerm(tname)) {
return(unify(tname, ModuleName[IntOfTerm(Deref(ARG2))])); return(_YAP_unify(tname, ModuleName[IntOfTerm(Deref(ARG2))]));
}else { }else {
t = MkIntTerm(LookupModule(Deref(ARG1))); t = MkIntTerm(LookupModule(Deref(ARG1)));
unify(t,ARG2); _YAP_unify(t,ARG2);
ARG2 = t; ARG2 = t;
} }
return(TRUE); return(TRUE);
@ -123,7 +127,7 @@ cont_current_module(void)
cut_fail(); cut_fail();
} }
EXTRA_CBACK_ARG(1,1) = MkIntTerm(mod+1); EXTRA_CBACK_ARG(1,1) = MkIntTerm(mod+1);
return(unify(ARG1,t)); return(_YAP_unify(ARG1,t));
} }
static Int static Int
@ -134,18 +138,18 @@ init_current_module(void)
} }
void void
InitModules(void) _YAP_InitModules(void)
{ {
ModuleName[PrimitivesModule = 0] = ModuleName[PrimitivesModule = 0] =
MkAtomTerm(LookupAtom("prolog")); MkAtomTerm(_YAP_LookupAtom("prolog"));
ModuleName[1] = ModuleName[1] =
MkAtomTerm(LookupAtom("user")); MkAtomTerm(_YAP_LookupAtom("user"));
NoOfModules = 2; NoOfModules = 2;
CurrentModule = 0; CurrentModule = 0;
InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
InitCPred("$module_number", 2, p_module_number, SafePredFlag); _YAP_InitCPred("$module_number", 2, p_module_number, SafePredFlag);
InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module, _YAP_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
SafePredFlag|SyncPredFlag); SafePredFlag|SyncPredFlag);
} }

27
C/other.c
View File

@ -23,19 +23,21 @@ static char SccsId[] = "%W% %G%";
#include "Yatom.h" #include "Yatom.h"
#include "Heap.h" #include "Heap.h"
Term /* exile _YAP_standard_regs here, otherwise WIN32 linkers may complain */
MkPairTerm(Term head, Term tail) REGSTORE _YAP_standard_regs;
{
register CELL *p = H;
*H++ = (CELL) (head); #if PUSH_REGS
*H++ = (CELL) (tail);
return (AbsPair(p));
}
REGSTORE *_YAP_regp;
#else
REGSTORE _YAP_REGS;
#endif
Term Term
MkNewPairTerm(void) _YAP_MkNewPairTerm(void)
{ {
register CELL *p = H; register CELL *p = H;
@ -45,9 +47,8 @@ MkNewPairTerm(void)
return (AbsPair(p)); return (AbsPair(p));
} }
Term
Term _YAP_MkApplTerm(Functor f, unsigned int n, register Term *a)
MkApplTerm(Functor f, unsigned int n, register Term *a)
/* build compound term with functor f and n /* build compound term with functor f and n
* args a */ * args a */
{ {
@ -64,7 +65,7 @@ MkApplTerm(Functor f, unsigned int n, register Term *a)
} }
Term Term
MkNewApplTerm(Functor f, unsigned int n) _YAP_MkNewApplTerm(Functor f, unsigned int n)
/* build compound term with functor f and n /* build compound term with functor f and n
* args a */ * args a */
{ {

197
C/parser.c
View File

@ -79,7 +79,7 @@ static JMPBUFF FailBuff;
#define TRY(S,P) \ #define TRY(S,P) \
{ Volatile JMPBUFF saveenv;\ { Volatile JMPBUFF saveenv;\
Volatile TokEntry *saveT=tokptr; \ Volatile TokEntry *saveT=_YAP_tokptr; \
Volatile CELL *saveH=H;\ Volatile CELL *saveH=H;\
Volatile int savecurprio=curprio;\ Volatile int savecurprio=curprio;\
saveenv=FailBuff;\ saveenv=FailBuff;\
@ -91,42 +91,39 @@ static JMPBUFF FailBuff;
else { FailBuff=saveenv; \ else { FailBuff=saveenv; \
H=saveH; \ H=saveH; \
curprio = savecurprio; \ curprio = savecurprio; \
tokptr=saveT; \ _YAP_tokptr=saveT; \
}\ }\
}\ }\
#define TRY3(S,P,F) \ #define TRY3(S,P,F) \
{ Volatile JMPBUFF saveenv;\ { Volatile JMPBUFF saveenv;\
Volatile TokEntry *saveT=tokptr; Volatile CELL *saveH=H;\ Volatile TokEntry *saveT=_YAP_tokptr; Volatile CELL *saveH=H;\
saveenv=FailBuff;\ saveenv=FailBuff;\
if(!setjmp(FailBuff.JmpBuff)) {\ if(!setjmp(FailBuff.JmpBuff)) {\
S;\ S;\
FailBuff=saveenv;\ FailBuff=saveenv;\
P;\ P;\
}\ }\
else { FailBuff=saveenv; H=saveH; tokptr=saveT; F }\ else { FailBuff=saveenv; H=saveH; _YAP_tokptr=saveT; F }\
}\ }\
#define FAIL longjmp(FailBuff.JmpBuff,1) #define FAIL longjmp(FailBuff.JmpBuff,1)
TokEntry *tokptr, *toktide;
VarEntry *VarTable, *AnonVarTable;
VarEntry * VarEntry *
LookupVar(char *var) /* lookup variable in variables table */ _YAP_LookupVar(char *var) /* lookup variable in variables table */
{ {
VarEntry *p; VarEntry *p;
#ifdef DEBUG #ifdef DEBUG
if (Option[4]) if (_YAP_Option[4])
YP_fprintf(YP_stderr,"[LookupVar %s]", var); fprintf(_YAP_stderr,"[LookupVar %s]", var);
#endif #endif
if (var[0] != '_' || var[1] != '\0') { if (var[0] != '_' || var[1] != '\0') {
VarEntry **op = &VarTable; VarEntry **op = &_YAP_VarTable;
unsigned char *vp = (unsigned char *)var; unsigned char *vp = (unsigned char *)var;
CELL hv; CELL hv;
p = VarTable; p = _YAP_VarTable;
HashFunction(vp, hv); HashFunction(vp, hv);
while (p != NULL) { while (p != NULL) {
CELL hpv = p->hv; CELL hpv = p->hv;
@ -149,16 +146,16 @@ LookupVar(char *var) /* lookup variable in variables table */
p = p->VarRight; p = p->VarRight;
} }
} }
p = (VarEntry *) AllocScannerMemory(strlen(var) + sizeof(VarEntry)); p = (VarEntry *) _YAP_AllocScannerMemory(strlen(var) + sizeof(VarEntry));
*op = p; *op = p;
p->VarLeft = p->VarRight = NULL; p->VarLeft = p->VarRight = NULL;
p->hv = hv; p->hv = hv;
strcpy(p->VarRep, var); strcpy(p->VarRep, var);
} else { } else {
/* anon var */ /* anon var */
p = (VarEntry *) AllocScannerMemory(sizeof(VarEntry) + 2); p = (VarEntry *) _YAP_AllocScannerMemory(sizeof(VarEntry) + 2);
p->VarLeft = AnonVarTable; p->VarLeft = _YAP_AnonVarTable;
AnonVarTable = p; _YAP_AnonVarTable = p;
p->VarRight = NULL; p->VarRight = NULL;
p->hv = 0L; p->hv = 0L;
p->VarRep[0] = '_'; p->VarRep[0] = '_';
@ -168,16 +165,16 @@ LookupVar(char *var) /* lookup variable in variables table */
return (p); return (p);
} }
Term static Term
VarNames(VarEntry *p,Term l) VarNames(VarEntry *p,Term l)
{ {
if (p != NULL) { if (p != NULL) {
if (strcmp(p->VarRep, "_") != 0) { if (strcmp(p->VarRep, "_") != 0) {
Term o = MkPairTerm(MkPairTerm(StringToList(p->VarRep), p->VarAdr), Term o = MkPairTerm(MkPairTerm(_YAP_StringToList(p->VarRep), p->VarAdr),
VarNames(p->VarRight, VarNames(p->VarRight,
VarNames(p->VarLeft,l))); VarNames(p->VarLeft,l)));
if (H > ASP-4096) { if (H > ASP-4096) {
longjmp(IOBotch,1); longjmp(_YAP_IOBotch,1);
} }
return(o); return(o);
} else { } else {
@ -188,7 +185,13 @@ VarNames(VarEntry *p,Term l)
} }
} }
int Term
_YAP_VarNames(VarEntry *p,Term l)
{
return VarNames(p,l);
}
static int
IsPrefixOp(Prop opinfo,int *pptr, int *rpptr) IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
{ {
int p; int p;
@ -207,6 +210,12 @@ IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
} }
int int
_YAP_IsPrefixOp(Prop opinfo,int *pptr, int *rpptr)
{
return IsPrefixOp(opinfo,pptr,rpptr);
}
static int
IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr) IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
{ {
int p; int p;
@ -227,6 +236,12 @@ IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
} }
int int
_YAP_IsInfixOp(Prop opinfo, int *pptr, int *lpptr, int *rpptr)
{
return IsInfixOp(opinfo, pptr, lpptr, rpptr);
}
static int
IsPosfixOp(Prop opinfo, int *pptr, int *lpptr) IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
{ {
int p; int p;
@ -243,27 +258,33 @@ IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
} }
} }
int
_YAP_IsPosfixOp(Prop opinfo, int *pptr, int *lpptr)
{
return IsPosfixOp(opinfo, pptr, lpptr);
}
inline static void inline static void
GNextToken(void) GNextToken(void)
{ {
if (tokptr->Tok == Ord(eot_tok)) if (_YAP_tokptr->Tok == Ord(eot_tok))
return; return;
#ifdef EMACS #ifdef EMACS
if ((tokptr = tokptr->TokNext)->TokPos > toktide->TokPos) if ((_YAP_tokptr = _YAP_tokptr->TokNext)->TokPos > _YAP_toktide->TokPos)
toktide = tokptr; _YAP_toktide = _YAP_tokptr;
#else #else
if (tokptr == toktide) if (_YAP_tokptr == _YAP_toktide)
toktide = tokptr = tokptr->TokNext; _YAP_toktide = _YAP_tokptr = _YAP_tokptr->TokNext;
else else
tokptr = tokptr->TokNext; _YAP_tokptr = _YAP_tokptr->TokNext;
#endif #endif
} }
inline static void inline static void
checkfor(Term c) checkfor(Term c)
{ {
if (tokptr->Tok != Ord(Ponctuation_tok) if (_YAP_tokptr->Tok != Ord(Ponctuation_tok)
|| tokptr->TokInfo != c) || _YAP_tokptr->TokInfo != c)
FAIL; FAIL;
NextToken; NextToken;
} }
@ -274,7 +295,7 @@ ParseArgs(Atom a)
int nargs = 0; int nargs = 0;
Term *p, t; Term *p, t;
#ifdef SFUNC #ifdef SFUNC
SFEntry *pe = (SFEntry *) GetAProp(a, SFProperty); SFEntry *pe = (SFEntry *) _YAP_GetAProp(a, SFProperty);
#endif #endif
NextToken; NextToken;
@ -284,9 +305,9 @@ ParseArgs(Atom a)
*tp++ = Unsigned(ParseTerm(999)); *tp++ = Unsigned(ParseTerm(999));
ParserAuxSp = (tr_fr_ptr)tp; ParserAuxSp = (tr_fr_ptr)tp;
++nargs; ++nargs;
if (tokptr->Tok != Ord(Ponctuation_tok)) if (_YAP_tokptr->Tok != Ord(Ponctuation_tok))
break; break;
if (((int) tokptr->TokInfo) != ',') if (((int) _YAP_tokptr->TokInfo) != ',')
break; break;
NextToken; NextToken;
} }
@ -296,16 +317,16 @@ ParseArgs(Atom a)
* order * order
*/ */
if (H > ASP-(nargs+1)) { if (H > ASP-(nargs+1)) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
#ifdef SFUNC #ifdef SFUNC
if (pe) if (pe)
t = MkSFTerm(MkFunctor(a, SFArity), nargs, p, pe->NilValue); t = MkSFTerm(_YAP_MkFunctor(a, SFArity), nargs, p, pe->NilValue);
else else
t = MkApplTerm(MkFunctor(a, nargs), nargs, p); t = _YAP_MkApplTerm(_YAP_MkFunctor(a, nargs), nargs, p);
#else #else
t = MkApplTerm(MkFunctor(a, nargs), nargs, p); t = _YAP_MkApplTerm(_YAP_MkFunctor(a, nargs), nargs, p);
#endif #endif
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
checkfor((Term) ')'); checkfor((Term) ')');
@ -316,32 +337,32 @@ ParseArgs(Atom a)
static Term static Term
ParseList(void) ParseList(void)
{ {
Term t, s, o; Term o;
CELL *to_store; CELL *to_store;
o = AbsPair(H); o = AbsPair(H);
loop: loop:
to_store = H; to_store = H;
H+=2; H+=2;
to_store[0] = ParseTerm(999); to_store[0] = ParseTerm(999);
if (tokptr->Tok == Ord(Ponctuation_tok)) { if (_YAP_tokptr->Tok == Ord(Ponctuation_tok)) {
if (((int) tokptr->TokInfo) == ',') { if (((int) _YAP_tokptr->TokInfo) == ',') {
NextToken; NextToken;
if (tokptr->Tok == Ord(Name_tok) if (_YAP_tokptr->Tok == Ord(Name_tok)
&& strcmp(RepAtom((Atom)(tokptr->TokInfo))->StrOfAE, "..") == 0) { && strcmp(RepAtom((Atom)(_YAP_tokptr->TokInfo))->StrOfAE, "..") == 0) {
NextToken; NextToken;
to_store[1] = ParseTerm(999); to_store[1] = ParseTerm(999);
} else { } else {
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
to_store[1] = TermNil; to_store[1] = TermNil;
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} else { } else {
to_store[1] = AbsPair(H); to_store[1] = AbsPair(H);
goto loop; goto loop;
} }
} }
} else if (((int) tokptr->TokInfo) == '|') { } else if (((int) _YAP_tokptr->TokInfo) == '|') {
NextToken; NextToken;
to_store[1] = ParseTerm(999); to_store[1] = ParseTerm(999);
} else { } else {
@ -370,29 +391,29 @@ ParseTerm(int prio)
Volatile VarEntry *varinfo; Volatile VarEntry *varinfo;
Volatile int curprio = 0, opprio, oplprio, oprprio; Volatile int curprio = 0, opprio, oplprio, oprprio;
switch (tokptr->Tok) { switch (_YAP_tokptr->Tok) {
case Name_tok: case Name_tok:
t = tokptr->TokInfo; t = _YAP_tokptr->TokInfo;
NextToken; NextToken;
if ((tokptr->Tok != Ord(Ponctuation_tok) if ((_YAP_tokptr->Tok != Ord(Ponctuation_tok)
|| Unsigned(tokptr->TokInfo) != 'l') || Unsigned(_YAP_tokptr->TokInfo) != 'l')
&& (opinfo = GetAProp((Atom) t, OpProperty)) && (opinfo = _YAP_GetAProp((Atom) t, OpProperty))
&& IsPrefixOp(opinfo, &opprio, &oprprio) && IsPrefixOp(opinfo, &opprio, &oprprio)
) { ) {
/* special rules apply for +1, -2.3, etc... */ /* special rules apply for +1, -2.3, etc... */
if (tokptr->Tok == Number_tok) { if (_YAP_tokptr->Tok == Number_tok) {
if ((Atom)t == AtomMinus) { if ((Atom)t == AtomMinus) {
t = tokptr->TokInfo; t = _YAP_tokptr->TokInfo;
if (IsIntTerm(t)) if (IsIntTerm(t))
t = MkIntTerm(-IntOfTerm(t)); t = MkIntTerm(-IntOfTerm(t));
else if (IsFloatTerm(t)) else if (IsFloatTerm(t))
t = MkFloatTerm(-FloatOfTerm(t)); t = MkFloatTerm(-FloatOfTerm(t));
#ifdef USE_GMP #ifdef USE_GMP
else if (IsBigIntTerm(t)) { else if (IsBigIntTerm(t)) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_neg(new, BigIntOfTerm(t)); mpz_neg(new, _YAP_BigIntOfTerm(t));
t = MkBigIntTerm(new); t = _YAP_MkBigIntTerm(new);
} }
#endif #endif
else else
@ -400,12 +421,12 @@ ParseTerm(int prio)
NextToken; NextToken;
break; break;
} else if ((Atom)t == AtomPlus) { } else if ((Atom)t == AtomPlus) {
t = tokptr->TokInfo; t = _YAP_tokptr->TokInfo;
NextToken; NextToken;
break; break;
} }
} else if (tokptr->Tok == Name_tok) { } else if (_YAP_tokptr->Tok == Name_tok) {
Atom at = (Atom)tokptr->TokInfo; Atom at = (Atom)_YAP_tokptr->TokInfo;
#ifndef _MSC_VER #ifndef _MSC_VER
if ((Atom)t == AtomPlus) { if ((Atom)t == AtomPlus) {
if (at == AtomInf) { if (at == AtomInf) {
@ -434,12 +455,12 @@ ParseTerm(int prio)
/* try to parse as a prefix operator */ /* try to parse as a prefix operator */
TRY( TRY(
/* build appl on the heap */ /* build appl on the heap */
func = MkFunctor((Atom) t, 1); func = _YAP_MkFunctor((Atom) t, 1);
t = ParseTerm(oprprio); t = ParseTerm(oprprio);
t = MkApplTerm(func, 1, &t); t = _YAP_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = opprio; curprio = opprio;
@ -448,35 +469,35 @@ ParseTerm(int prio)
) )
} }
} }
if (tokptr->Tok == Ord(Ponctuation_tok) if (_YAP_tokptr->Tok == Ord(Ponctuation_tok)
&& Unsigned(tokptr->TokInfo) == 'l') && Unsigned(_YAP_tokptr->TokInfo) == 'l')
t = ParseArgs((Atom) t); t = ParseArgs((Atom) t);
else else
t = MkAtomTerm((Atom)t); t = MkAtomTerm((Atom)t);
break; break;
case Number_tok: case Number_tok:
t = tokptr->TokInfo; t = _YAP_tokptr->TokInfo;
NextToken; NextToken;
break; break;
case String_tok: /* build list on the heap */ case String_tok: /* build list on the heap */
{ {
Volatile char *p = (char *) tokptr->TokInfo; Volatile char *p = (char *) _YAP_tokptr->TokInfo;
if (*p == 0) if (*p == 0)
t = MkAtomTerm(AtomNil); t = MkAtomTerm(AtomNil);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS) else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS)
t = StringToListOfAtoms(p); t = _YAP_StringToListOfAtoms(p);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM) else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM)
t = MkAtomTerm(LookupAtom(p)); t = MkAtomTerm(_YAP_LookupAtom(p));
else else
t = StringToList(p); t = _YAP_StringToList(p);
NextToken; NextToken;
} }
break; break;
case Var_tok: case Var_tok:
varinfo = (VarEntry *) (tokptr->TokInfo); varinfo = (VarEntry *) (_YAP_tokptr->TokInfo);
if ((t = varinfo->VarAdr) == TermNil) { if ((t = varinfo->VarAdr) == TermNil) {
t = varinfo->VarAdr = MkVarTerm(); t = varinfo->VarAdr = MkVarTerm();
} }
@ -484,7 +505,7 @@ ParseTerm(int prio)
break; break;
case Ponctuation_tok: case Ponctuation_tok:
switch ((int) tokptr->TokInfo) { switch ((int) _YAP_tokptr->TokInfo) {
case '(': case '(':
case 'l': /* non solo ( */ case 'l': /* non solo ( */
NextToken; NextToken;
@ -498,16 +519,16 @@ ParseTerm(int prio)
break; break;
case '{': case '{':
NextToken; NextToken;
if (tokptr->Tok == Ord(Ponctuation_tok) && if (_YAP_tokptr->Tok == Ord(Ponctuation_tok) &&
Unsigned(tokptr->TokInfo) == '}') { Unsigned(_YAP_tokptr->TokInfo) == '}') {
t = MkAtomTerm(NameOfFunctor(FunctorBraces)); t = MkAtomTerm(NameOfFunctor(FunctorBraces));
NextToken; NextToken;
} else { } else {
t = ParseTerm(1200); t = ParseTerm(1200);
t = MkApplTerm(FunctorBraces, 1, &t); t = _YAP_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
checkfor((Term) '}'); checkfor((Term) '}');
@ -525,24 +546,24 @@ ParseTerm(int prio)
/* main loop to parse infix and posfix operators starts here */ /* main loop to parse infix and posfix operators starts here */
while (TRUE) { while (TRUE) {
if (tokptr->Tok == Ord(Name_tok) if (_YAP_tokptr->Tok == Ord(Name_tok)
&& (opinfo = GetAProp((Atom)(tokptr->TokInfo), OpProperty))) { && (opinfo = _YAP_GetAProp((Atom)(_YAP_tokptr->TokInfo), OpProperty))) {
Prop save_opinfo = opinfo; Prop save_opinfo = opinfo;
if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio) if (IsInfixOp(opinfo, &opprio, &oplprio, &oprprio)
&& opprio <= prio && oplprio >= curprio) { && opprio <= prio && oplprio >= curprio) {
/* try parsing as infix operator */ /* try parsing as infix operator */
Volatile int oldprio = curprio; Volatile int oldprio = curprio;
TRY3( TRY3(
func = MkFunctor((Atom) tokptr->TokInfo, 2); func = _YAP_MkFunctor((Atom) _YAP_tokptr->TokInfo, 2);
NextToken; NextToken;
{ {
Term args[2]; Term args[2];
args[0] = t; args[0] = t;
args[1] = ParseTerm(oprprio); args[1] = ParseTerm(oprprio);
t = MkApplTerm(func, 2, args); t = _YAP_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
}, },
@ -557,10 +578,10 @@ ParseTerm(int prio)
if (IsPosfixOp(opinfo, &opprio, &oplprio) if (IsPosfixOp(opinfo, &opprio, &oplprio)
&& opprio <= prio && oplprio >= curprio) { && opprio <= prio && oplprio >= curprio) {
/* parse as posfix operator */ /* parse as posfix operator */
t = MkApplTerm(MkFunctor((Atom) tokptr->TokInfo, 1), 1, &t); t = _YAP_MkApplTerm(_YAP_MkFunctor((Atom) _YAP_tokptr->TokInfo, 1), 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = opprio; curprio = opprio;
@ -569,38 +590,38 @@ ParseTerm(int prio)
} }
break; break;
} }
if (tokptr->Tok == Ord(Ponctuation_tok)) { if (_YAP_tokptr->Tok == Ord(Ponctuation_tok)) {
if (Unsigned(tokptr->TokInfo) == ',' && if (Unsigned(_YAP_tokptr->TokInfo) == ',' &&
prio >= 1000 && curprio <= 999) { prio >= 1000 && curprio <= 999) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(1000); args[1] = ParseTerm(1000);
t = MkApplTerm(MkFunctor(AtomComma, 2), 2, args); t = _YAP_MkApplTerm(_YAP_MkFunctor(AtomComma, 2), 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = 1000; curprio = 1000;
continue; continue;
} else if (Unsigned(tokptr->TokInfo) == '|' && prio >= 1100 && } else if (Unsigned(_YAP_tokptr->TokInfo) == '|' && prio >= 1100 &&
curprio <= 1099) { curprio <= 1099) {
Volatile Term args[2]; Volatile Term args[2];
NextToken; NextToken;
args[0] = t; args[0] = t;
args[1] = ParseTerm(1100); args[1] = ParseTerm(1100);
t = MkApplTerm(FunctorVBar, 2, args); t = _YAP_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (H > ASP-4096) { if (H > ASP-4096) {
ErrorMessage = "Stack Overflow"; _YAP_ErrorMessage = "Stack Overflow";
FAIL; FAIL;
} }
curprio = 1100; curprio = 1100;
continue; continue;
} }
} }
if (tokptr->Tok <= Ord(String_tok)) if (_YAP_tokptr->Tok <= Ord(String_tok))
FAIL; FAIL;
break; break;
} }
@ -609,12 +630,12 @@ ParseTerm(int prio)
Term Term
Parse(void) _YAP_Parse(void)
{ {
Volatile Term t; Volatile Term t;
if (!setjmp(FailBuff.JmpBuff)) { if (!setjmp(FailBuff.JmpBuff)) {
t = ParseTerm(1200); t = ParseTerm(1200);
if (tokptr->Tok != Ord(eot_tok)) if (_YAP_tokptr->Tok != Ord(eot_tok))
return (0L); return (0L);
return (t); return (t);
} else } else

375
C/save.c
View File

@ -50,8 +50,6 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#endif #endif
#include "iopreds.h" #include "iopreds.h"
/********* hack for accesing several kinds of terms. Should be cleaned **/ /********* hack for accesing several kinds of terms. Should be cleaned **/
static char StartUpFile[] = "startup"; static char StartUpFile[] = "startup";
@ -166,7 +164,7 @@ myread(int fd, char *buff, Int len)
while (len > 16000) { while (len > 16000) {
int nchars = read(fd, buff, 16000); int nchars = read(fd, buff, 16000);
if (nchars <= 0) if (nchars <= 0)
Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
len -= 16000; len -= 16000;
buff += 16000; buff += 16000;
} }
@ -193,7 +191,7 @@ void myread(int fd, char *buffer, Int len) {
while (len > 0) { while (len > 0) {
nread = read(fd, buffer, (int)len); nread = read(fd, buffer, (int)len);
if (nread < 1) { if (nread < 1) {
Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
} }
buffer += nread; buffer += nread;
len -= nread; len -= nread;
@ -207,7 +205,7 @@ void mywrite(int fd, char *buff, Int len) {
while (len > 0) { while (len > 0) {
nwritten = (Int)write(fd, buff, (int)len); nwritten = (Int)write(fd, buff, (int)len);
if (nwritten == -1) { if (nwritten == -1) {
Error(SYSTEM_ERROR,TermNil,"write error while saving"); _YAP_Error(SYSTEM_ERROR,TermNil,"write error while saving");
} }
buff += nwritten; buff += nwritten;
len -= nwritten; len -= nwritten;
@ -224,14 +222,14 @@ void mywrite(int fd, char *buff, Int len) {
typedef CELL *CELLPOINTER; typedef CELL *CELLPOINTER;
int splfild = 0; static int splfild = 0;
#ifdef DEBUG #ifdef DEBUG
#ifdef DEBUG_RESTORE4 #ifdef DEBUG_RESTORE4
static FILE *errout; static FILE *errout;
#else #else
#define errout YP_stderr #define errout _YAP_stderr
#endif #endif
#endif /* DEBUG */ #endif /* DEBUG */
@ -242,25 +240,25 @@ static CELL which_save;
/* Open a file to read or to write */ /* Open a file to read or to write */
static int static int
open_file(char *ss, int flag) open_file(char *my_file, int flag)
{ {
int splfild; int splfild;
#ifdef M_WILLIAMS #ifdef M_WILLIAMS
if (flag & O_CREAT) if (flag & O_CREAT)
splfild = creat(ss, flag); splfild = creat(my_file, flag);
else else
splfild = open(ss, flag); splfild = open(my_file, flag);
if (splfild < 0) { if (splfild < 0) {
#else #else
#ifdef O_BINARY #ifdef O_BINARY
#if _MSC_VER #if _MSC_VER
if ((splfild = _open(ss, flag | O_BINARY), _S_IREAD | _S_IWRITE) < 0) if ((splfild = _open(my_file, flag | O_BINARY), _S_IREAD | _S_IWRITE) < 0)
#else #else
if ((splfild = open(ss, flag | O_BINARY), 0755) < 0) if ((splfild = open(my_file, flag | O_BINARY, 0775)) < 0)
#endif #endif
#else /* O_BINARY */ #else /* O_BINARY */
if ((splfild = open(ss, flag, 0755)) < 0) if ((splfild = open(my_file, flag, 0755)) < 0)
#endif /* O_BINARY */ #endif /* O_BINARY */
#endif /* M_WILLIAMS */ #endif /* M_WILLIAMS */
{ {
@ -268,7 +266,7 @@ open_file(char *ss, int flag)
return(-1); return(-1);
} }
#ifdef undf0 #ifdef undf0
YP_fprintf(errout, "Opened file %s\n", ss); fprintf(errout, "Opened file %s\n", my_file);
#endif #endif
return(splfild); return(splfild);
} }
@ -313,7 +311,7 @@ get_header_cell(void)
int count = 0, n; int count = 0, n;
while (count < sizeof(CELL)) { while (count < sizeof(CELL)) {
if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) { if ((n = read(splfild, &l, sizeof(CELL)-count)) < 0) {
ErrorMessage = "corrupt saved state"; _YAP_ErrorMessage = "corrupt saved state";
return(0L); return(0L);
} }
count += n; count += n;
@ -340,37 +338,37 @@ put_info(int info, int mode)
{ {
char msg[256]; char msg[256];
sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%cYAPV%s", BIN_DIR, 1, version_number); sprintf(msg, "#!/bin/sh\nexec_dir=${YAPBINDIR:-%s}\nexec $exec_dir/yap $0 \"$@\"\n%cYAPV%s", BIN_DIR, 1, YAP_VERSION);
mywrite(splfild, msg, strlen(msg) + 1); mywrite(splfild, msg, strlen(msg) + 1);
putout(Unsigned(info)); putout(Unsigned(info));
/* say whether we just saved the heap or everything */ /* say whether we just saved the heap or everything */
putout(mode); putout(mode);
/* c-predicates in system */ /* c-predicates in system */
putout(NUMBER_OF_CPREDS); putout(NumberOfCPreds);
/* comparison predicates in system */ /* comparison predicates in system */
putout(NUMBER_OF_CMPFUNCS); putout(NumberOfCmpFuncs);
/* current state of stacks, to be used by SavedInfo */ /* current state of stacks, to be used by SavedInfo */
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
/* space available in heap area */ /* space available in heap area */
putout(Unsigned(GlobalBase)-Unsigned(HeapBase)); putout(Unsigned(_YAP_GlobalBase)-Unsigned(_YAP_HeapBase));
/* space available for stacks */ /* space available for stacks */
putout(Unsigned(LocalBase)-Unsigned(GlobalBase)+CellSize); putout(Unsigned(_YAP_LocalBase)-Unsigned(_YAP_GlobalBase)+CellSize);
#else #else
/* space available in heap area */ /* space available in heap area */
putout(Unsigned(GlobalBase)-Unsigned(HeapBase)); putout(Unsigned(_YAP_GlobalBase)-Unsigned(_YAP_HeapBase));
/* space available for stacks */ /* space available for stacks */
putout(Unsigned(LocalBase)-Unsigned(GlobalBase)); putout(Unsigned(_YAP_LocalBase)-Unsigned(_YAP_GlobalBase));
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */
/* space available for trail */ /* space available for trail */
putout(Unsigned(TrailTop)-Unsigned(TrailBase)); putout(Unsigned(_YAP_TrailTop)-Unsigned(_YAP_TrailBase));
/* Space used in heap area */ /* Space used in heap area */
putout(Unsigned(HeapTop)-Unsigned(HeapBase)); putout(Unsigned(HeapTop)-Unsigned(_YAP_HeapBase));
/* Space used for local stack */ /* Space used for local stack */
putout(Unsigned(LCL0)-Unsigned(ASP)); putout(Unsigned(LCL0)-Unsigned(ASP));
/* Space used for global stack */ /* Space used for global stack */
putout(Unsigned(H) - Unsigned(GlobalBase)); putout(Unsigned(H) - Unsigned(_YAP_GlobalBase));
/* Space used for trail */ /* Space used for trail */
putout(Unsigned(TR) - Unsigned(TrailBase)); putout(Unsigned(TR) - Unsigned(_YAP_TrailBase));
} }
static void static void
@ -415,7 +413,7 @@ save_regs(int mode)
putout(which_save); putout(which_save);
/* Now start by saving the code */ /* Now start by saving the code */
/* the heap boundaries */ /* the heap boundaries */
putcellptr(CellPtr(HeapBase)); putcellptr(CellPtr(_YAP_HeapBase));
putcellptr(CellPtr(HeapTop)); putcellptr(CellPtr(HeapTop));
/* and the space it ocuppies */ /* and the space it ocuppies */
putout(Unsigned(HeapUsed)); putout(Unsigned(HeapUsed));
@ -427,7 +425,7 @@ save_regs(int mode)
if (which_save == 2) { if (which_save == 2) {
putout(ARG2); putout(ARG2);
} }
putcellptr(CellPtr(TrailBase)); putcellptr(CellPtr(_YAP_TrailBase));
} }
} }
@ -441,27 +439,27 @@ save_code_info(void)
OPCODE my_ops[_std_top+1]; OPCODE my_ops[_std_top+1];
for (i = _Ystop; i <= _std_top; ++i) for (i = _Ystop; i <= _std_top; ++i)
my_ops[i] = opcode(i); my_ops[i] = _YAP_opcode(i);
mywrite(splfild, (char *)my_ops, sizeof(OPCODE)*(_std_top+1)); mywrite(splfild, (char *)my_ops, sizeof(OPCODE)*(_std_top+1));
} }
/* Then the c-functions */ /* Then the c-functions */
putout(NUMBER_OF_CPREDS); putout(NumberOfCPreds);
{ {
UInt i; UInt i;
for (i = 0; i < NUMBER_OF_CPREDS; ++i) for (i = 0; i < NumberOfCPreds; ++i)
putcellptr(CellPtr(c_predicates[i])); putcellptr(CellPtr(_YAP_c_predicates[i]));
} }
/* Then the cmp-functions */ /* Then the cmp-functions */
putout(NUMBER_OF_CMPFUNCS); putout(NumberOfCmpFuncs);
{ {
UInt i; UInt i;
for (i = 0; i < NUMBER_OF_CMPFUNCS; ++i) { for (i = 0; i < NumberOfCmpFuncs; ++i) {
putcellptr(CellPtr(cmp_funcs[i].p)); putcellptr(CellPtr(_YAP_cmp_funcs[i].p));
putcellptr(CellPtr(cmp_funcs[i].f)); putcellptr(CellPtr(_YAP_cmp_funcs[i].f));
} }
} }
/* and the current character codes */ /* and the current character codes */
mywrite(splfild, chtype, NUMBER_OF_CHARS); mywrite(splfild, _YAP_chtype, NUMBER_OF_CHARS);
} }
static void static void
@ -471,9 +469,9 @@ save_heap(void)
/* Then save the whole heap */ /* Then save the whole heap */
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
/* skip the local and global data structures */ /* skip the local and global data structures */
j = Unsigned(&GLOBAL) - Unsigned(HeapBase); j = Unsigned(&GLOBAL) - Unsigned(_YAP_HeapBase);
putout(j); putout(j);
mywrite(splfild, (char *) HeapBase, j); mywrite(splfild, (char *) _YAP_HeapBase, j);
#ifdef USE_HEAP #ifdef USE_HEAP
j = Unsigned(HeapTop) - Unsigned(&HashChain); j = Unsigned(HeapTop) - Unsigned(&HashChain);
putout(j); putout(j);
@ -487,9 +485,9 @@ save_heap(void)
mywrite(splfild, (char *) TopAllocBlockArea, j); mywrite(splfild, (char *) TopAllocBlockArea, j);
#endif #endif
#else #else
j = Unsigned(HeapTop) - Unsigned(HeapBase); j = Unsigned(HeapTop) - Unsigned(_YAP_HeapBase);
/* store 10 more cells because of the memory manager */ /* store 10 more cells because of the memory manager */
mywrite(splfild, (char *) HeapBase, j); mywrite(splfild, (char *) _YAP_HeapBase, j);
#endif #endif
} }
@ -505,16 +503,16 @@ save_stacks(int mode)
j = Unsigned(LCL0) - Unsigned(ASP); j = Unsigned(LCL0) - Unsigned(ASP);
mywrite(splfild, (char *) ASP, j); mywrite(splfild, (char *) ASP, j);
/* Save the global stack */ /* Save the global stack */
j = Unsigned(H) - Unsigned(GlobalBase); j = Unsigned(H) - Unsigned(_YAP_GlobalBase);
mywrite(splfild, (char *) GlobalBase, j); mywrite(splfild, (char *) _YAP_GlobalBase, j);
/* Save the trail */ /* Save the trail */
j = Unsigned(TR) - Unsigned(TrailBase); j = Unsigned(TR) - Unsigned(_YAP_TrailBase);
mywrite(splfild, (char *) TrailBase, j); mywrite(splfild, (char *) _YAP_TrailBase, j);
break; break;
case DO_ONLY_CODE: case DO_ONLY_CODE:
{ {
tr_fr_ptr tr_ptr = TR; tr_fr_ptr tr_ptr = TR;
while (tr_ptr != (tr_fr_ptr)TrailBase) { while (tr_ptr != (tr_fr_ptr)_YAP_TrailBase) {
CELL val = TrailTerm(tr_ptr-1); CELL val = TrailTerm(tr_ptr-1);
if (IsVarTerm(val)) { if (IsVarTerm(val)) {
CELL *d1 = VarOfTerm(val); CELL *d1 = VarOfTerm(val);
@ -552,13 +550,13 @@ do_save(int mode) {
NewFileInfo('YAPS', 'MYap'); NewFileInfo('YAPS', 'MYap');
#endif #endif
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (!GetName(FileNameBuf, YAP_FILENAME_MAX, t1)) { if (!_YAP_GetName(_YAP_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Error(TYPE_ERROR_LIST,t1,"save/1"); _YAP_Error(TYPE_ERROR_LIST,t1,"save/1");
return(FALSE); return(FALSE);
} }
CloseStreams(TRUE); _YAP_CloseStreams(TRUE);
if ((splfild = open_file(FileNameBuf, O_WRONLY | O_CREAT)) < 0) { if ((splfild = open_file(_YAP_FileNameBuf, O_WRONLY | O_CREAT)) < 0) {
Error(SYSTEM_ERROR,MkAtomTerm(LookupAtom(FileNameBuf)), _YAP_Error(SYSTEM_ERROR,MkAtomTerm(_YAP_LookupAtom(_YAP_FileNameBuf)),
"restore/1, open(%s)", strerror(errno)); "restore/1, open(%s)", strerror(errno));
return(FALSE); return(FALSE);
} }
@ -578,7 +576,7 @@ p_save(void)
{ {
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
@ -592,12 +590,13 @@ p_save2(void)
{ {
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,
"cannot perform save: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
which_save = 2; which_save = 2;
return(do_save(DO_EVERYTHING) && unify(ARG2,MkIntTerm(1))); return(do_save(DO_EVERYTHING) && _YAP_unify(ARG2,MkIntTerm(1)));
} }
/* Just save the program, not the stacks */ /* Just save the program, not the stacks */
@ -622,99 +621,99 @@ check_header(CELL *info, CELL *ATrail, CELL *AStack, CELL *AHeap)
/* skip the first line */ /* skip the first line */
do { do {
if (read(splfild, pp, 1) < 0) { if (read(splfild, pp, 1) < 0) {
ErrorMessage = "corrupt saved state"; _YAP_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
} while (pp[0] != 1); } while (pp[0] != 1);
/* now check the version */ /* now check the version */
sprintf(msg, "YAPV%s", version_number); sprintf(msg, "YAPV%s", YAP_VERSION);
{ {
int count = 0, n, to_read = Unsigned(strlen(msg) + 1); int count = 0, n, to_read = Unsigned(strlen(msg) + 1);
while (count < to_read) { while (count < to_read) {
if ((n = read(splfild, pp, to_read-count)) < 0) { if ((n = read(splfild, pp, to_read-count)) < 0) {
ErrorMessage = "corrupt saved state"; _YAP_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
count += n; count += n;
} }
} }
if (pp[0] != 'Y' && pp[1] != 'A' && pp[0] != 'P') { if (pp[0] != 'Y' && pp[1] != 'A' && pp[0] != 'P') {
ErrorMessage = "corrupt saved state"; _YAP_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
if (strcmp(pp, msg) != 0) { if (strcmp(pp, msg) != 0) {
ErrorMessage = "saved state for different version of YAP"; _YAP_ErrorMessage = "saved state for different version of YAP";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
/* check info on header */ /* check info on header */
/* ignore info on saved state */ /* ignore info on saved state */
*info = get_header_cell(); *info = get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
/* check the restore mode */ /* check the restore mode */
mode = get_header_cell(); mode = get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
/* check the number of c-predicates */ /* check the number of c-predicates */
c_preds = get_header_cell(); c_preds = get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
if (HeapBase != NULL && c_preds != NUMBER_OF_CPREDS) { if (_YAP_HeapBase != NULL && c_preds != NumberOfCPreds) {
ErrorMessage = "saved state with different built-ins"; _YAP_ErrorMessage = "saved state with different number of built-ins";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
cmp_funcs = get_header_cell(); cmp_funcs = get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
if (HeapBase != NULL && cmp_funcs != NUMBER_OF_CMPFUNCS) { if (_YAP_HeapBase != NULL && cmp_funcs != NumberOfCmpFuncs) {
ErrorMessage = "saved state with different built-ins"; _YAP_ErrorMessage = "saved state with different built-ins";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) { if (mode != DO_EVERYTHING && mode != DO_ONLY_CODE) {
ErrorMessage = "corrupt saved state"; _YAP_ErrorMessage = "corrupt saved state";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
/* ignore info on stacks size */ /* ignore info on stacks size */
*AHeap = get_header_cell(); *AHeap = get_header_cell();
*AStack = get_header_cell(); *AStack = get_header_cell();
*ATrail = get_header_cell(); *ATrail = get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
/* now, check whether we got enough enough space to load the /* now, check whether we got enough enough space to load the
saved space */ saved space */
hp_size = get_cell(); hp_size = get_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
while (HeapBase != NULL && hp_size > Unsigned(AuxTop) - Unsigned(HeapBase)) { while (_YAP_HeapBase != NULL && hp_size > Unsigned(AuxTop) - Unsigned(_YAP_HeapBase)) {
if(!growheap(FALSE)) { if(!_YAP_growheap(FALSE)) {
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
} }
if (mode == DO_EVERYTHING) { if (mode == DO_EVERYTHING) {
lc_size = get_cell(); lc_size = get_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
gb_size=get_cell(); gb_size=get_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
if (HeapBase != NULL && lc_size+gb_size > Unsigned(LocalBase) - Unsigned(GlobalBase)) { if (_YAP_HeapBase != NULL && lc_size+gb_size > Unsigned(_YAP_LocalBase) - Unsigned(_YAP_GlobalBase)) {
ErrorMessage = "not enough stack space for restore"; _YAP_ErrorMessage = "not enough stack space for restore";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
if (HeapBase != NULL && (tr_size = get_cell()) > Unsigned(TrailTop) - Unsigned(TrailBase)) { if (_YAP_HeapBase != NULL && (tr_size = get_cell()) > Unsigned(_YAP_TrailTop) - Unsigned(_YAP_TrailBase)) {
ErrorMessage = "not enough trail space for restore"; _YAP_ErrorMessage = "not enough trail space for restore";
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
} else { } else {
/* skip cell size */ /* skip cell size */
get_header_cell(); get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
get_header_cell(); get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
get_header_cell(); get_header_cell();
if (ErrorMessage) if (_YAP_ErrorMessage)
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
return(mode); return(mode);
@ -728,7 +727,7 @@ get_heap_info(void)
OldHeapTop = (ADDR) get_cellptr(); OldHeapTop = (ADDR) get_cellptr();
OldHeapUsed = (Int) get_cell(); OldHeapUsed = (Int) get_cell();
FreeBlocks = (BlockHeader *) get_cellptr(); FreeBlocks = (BlockHeader *) get_cellptr();
HDiff = Unsigned(HeapBase) - Unsigned(OldHeapBase); HDiff = Unsigned(_YAP_HeapBase) - Unsigned(OldHeapBase);
} }
/* Gets the register array */ /* Gets the register array */
@ -737,7 +736,7 @@ get_heap_info(void)
static void static void
get_regs(int flag) get_regs(int flag)
{ {
CELL *NewGlobalBase = (CELL *)GlobalBase; CELL *NewGlobalBase = (CELL *)_YAP_GlobalBase;
CELL *NewLCL0 = LCL0; CELL *NewLCL0 = LCL0;
CELL *OldXREGS; CELL *OldXREGS;
@ -789,13 +788,13 @@ get_regs(int flag)
/* Save the old register where we can easily access them */ /* Save the old register where we can easily access them */
OldASP = ASP; OldASP = ASP;
OldLCL0 = LCL0; OldLCL0 = LCL0;
OldGlobalBase = (CELL *)GlobalBase; OldGlobalBase = (CELL *)_YAP_GlobalBase;
OldH = H; OldH = H;
OldTR = TR; OldTR = TR;
GDiff = Unsigned(NewGlobalBase) - Unsigned(GlobalBase); GDiff = Unsigned(NewGlobalBase) - Unsigned(_YAP_GlobalBase);
LDiff = Unsigned(NewLCL0) - Unsigned(LCL0); LDiff = Unsigned(NewLCL0) - Unsigned(LCL0);
TrDiff = LDiff; TrDiff = LDiff;
GlobalBase = (ADDR)NewGlobalBase; _YAP_GlobalBase = (ADDR)NewGlobalBase;
LCL0 = NewLCL0; LCL0 = NewLCL0;
} }
} }
@ -812,34 +811,34 @@ get_insts(OPCODE old_ops[])
static int static int
check_funcs(void) check_funcs(void)
{ {
UInt old_NUMBER_OF_CPREDS, old_NUMBER_OF_CMPFUNCS; UInt old_NumberOfCPreds, old_NumberOfCmpFuncs;
int out = FALSE; int out = FALSE;
if ((old_NUMBER_OF_CPREDS = get_cell()) != NUMBER_OF_CPREDS) { if ((old_NumberOfCPreds = get_cell()) != NumberOfCPreds) {
Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of functions (%d vs %d), system corrupted, old_NUMBER_OF_CPREDS, NUMBER_OF_CPREDS"); _YAP_Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of functions (%d vs %d), system corrupted, old_NumberOfCPreds, NumberOfCPreds");
} }
{ {
unsigned int i; unsigned int i;
for (i = 0; i < old_NUMBER_OF_CPREDS; ++i) { for (i = 0; i < old_NumberOfCPreds; ++i) {
CELL *old_pred = get_cellptr(); CELL *old_pred = get_cellptr();
out = (out || old_pred != CellPtr(c_predicates[i])); out = (out || old_pred != CellPtr(_YAP_c_predicates[i]));
} }
} }
if ((old_NUMBER_OF_CMPFUNCS = get_cell()) != NUMBER_OF_CMPFUNCS) { if ((old_NumberOfCmpFuncs = get_cell()) != NumberOfCmpFuncs) {
Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of comparison functions (%d vs %d), system corrupted", old_NUMBER_OF_CMPFUNCS, NUMBER_OF_CMPFUNCS); _YAP_Error(SYSTEM_ERROR,TermNil,"bad saved state, different number of comparison functions (%d vs %d), system corrupted", old_NumberOfCmpFuncs, NumberOfCmpFuncs);
} }
{ {
unsigned int i; unsigned int i;
for (i = 0; i < old_NUMBER_OF_CMPFUNCS; ++i) { for (i = 0; i < old_NumberOfCmpFuncs; ++i) {
CELL *old_p = get_cellptr(); CELL *old_p = get_cellptr();
CELL *old_f = get_cellptr(); CELL *old_f = get_cellptr();
/* if (AddrAdjust((ADDR)old_p) != cmp_funcs[i].p) { /* if (AddrAdjust((ADDR)old_p) != cmp_funcs[i].p) {
Error(SYSTEM_ERROR,TermNil,"bad saved state, comparison function is in wrong place (%p vs %p), system corrupted", AddrAdjust((ADDR)old_p), cmp_funcs[i].p); _YAP_Error(SYSTEM_ERROR,TermNil,"bad saved state, comparison function is in wrong place (%p vs %p), system corrupted", AddrAdjust((ADDR)old_p), cmp_funcs[i].p);
} */ } */
cmp_funcs[i].p = (PredEntry *)AddrAdjust((ADDR)old_p); _YAP_cmp_funcs[i].p = (PredEntry *)AddrAdjust((ADDR)old_p);
out = (out || out = (out ||
old_f != CellPtr(cmp_funcs[i].f)); old_f != CellPtr(_YAP_cmp_funcs[i].f));
} }
} }
return(out); return(out);
@ -849,7 +848,7 @@ check_funcs(void)
static void static void
get_hash(void) get_hash(void)
{ {
myread(splfild, chtype , NUMBER_OF_CHARS); myread(splfild, _YAP_chtype , NUMBER_OF_CHARS);
} }
/* Copy all of the old code to the new Heap */ /* Copy all of the old code to the new Heap */
@ -859,24 +858,24 @@ CopyCode(void)
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
/* skip the local and global data structures */ /* skip the local and global data structures */
CELL j = get_cell(); CELL j = get_cell();
if (j != Unsigned(&GLOBAL) - Unsigned(HeapBase)) { if (j != Unsigned(&GLOBAL) - Unsigned(_YAP_HeapBase)) {
Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
} }
myread(splfild, (char *) HeapBase, j); myread(splfild, (char *) _YAP_HeapBase, j);
#ifdef USE_HEAP #ifdef USE_HEAP
j = get_cell(); j = get_cell();
myread(splfild, (char *) &HashChain, j); myread(splfild, (char *) &HashChain, j);
#else #else
j = get_cell(); j = get_cell();
if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) { if (j != Unsigned(BaseAllocArea) - Unsigned(&HashChain)) {
Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
} }
myread(splfild, (char *) &HashChain, j); myread(splfild, (char *) &HashChain, j);
j = get_cell(); j = get_cell();
myread(splfild, (char *) TopAllocBlockArea, j); myread(splfild, (char *) TopAllocBlockArea, j);
#endif #endif
#else #else
myread(splfild, (char *) HeapBase, myread(splfild, (char *) _YAP_HeapBase,
(Unsigned(OldHeapTop) - Unsigned(OldHeapBase))); (Unsigned(OldHeapTop) - Unsigned(OldHeapBase)));
#endif #endif
} }
@ -893,9 +892,9 @@ CopyStacks(void)
NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(OldLCL0))); NewASP = (char *) (Unsigned(ASP) + (Unsigned(LCL0) - Unsigned(OldLCL0)));
myread(splfild, (char *) NewASP, j); myread(splfild, (char *) NewASP, j);
j = Unsigned(H) - Unsigned(OldGlobalBase); j = Unsigned(H) - Unsigned(OldGlobalBase);
myread(splfild, (char *) GlobalBase, j); myread(splfild, (char *) _YAP_GlobalBase, j);
j = Unsigned(TR) - Unsigned(OldTrailBase); j = Unsigned(TR) - Unsigned(OldTrailBase);
myread(splfild, TrailBase, j); myread(splfild, _YAP_TrailBase, j);
} }
/* Copy the local and global stack and also the trail to their new home */ /* Copy the local and global stack and also the trail to their new home */
@ -905,7 +904,7 @@ CopyTrailEntries(void)
{ {
CELL entry, *Entries; CELL entry, *Entries;
Entries = (CELL *)TrailBase; Entries = (CELL *)_YAP_TrailBase;
do { do {
*Entries++ = entry = get_cell(); *Entries++ = entry = get_cell();
} while ((CODEADDR)entry != NULL); } while ((CODEADDR)entry != NULL);
@ -934,7 +933,7 @@ get_coded(int flag, OPCODE old_ops[])
/* Check CRC */ /* Check CRC */
myread(splfild, my_end_msg, 256); myread(splfild, my_end_msg, 256);
if (strcmp(end_msg,my_end_msg) != 0) if (strcmp(end_msg,my_end_msg) != 0)
Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, system corrupted");
return(funcs_moved); return(funcs_moved);
} }
@ -981,7 +980,7 @@ static void
recompute_mask(DBRef dbr) recompute_mask(DBRef dbr)
{ {
if (dbr->Flags & DBNoVars) { if (dbr->Flags & DBNoVars) {
dbr->Mask = EvalMasks((Term) dbr->Entry, &(dbr->Key)); dbr->Mask = _YAP_EvalMasks((Term) dbr->Entry, &(dbr->Key));
} else if (dbr->Flags & DBComplex) { } else if (dbr->Flags & DBComplex) {
/* This is quite nasty, we want to recalculate the mask but /* This is quite nasty, we want to recalculate the mask but
we don't want to rebuild the whole term. We'll just build whatever we we don't want to rebuild the whole term. We'll just build whatever we
@ -1026,7 +1025,7 @@ recompute_mask(DBRef dbr)
} }
x++; x++;
} }
dbr->Mask = EvalMasks(out, &(dbr->Key)); dbr->Mask = _YAP_EvalMasks(out, &(dbr->Key));
} }
} }
@ -1054,11 +1053,11 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries)
basep = H; basep = H;
if (H + (NOfE*2) > ASP) { if (H + (NOfE*2) > ASP) {
basep = (CELL *)TR; basep = (CELL *)TR;
if (basep + (NOfE*2) > (CELL *)TrailTop) { if (basep + (NOfE*2) > (CELL *)_YAP_TrailTop) {
if (!growtrail((ADDR)(basep + (NOfE*2))-TrailTop)) { if (!_YAP_growtrail((ADDR)(basep + (NOfE*2))-_YAP_TrailTop)) {
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"not enough space to restore hash tables for indexing"); "not enough space to restore hash tables for indexing");
exit_yap(1); _YAP_exit(1);
} }
} }
} }
@ -1110,7 +1109,7 @@ CCodeAdjust(PredEntry *pe, CODEADDR c)
{ {
/* add this code to a list of ccalls that must be adjusted */ /* add this code to a list of ccalls that must be adjusted */
return ((CODEADDR)(c_predicates[pe->StateOfPred])); return ((CODEADDR)(_YAP_c_predicates[pe->StateOfPred]));
} }
static CODEADDR static CODEADDR
@ -1118,7 +1117,7 @@ NextCCodeAdjust(PredEntry *pe, CODEADDR c)
{ {
/* add this code to a list of ccalls that must be adjusted */ /* add this code to a list of ccalls that must be adjusted */
return ((CODEADDR)(c_predicates[pe->StateOfPred+1])); return ((CODEADDR)(_YAP_c_predicates[pe->StateOfPred+1]));
} }
@ -1127,12 +1126,12 @@ DirectCCodeAdjust(PredEntry *pe, CODEADDR c)
{ {
/* add this code to a list of ccalls that must be adjusted */ /* add this code to a list of ccalls that must be adjusted */
unsigned int i; unsigned int i;
for (i = 0; i < NUMBER_OF_CMPFUNCS; i++) { for (i = 0; i < NumberOfCmpFuncs; i++) {
if (cmp_funcs[i].p == pe) { if (_YAP_cmp_funcs[i].p == pe) {
return((CODEADDR)(cmp_funcs[i].f)); return((CODEADDR)(_YAP_cmp_funcs[i].f));
} }
} }
Error(FATAL_ERROR,TermNil,"bad saved state, ccalls corrupted"); _YAP_Error(FATAL_ERROR,TermNil,"bad saved state, ccalls corrupted");
return(NULL); return(NULL);
} }
@ -1182,7 +1181,7 @@ RestoreForeignCodeStructure(void)
static void static void
RestoreIOStructures(void) RestoreIOStructures(void)
{ {
InitStdStreams(); _YAP_InitStdStreams();
} }
/* restores the list of free space, with its curious structure */ /* restores the list of free space, with its curious structure */
@ -1224,7 +1223,7 @@ RestoreInvisibleAtoms(void)
return; return;
do { do {
#ifdef DEBUG_RESTORE2 /* useful during debug */ #ifdef DEBUG_RESTORE2 /* useful during debug */
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE); fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif #endif
at->PropsOfAE = PropAdjust(at->PropsOfAE); at->PropsOfAE = PropAdjust(at->PropsOfAE);
RestoreEntries(RepProp(at->PropsOfAE)); RestoreEntries(RepProp(at->PropsOfAE));
@ -1251,7 +1250,7 @@ restore_heap(void)
at = RepAtom(atm); at = RepAtom(atm);
do { do {
#ifdef DEBUG_RESTORE2 /* useful during debug */ #ifdef DEBUG_RESTORE2 /* useful during debug */
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE); fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif #endif
at->PropsOfAE = PropAdjust(at->PropsOfAE); at->PropsOfAE = PropAdjust(at->PropsOfAE);
RestoreEntries(RepProp(at->PropsOfAE)); RestoreEntries(RepProp(at->PropsOfAE));
@ -1273,7 +1272,7 @@ ShowEntries(pp)
PropEntry *pp; PropEntry *pp;
{ {
while (!EndOfPAEntr(pp)) { while (!EndOfPAEntr(pp)) {
YP_fprintf(YP_stderr,"Estou a ver a prop %x em %x\n", pp->KindOfPE, pp); fprintf(_YAP_stderr,"Estou a ver a prop %x em %x\n", pp->KindOfPE, pp);
pp = RepProp(pp->NextOfPE); pp = RepProp(pp->NextOfPE);
} }
} }
@ -1288,7 +1287,7 @@ ShowAtoms()
AtomEntry *at; AtomEntry *at;
at = RepAtom(HashPtr->Entry); at = RepAtom(HashPtr->Entry);
do { do {
YP_fprintf(YP_stderr,"Passei ao %s em %x\n", at->StrOfAE, at); fprintf(_YAP_stderr,"Passei ao %s em %x\n", at->StrOfAE, at);
ShowEntries(RepProp(at->PropsOfAE)); ShowEntries(RepProp(at->PropsOfAE));
} while (!EndOfPAEntr(at = RepAtom(at->NextOfAE))); } while (!EndOfPAEntr(at = RepAtom(at->NextOfAE)));
} }
@ -1306,19 +1305,19 @@ commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *A
if ((mode = check_header(Astate,ATrail,AStack,AHeap)) == FAIL_RESTORE) if ((mode = check_header(Astate,ATrail,AStack,AHeap)) == FAIL_RESTORE)
return(FAIL_RESTORE); return(FAIL_RESTORE);
PrologMode = BootMode; _YAP_PrologMode = BootMode;
if (HeapBase) { if (_YAP_HeapBase) {
if (!yap_flags[HALT_AFTER_CONSULT_FLAG]) { if (!yap_flags[HALT_AFTER_CONSULT_FLAG]) {
TrueFileName(s,FileNameBuf2, YAP_FILENAME_MAX); _YAP_TrueFileName(s,_YAP_FileNameBuf2, YAP_FILENAME_MAX);
YP_fprintf(YP_stderr, "[ Restoring file %s ]\n", FileNameBuf2); fprintf(_YAP_stderr, "[ Restoring file %s ]\n", _YAP_FileNameBuf2);
} }
CloseStreams(TRUE); _YAP_CloseStreams(TRUE);
} }
#ifdef DEBUG_RESTORE4 #ifdef DEBUG_RESTORE4
/* /*
* This should be another file, like the log file * This should be another file, like the log file
*/ */
errout = YP_stderr; errout = _YAP_stderr;
#endif #endif
return(mode); return(mode);
} }
@ -1336,26 +1335,26 @@ cat_file_name(char *s, char *prefix, char *name, unsigned int max_length)
} }
static int static int
OpenRestore(char *s, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap) OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap)
{ {
int mode = FAIL_RESTORE; int mode = FAIL_RESTORE;
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
if (s == NULL) if (inpf == NULL)
s = StartUpFile; inpf = StartUpFile;
if (s != NULL && (splfild = open_file(s, O_RDONLY)) > 0) { if (inpf != NULL && (splfild = open_file(inpf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(s,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) if ((mode = commit_to_saved_state(inpf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE)
return(mode); return(mode);
} }
if (!dir_separator(s[0]) && !volume_header(s)) { if (!_YAP_dir_separator(inpf[0]) && !_YAP_volume_header(inpf)) {
/* /*
we have a relative path for the file, try to do somewhat better we have a relative path for the file, try to do somewhat better
using YAPLIBDIR or friends. using YAPLIBDIR or friends.
*/ */
if (YapLibDir != NULL) { if (YapLibDir != NULL) {
cat_file_name(FileNameBuf, Yap_LibDir, s, YAP_FILENAME_MAX); cat_file_name(_YAP_FileNameBuf, Yap_LibDir, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(FileNameBuf, O_RDONLY)) > 0) { if ((splfild = open_file(_YAP_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) if ((mode = commit_to_saved_state(_YAP_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE)
return(mode); return(mode);
} }
} }
@ -1363,24 +1362,24 @@ OpenRestore(char *s, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStack,
{ {
char *yap_env = getenv("YAPLIBDIR"); char *yap_env = getenv("YAPLIBDIR");
if (yap_env != NULL) { if (yap_env != NULL) {
cat_file_name(FileNameBuf, yap_env, s, YAP_FILENAME_MAX); cat_file_name(_YAP_FileNameBuf, yap_env, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(FileNameBuf, O_RDONLY)) > 0) { if ((splfild = open_file(_YAP_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) if ((mode = commit_to_saved_state(_YAP_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE)
return(mode); return(mode);
} }
} }
} }
#endif #endif
if (LIB_DIR != NULL) { if (LIB_DIR != NULL) {
cat_file_name(FileNameBuf, LIB_DIR, s, YAP_FILENAME_MAX); cat_file_name(_YAP_FileNameBuf, LIB_DIR, inpf, YAP_FILENAME_MAX);
if ((splfild = open_file(FileNameBuf, O_RDONLY)) > 0) { if ((splfild = open_file(_YAP_FileNameBuf, O_RDONLY)) > 0) {
if ((mode = commit_to_saved_state(FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) if ((mode = commit_to_saved_state(_YAP_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE)
return(mode); return(mode);
} }
} }
} }
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
return(FAIL_RESTORE); return(FAIL_RESTORE);
} }
@ -1391,7 +1390,7 @@ CloseRestore(void)
ShowAtoms(); ShowAtoms();
#endif #endif
close_file(); close_file();
PrologMode = UserMode; _YAP_PrologMode = UserMode;
} }
static int static int
@ -1401,7 +1400,7 @@ check_opcodes(OPCODE old_ops[])
int have_shifted = FALSE; int have_shifted = FALSE;
op_numbers op = _Ystop; op_numbers op = _Ystop;
for (op = _Ystop; op < _std_top; op++) { for (op = _Ystop; op < _std_top; op++) {
if (opcode(op) != old_ops[op]) { if (_YAP_opcode(op) != old_ops[op]) {
have_shifted = TRUE; have_shifted = TRUE;
break; break;
} }
@ -1415,7 +1414,7 @@ check_opcodes(OPCODE old_ops[])
static void static void
RestoreHeap(OPCODE old_ops[], int functions_moved) RestoreHeap(OPCODE old_ops[], int functions_moved)
{ {
int heap_moved = (OldHeapBase != HeapBase), opcodes_moved; int heap_moved = (OldHeapBase != _YAP_HeapBase), opcodes_moved;
opcodes_moved = check_opcodes(old_ops); opcodes_moved = check_opcodes(old_ops);
/* opcodes_moved has side-effects and should be tried first */ /* opcodes_moved has side-effects and should be tried first */
@ -1426,11 +1425,11 @@ RestoreHeap(OPCODE old_ops[], int functions_moved)
if (heap_moved) { if (heap_moved) {
RestoreFreeSpace(); RestoreFreeSpace();
} }
InitAbsmi(); _YAP_InitAbsmi();
if (!(ReInitConstExps() && ReInitUnaryExps() && ReInitBinaryExps())) if (!(_YAP_ReInitConstExps() && _YAP_ReInitUnaryExps() && _YAP_ReInitBinaryExps()))
Error(SYSTEM_ERROR, TermNil, "arithmetic operator not in saved state"); _YAP_Error(SYSTEM_ERROR, TermNil, "arithmetic operator not in saved state");
#ifdef DEBUG_RESTORE1 #ifdef DEBUG_RESTORE1
YP_fprintf(errout, "phase 1 done\n"); fprintf(errout, "phase 1 done\n");
#endif #endif
} }
@ -1439,7 +1438,7 @@ RestoreHeap(OPCODE old_ops[], int functions_moved)
* state * state
*/ */
int int
SavedInfo(char *FileName, char *YapLibDir, CELL *ATrail, CELL *AStack, CELL *AHeap) _YAP_SavedInfo(char *FileName, char *YapLibDir, CELL *ATrail, CELL *AStack, CELL *AHeap)
{ {
CELL MyTrail, MyStack, MyHeap, MyState; CELL MyTrail, MyStack, MyHeap, MyState;
int mode; int mode;
@ -1447,7 +1446,7 @@ SavedInfo(char *FileName, char *YapLibDir, CELL *ATrail, CELL *AStack, CELL *AHe
mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap); mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap);
close_file(); close_file();
if (mode == FAIL_RESTORE) { if (mode == FAIL_RESTORE) {
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
return(0); return(0);
} }
if (! *AHeap) if (! *AHeap)
@ -1468,7 +1467,7 @@ UnmarkTrEntries(void)
B = (choiceptr)LCL0; B = (choiceptr)LCL0;
B--; B--;
B->cp_ap = NOCODE; B->cp_ap = NOCODE;
Entries = (CELL *)TrailBase; Entries = (CELL *)_YAP_TrailBase;
while ((entry = *Entries++) != (CELL)NULL) { while ((entry = *Entries++) != (CELL)NULL) {
if (IsVarTerm(entry)) { if (IsVarTerm(entry)) {
RESET_VARIABLE((CELL *)entry); RESET_VARIABLE((CELL *)entry);
@ -1481,9 +1480,9 @@ UnmarkTrEntries(void)
Flags(ent) = flags; Flags(ent) = flags;
if (FlagOn(ErasedMask, flags)) { if (FlagOn(ErasedMask, flags)) {
if (FlagOn(DBClMask, flags)) { if (FlagOn(DBClMask, flags)) {
ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags))); _YAP_ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags)));
} else { } else {
ErCl(ClauseFlagsToClause(ent)); _YAP_ErCl(ClauseFlagsToClause(ent));
} }
} }
} }
@ -1499,7 +1498,7 @@ int in_limbo = FALSE;
* This function is called when wanting only to restore the heap and * This function is called when wanting only to restore the heap and
* associated registers * associated registers
*/ */
int static int
Restore(char *s, char *lib_dir) Restore(char *s, char *lib_dir)
{ {
int restore_mode; int restore_mode;
@ -1510,7 +1509,7 @@ Restore(char *s, char *lib_dir)
CELL MyTrail, MyStack, MyHeap, MyState; CELL MyTrail, MyStack, MyHeap, MyState;
if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, &MyHeap)) == FAIL_RESTORE) if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, &MyHeap)) == FAIL_RESTORE)
return(FALSE); return(FALSE);
ShutdownLoadForeign(); _YAP_ShutdownLoadForeign();
in_limbo = TRUE; in_limbo = TRUE;
funcs_moved = get_coded(restore_mode, old_ops); funcs_moved = get_coded(restore_mode, old_ops);
restore_regs(restore_mode); restore_regs(restore_mode);
@ -1519,38 +1518,44 @@ Restore(char *s, char *lib_dir)
RestoreHeap(old_ops, funcs_moved); RestoreHeap(old_ops, funcs_moved);
switch(restore_mode) { switch(restore_mode) {
case DO_EVERYTHING: case DO_EVERYTHING:
if (OldHeapBase != HeapBase || if (OldHeapBase != _YAP_HeapBase ||
OldLCL0 != LCL0 || OldLCL0 != LCL0 ||
OldGlobalBase != (CELL *)GlobalBase || OldGlobalBase != (CELL *)_YAP_GlobalBase ||
OldTrailBase != TrailBase) { OldTrailBase != _YAP_TrailBase) {
AdjustStacksAndTrail(); _YAP_AdjustStacksAndTrail();
if (which_save == 2) { if (which_save == 2) {
AdjustRegs(2); _YAP_AdjustRegs(2);
} else { } else {
AdjustRegs(1); _YAP_AdjustRegs(1);
} }
break; break;
#ifdef DEBUG_RESTORE2 #ifdef DEBUG_RESTORE2
YP_fprintf(errout, "phase 2 done\n"); fprintf(errout, "phase 2 done\n");
#endif #endif
} }
break; break;
case DO_ONLY_CODE: case DO_ONLY_CODE:
UnmarkTrEntries(); UnmarkTrEntries();
InitYaamRegs(); _YAP_InitYaamRegs();
break; break;
} }
ReOpenLoadForeign(); _YAP_ReOpenLoadForeign();
InitPlIO(); _YAP_InitPlIO();
/* reset time */ /* reset time */
ReInitWallTime(); _YAP_ReInitWallTime();
CloseRestore(); CloseRestore();
if (which_save == 2) { if (which_save == 2) {
unify(ARG2, MkIntTerm(0)); _YAP_unify(ARG2, MkIntTerm(0));
} }
return(restore_mode); return(restore_mode);
} }
int
_YAP_Restore(char *s, char *lib_dir)
{
return Restore(s, lib_dir);
}
static Int static Int
p_restore(void) p_restore(void)
{ {
@ -1559,29 +1564,29 @@ p_restore(void)
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running"); _YAP_Error(SYSTEM_ERROR,TermNil,"cannot perform save: more than a worker/thread running");
return(FALSE); return(FALSE);
} }
#endif #endif
if (!GetName(FileNameBuf, YAP_FILENAME_MAX, t1)) { if (!_YAP_GetName(_YAP_FileNameBuf, YAP_FILENAME_MAX, t1)) {
Error(TYPE_ERROR_LIST,t1,"restore/1"); _YAP_Error(TYPE_ERROR_LIST,t1,"restore/1");
return(FALSE); return(FALSE);
} }
if ((mode = Restore(FileNameBuf, NULL)) == DO_ONLY_CODE) { if ((mode = Restore(_YAP_FileNameBuf, NULL)) == DO_ONLY_CODE) {
#if PUSH_REGS #if PUSH_REGS
restore_absmi_regs(&standard_regs); restore_absmi_regs(&_YAP_standard_regs);
#endif #endif
/* back to the top level we go */ /* back to the top level we go */
siglongjmp(RestartEnv,3); siglongjmp(_YAP_RestartEnv,3);
} }
return(mode != FAIL_RESTORE); return(mode != FAIL_RESTORE);
} }
void void
InitSavePreds(void) _YAP_InitSavePreds(void)
{ {
InitCPred("$save", 1, p_save, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$save", 1, p_save, SafePredFlag|SyncPredFlag);
InitCPred("$save", 2, p_save2, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$save", 2, p_save2, SafePredFlag|SyncPredFlag);
InitCPred("$save_program", 1, p_save_program, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$save_program", 1, p_save_program, SafePredFlag|SyncPredFlag);
InitCPred("$restore", 1, p_restore, SyncPredFlag); _YAP_InitCPred("$restore", 1, p_restore, SyncPredFlag);
} }

247
C/scanner.c
View File

@ -124,9 +124,8 @@ EF,
#endif #endif
}; };
char *chtype = chtype0+1; #define chtype (chtype0+1)
char *_YAP_chtype = chtype0+1;
int eot_before_eof = FALSE;
static int ch, chbuff, o_ch; static int ch, chbuff, o_ch;
@ -142,7 +141,7 @@ static int (*Nextch) (int);
static int (*QuotedNextch) (int); static int (*QuotedNextch) (int);
char * static char *
AllocScannerMemory(unsigned int size) AllocScannerMemory(unsigned int size)
{ {
char *AuxSpScan; char *AuxSpScan;
@ -151,8 +150,8 @@ AllocScannerMemory(unsigned int size)
size = AdjustSize(size); size = AdjustSize(size);
TR = (tr_fr_ptr)(AuxSpScan+size); TR = (tr_fr_ptr)(AuxSpScan+size);
#if !OS_HANDLES_TR_OVERFLOW #if !OS_HANDLES_TR_OVERFLOW
if (Unsigned(TrailTop) == Unsigned(TR)) { if (Unsigned(_YAP_TrailTop) == Unsigned(TR)) {
if(!growtrail (sizeof(CELL) * 16 * 1024L)) { if(!_YAP_growtrail (sizeof(CELL) * 16 * 1024L)) {
return(NULL); return(NULL);
} }
} }
@ -160,6 +159,12 @@ AllocScannerMemory(unsigned int size)
return (AuxSpScan); return (AuxSpScan);
} }
char *
_YAP_AllocScannerMemory(unsigned int size)
{
return AllocScannerMemory(size);
}
inline static void inline static void
my_ungetch(void) my_ungetch(void)
{ {
@ -177,11 +182,11 @@ my_getch(void)
ch = chbuff; ch = chbuff;
} }
else { else {
ch = (*Nextch) (c_input_stream); ch = (*Nextch) (_YAP_c_input_stream);
} }
#ifdef DEBUG #ifdef DEBUG
if (Option[1]) if (_YAP_Option[1])
YP_fprintf(YP_stderr, "[getch %c]", ch); fprintf(_YAP_stderr, "[getch %c]", ch);
#endif #endif
return(ch); return(ch);
} }
@ -195,11 +200,11 @@ my_get_quoted_ch(void)
ch = chbuff; ch = chbuff;
} }
else { else {
ch = (*QuotedNextch) (c_input_stream); ch = (*QuotedNextch) (_YAP_c_input_stream);
} }
#ifdef DEBUG #ifdef DEBUG
if (Option[1]) if (_YAP_Option[1])
YP_fprintf(YP_stderr, "[getch %c]",ch); fprintf(_YAP_stderr, "[getch %c]",ch);
#endif #endif
return (ch); return (ch);
} }
@ -213,7 +218,7 @@ float_send(char *s)
#if HAVE_FINITE #if HAVE_FINITE
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */
if (!finite(f)) { if (!finite(f)) {
ErrorMessage = "Float overflow while scanning"; _YAP_ErrorMessage = "Float overflow while scanning";
return(MkEvalFl(0.0)); return(MkEvalFl(0.0));
} }
} }
@ -227,10 +232,10 @@ read_int_overflow(const char *s, Int base, Int val)
{ {
#ifdef USE_GMP #ifdef USE_GMP
/* try to scan it as a bignum */ /* try to scan it as a bignum */
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_init_set_str (new, s, base); mpz_init_set_str (new, s, base);
return(MkBigIntTerm(new)); return(_YAP_MkBigIntTerm(new));
#else #else
/* try to scan it as a float */ /* try to scan it as a float */
return(MkIntegerTerm(val)); return(MkIntegerTerm(val));
@ -259,7 +264,7 @@ get_num(void)
} }
if (ch == '\'') { if (ch == '\'') {
if (base > 36) { if (base > 36) {
ErrorMessage = "Admissible bases are 0..36"; _YAP_ErrorMessage = "Admissible bases are 0..36";
return (TermNil); return (TermNil);
} }
might_be_float = FALSE; might_be_float = FALSE;
@ -328,17 +333,17 @@ get_num(void)
ascii = so_far*8+(ch-'0'); ascii = so_far*8+(ch-'0');
my_get_quoted_ch(); my_get_quoted_ch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} }
break; break;
@ -356,12 +361,12 @@ get_num(void)
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
my_get_quoted_ch(); my_get_quoted_ch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
@ -373,7 +378,7 @@ get_num(void)
/* accept sequence. Note that the ISO standard does not /* accept sequence. Note that the ISO standard does not
consider this sequence legal, whereas SICStus would consider this sequence legal, whereas SICStus would
eat up the escape sequence. */ eat up the escape sequence. */
ErrorMessage = "invalid escape sequence"; _YAP_ErrorMessage = "invalid escape sequence";
} }
} }
/* a quick way to represent ASCII */ /* a quick way to represent ASCII */
@ -480,19 +485,19 @@ get_num(void)
/* given a function Nxtch scan until we either find the number /* given a function Nxtch scan until we either find the number
or end of file */ or end of file */
Term Term
scan_num(int (*Nxtch) (int)) _YAP_scan_num(int (*Nxtch) (int))
{ {
Term out; Term out;
int sign = 1; int sign = 1;
Nextch = Nxtch; Nextch = Nxtch;
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
ch = Nextch(c_input_stream); ch = Nextch(_YAP_c_input_stream);
if (ch == '-') { if (ch == '-') {
sign = -1; sign = -1;
ch = Nextch(c_input_stream); ch = Nextch(_YAP_c_input_stream);
} else if (ch == '+') { } else if (ch == '+') {
ch = Nextch(c_input_stream); ch = Nextch(_YAP_c_input_stream);
} }
if (chtype[ch] != NU) { if (chtype[ch] != NU) {
return(TermNil); return(TermNil);
@ -504,7 +509,7 @@ scan_num(int (*Nxtch) (int))
else if (IsFloatTerm(out)) else if (IsFloatTerm(out))
out = MkFloatTerm(-FloatOfTerm(out)); out = MkFloatTerm(-FloatOfTerm(out));
} }
if (ErrorMessage != NULL || ch != -1) if (_YAP_ErrorMessage != NULL || ch != -1)
return(TermNil); return(TermNil);
return(out); return(out);
} }
@ -518,7 +523,7 @@ token(void)
char *charp, *mp; char *charp, *mp;
unsigned int len; unsigned int len;
TokImage = ((AtomEntry *) ( PreAllocCodeSpace()))->StrOfAE; TokImage = ((AtomEntry *) ( _YAP_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
while (chtype[ch] == BS) while (chtype[ch] == BS)
my_getch(); my_getch();
@ -527,10 +532,10 @@ token(void)
case CC: case CC:
while (my_getch() != 10 && chtype[ch] != EF); while (my_getch() != 10 && chtype[ch] != EF);
if (chtype[ch] != EF) { if (chtype[ch] != EF) {
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (token()); return (token());
} else { } else {
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
} }
case UC: case UC:
@ -543,19 +548,19 @@ token(void)
*charp++ = '\0'; *charp++ = '\0';
if (!isvar) { if (!isvar) {
/* don't do this in iso */ /* don't do this in iso */
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Name_tok); return (Name_tok);
} }
else { else {
TokenInfo = Unsigned(LookupVar(TokImage)); TokenInfo = Unsigned(_YAP_LookupVar(TokImage));
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Var_tok); return (Var_tok);
} }
case NU: case NU:
TokenInfo = get_num(); TokenInfo = get_num();
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Number_tok); return (Number_tok);
case QT: case QT:
@ -565,7 +570,7 @@ token(void)
my_get_quoted_ch(); my_get_quoted_ch();
while (1) { while (1) {
if (charp + 1024 > (char *)AuxSp) { if (charp + 1024 > (char *)AuxSp) {
ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; _YAP_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break; break;
} }
if (ch == quote) { if (ch == quote) {
@ -646,7 +651,7 @@ token(void)
*charp++ = so_far*8+(ch-'0'); *charp++ = so_far*8+(ch-'0');
my_get_quoted_ch(); my_get_quoted_ch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} else { } else {
my_get_quoted_ch(); my_get_quoted_ch();
} }
@ -654,13 +659,13 @@ token(void)
*charp++ = so_far; *charp++ = so_far;
my_get_quoted_ch(); my_get_quoted_ch();
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
*charp++ = so_far; *charp++ = so_far;
my_get_quoted_ch(); my_get_quoted_ch();
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} }
break; break;
@ -678,7 +683,7 @@ token(void)
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
my_get_quoted_ch(); my_get_quoted_ch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} else { } else {
my_get_quoted_ch(); my_get_quoted_ch();
} }
@ -686,13 +691,13 @@ token(void)
*charp++ = so_far; *charp++ = so_far;
my_get_quoted_ch(); my_get_quoted_ch();
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
*charp++ = so_far; *charp++ = so_far;
my_get_quoted_ch(); my_get_quoted_ch();
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} }
break; break;
@ -700,10 +705,10 @@ token(void)
/* accept sequence. Note that the ISO standard does not /* accept sequence. Note that the ISO standard does not
consider this sequence legal, whereas SICStus would consider this sequence legal, whereas SICStus would
eat up the escape sequence. */ eat up the escape sequence. */
ErrorMessage = "invalid escape sequence"; _YAP_ErrorMessage = "invalid escape sequence";
} }
} else if (chtype[ch] == EF) { } else if (chtype[ch] == EF) {
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
} else { } else {
*charp++ = ch; *charp++ = ch;
@ -712,9 +717,9 @@ token(void)
++len; ++len;
if (charp > (char *)AuxSp - 1024) { if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */ /* Not enough space to read in the string. */
ErrorMessage = "not enough heap space to read in string or quoted atom"; _YAP_ErrorMessage = "not enough heap space to read in string or quoted atom";
/* serious error now */ /* serious error now */
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return(eot_tok); return(eot_tok);
} }
} }
@ -722,18 +727,18 @@ token(void)
if (quote == '"') { if (quote == '"') {
mp = AllocScannerMemory(len + 1); mp = AllocScannerMemory(len + 1);
if (mp == NULL) { if (mp == NULL) {
ErrorMessage = "not enough stack space to read in string or quoted atom"; _YAP_ErrorMessage = "not enough stack space to read in string or quoted atom";
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return(eot_tok); return(eot_tok);
} }
strcpy(mp, TokImage); strcpy(mp, TokImage);
TokenInfo = Unsigned(mp); TokenInfo = Unsigned(mp);
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (String_tok); return (String_tok);
} }
else { else {
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Name_tok); return (Name_tok);
} }
@ -746,19 +751,19 @@ token(void)
my_getch(); my_getch();
} }
if (chtype[ch] == EF) { if (chtype[ch] == EF) {
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
} }
my_getch(); my_getch();
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (token()); return (token());
} }
if (och == '.' && (chtype[ch] == BS || chtype[ch] == EF if (och == '.' && (chtype[ch] == BS || chtype[ch] == EF
|| chtype[ch] == CC)) { || chtype[ch] == CC)) {
eot_before_eof = TRUE; _YAP_eot_before_eof = TRUE;
if (chtype[ch] == CC) if (chtype[ch] == CC)
while (my_getch() != 10 && chtype[ch] != EF); while (my_getch() != 10 && chtype[ch] != EF);
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
} }
else { else {
@ -766,8 +771,8 @@ token(void)
for (; chtype[ch] == SY; my_getch()) for (; chtype[ch] == SY; my_getch())
*charp++ = ch; *charp++ = ch;
*charp = '\0'; *charp = '\0';
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Name_tok); return (Name_tok);
} }
@ -775,8 +780,8 @@ token(void)
*charp++ = ch; *charp++ = ch;
*charp++ = '\0'; *charp++ = '\0';
my_getch(); my_getch();
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Name_tok); return (Name_tok);
case BK: case BK:
@ -787,55 +792,55 @@ token(void)
if (och == '[' && ch == ']') { if (och == '[' && ch == ']') {
TokenInfo = Unsigned(AtomNil); TokenInfo = Unsigned(AtomNil);
my_getch(); my_getch();
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Name_tok); return (Name_tok);
} }
else { else {
TokenInfo = och; TokenInfo = och;
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (Ponctuation_tok); return (Ponctuation_tok);
} }
case EF: case EF:
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
#ifdef DEBUG #ifdef DEBUG
default: default:
YP_fprintf(YP_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype[ch]); fprintf(_YAP_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype[ch]);
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); return (eot_tok);
#else #else
default: default:
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return (eot_tok); /* Just to make lint happy */ return (eot_tok); /* Just to make lint happy */
#endif #endif
} }
} }
TokEntry * TokEntry *
tokenizer(int (*Nxtch) (int), int (*QuotedNxtch) (int)) _YAP_tokenizer(int (*Nxtch) (int), int (*QuotedNxtch) (int))
{ {
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
enum TokenKinds kind; enum TokenKinds kind;
int solo_flag = TRUE; int solo_flag = TRUE;
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
VarTable = NULL; _YAP_VarTable = NULL;
AnonVarTable = NULL; _YAP_AnonVarTable = NULL;
Nextch = Nxtch; Nextch = Nxtch;
QuotedNextch = QuotedNxtch; QuotedNextch = QuotedNxtch;
eot_before_eof = FALSE; _YAP_eot_before_eof = FALSE;
l = NIL; l = NIL;
p = NIL; /* Just to make lint happy */ p = NIL; /* Just to make lint happy */
ch = ' '; ch = ' ';
my_getch(); my_getch();
while (chtype[ch] == BS) while (chtype[ch] == BS) {
my_getch(); my_getch();
}
do { do {
t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (t == NULL) { if (t == NULL) {
ErrorMessage = "not enough stack space to read in term"; _YAP_ErrorMessage = "not enough stack space to read in term";
if (p != NIL) if (p != NIL)
p->TokInfo = eot_tok; p->TokInfo = eot_tok;
/* serious error now */ /* serious error now */
@ -855,7 +860,7 @@ tokenizer(int (*Nxtch) (int), int (*QuotedNxtch) (int))
} }
t->Tok = Ord(kind); t->Tok = Ord(kind);
#ifdef DEBUG #ifdef DEBUG
if(Option[2]) YP_fprintf(YP_stderr,"[Token %d %ld]",Ord(kind),(unsigned long int)TokenInfo); if(_YAP_Option[2]) fprintf(_YAP_stderr,"[Token %d %ld]",Ord(kind),(unsigned long int)TokenInfo);
#endif #endif
t->TokInfo = (Term) TokenInfo; t->TokInfo = (Term) TokenInfo;
t->TokPos = TokenPos; t->TokPos = TokenPos;
@ -864,24 +869,22 @@ tokenizer(int (*Nxtch) (int), int (*QuotedNxtch) (int))
return (l); return (l);
} }
extern int PlFGetchar(void);
#if DEBUG #if DEBUG
static inline int static inline int
debug_fgetch(void) debug_fgetch(void)
{ {
int ch = PlFGetchar(); int ch = _YAP_PlFGetchar();
if (Option[1]) if (_YAP_Option[1])
YP_fprintf(YP_stderr, "[getch %c,%d]", ch,ch); fprintf(_YAP_stderr, "[getch %c,%d]", ch,ch);
return (ch); return (ch);
} }
#define my_fgetch() (ch = debug_fgetch()) #define my_fgetch() (ch = debug_fgetch())
#else #else
#define my_fgetch() (ch = PlFGetchar()) #define my_fgetch() (ch = _YAP_PlFGetchar())
#endif #endif
TokEntry * TokEntry *
fast_tokenizer(void) _YAP_fast_tokenizer(void)
{ {
/* I hope, a compressed version of the last /* I hope, a compressed version of the last
* three files */ * three files */
@ -891,10 +894,10 @@ fast_tokenizer(void)
register int ch, och; register int ch, och;
int solo_flag = TRUE; int solo_flag = TRUE;
ErrorMessage = NULL; _YAP_ErrorMessage = NULL;
VarTable = NULL; _YAP_VarTable = NULL;
AnonVarTable = NULL; _YAP_AnonVarTable = NULL;
eot_before_eof = FALSE; _YAP_eot_before_eof = FALSE;
l = NIL; l = NIL;
p = NIL; /* Just to make lint happy */ p = NIL; /* Just to make lint happy */
my_fgetch(); my_fgetch();
@ -905,7 +908,7 @@ fast_tokenizer(void)
do { do {
t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (t == NULL) { if (t == NULL) {
ErrorMessage = "not enough stack space to read in term"; _YAP_ErrorMessage = "not enough stack space to read in term";
if (p != NIL) if (p != NIL)
p->TokInfo = eot_tok; p->TokInfo = eot_tok;
/* serious error now */ /* serious error now */
@ -925,7 +928,7 @@ fast_tokenizer(void)
get_tok: get_tok:
charp = TokImage = ((AtomEntry *) ( PreAllocCodeSpace()))->StrOfAE; charp = TokImage = ((AtomEntry *) ( _YAP_PreAllocCodeSpace()))->StrOfAE;
while (chtype[ch] == BS) while (chtype[ch] == BS)
my_fgetch(); my_fgetch();
TokenPos = GetCurInpPos(); TokenPos = GetCurInpPos();
@ -934,7 +937,7 @@ fast_tokenizer(void)
while (my_fgetch() != 10 && chtype[ch] != EF); while (my_fgetch() != 10 && chtype[ch] != EF);
if (chtype[ch] != EF) { if (chtype[ch] != EF) {
my_fgetch(); my_fgetch();
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
goto get_tok; goto get_tok;
} }
else else
@ -952,13 +955,13 @@ fast_tokenizer(void)
*charp++ = ch; *charp++ = ch;
*charp++ = '\0'; *charp++ = '\0';
if (!isvar) { if (!isvar) {
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
kind = Name_tok; kind = Name_tok;
} }
else { else {
TokenInfo = Unsigned(LookupVar(TokImage)); TokenInfo = Unsigned(_YAP_LookupVar(TokImage));
kind = Var_tok; kind = Var_tok;
} }
break; break;
@ -1053,17 +1056,17 @@ fast_tokenizer(void)
ascii = so_far*8+(ch-'0'); ascii = so_far*8+(ch-'0');
my_fgetch(); my_fgetch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} }
break; break;
@ -1081,18 +1084,18 @@ fast_tokenizer(void)
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
my_fgetch(); my_fgetch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
ascii = so_far; ascii = so_far;
my_fgetch(); my_fgetch();
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} }
break; break;
@ -1100,7 +1103,7 @@ fast_tokenizer(void)
/* accept sequence. Note that the ISO standard does not /* accept sequence. Note that the ISO standard does not
consider this sequence legal, whereas SICStus would consider this sequence legal, whereas SICStus would
eat up the escape sequence. */ eat up the escape sequence. */
ErrorMessage = "invalid escape sequence"; _YAP_ErrorMessage = "invalid escape sequence";
} }
} }
my_fgetch(); my_fgetch();
@ -1167,9 +1170,9 @@ fast_tokenizer(void)
t->Tok = Ord(Number_tok); t->Tok = Ord(Number_tok);
#ifdef DEBUG #ifdef DEBUG
/* /*
* if(Option[2 * if(_YAP_Option[2
* ]) * ])
* YP_fprintf(YP_stderr,"[To * fprintf(_YAP_stderr,"[To
* ken %d * ken %d
* %d]",Ord(ki * %d]",Ord(ki
* nd),TokenIn * nd),TokenIn
@ -1183,11 +1186,11 @@ fast_tokenizer(void)
t->TokPos = TokenPos; t->TokPos = TokenPos;
t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry)); t = (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (t == NULL) { if (t == NULL) {
ErrorMessage = "not enough stack space to read in term"; _YAP_ErrorMessage = "not enough stack space to read in term";
if (p != NIL) if (p != NIL)
p->TokInfo = eot_tok; p->TokInfo = eot_tok;
/* serious error now */ /* serious error now */
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return(l); return(l);
} }
@ -1238,11 +1241,11 @@ fast_tokenizer(void)
t = t =
(TokEntry *) AllocScannerMemory(sizeof(TokEntry)); (TokEntry *) AllocScannerMemory(sizeof(TokEntry));
if (t == NULL) { if (t == NULL) {
ErrorMessage = "not enough stack space to read in term"; _YAP_ErrorMessage = "not enough stack space to read in term";
if (p != NIL) if (p != NIL)
p->TokInfo = eot_tok; p->TokInfo = eot_tok;
/* serious error now */ /* serious error now */
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
return(l); return(l);
} }
@ -1302,7 +1305,7 @@ fast_tokenizer(void)
my_fgetch(); my_fgetch();
while (1) { while (1) {
if (charp + 1024 > (char *)AuxSp) { if (charp + 1024 > (char *)AuxSp) {
ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; _YAP_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break; break;
} }
if (ch == quote) { if (ch == quote) {
@ -1382,7 +1385,7 @@ fast_tokenizer(void)
*charp++ = so_far*8+(ch-'0'); *charp++ = so_far*8+(ch-'0');
my_fgetch(); my_fgetch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} else { } else {
my_fgetch(); my_fgetch();
} }
@ -1390,13 +1393,13 @@ fast_tokenizer(void)
*charp++ = so_far; *charp++ = so_far;
my_fgetch(); my_fgetch();
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
*charp++ = so_far; *charp++ = so_far;
my_fgetch(); my_fgetch();
} else { } else {
ErrorMessage = "invalid octal escape sequence"; _YAP_ErrorMessage = "invalid octal escape sequence";
} }
} }
break; break;
@ -1414,7 +1417,7 @@ fast_tokenizer(void)
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10); (my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
my_fgetch(); my_fgetch();
if (ch != '\\') { if (ch != '\\') {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} else { } else {
my_fgetch(); my_fgetch();
} }
@ -1422,13 +1425,13 @@ fast_tokenizer(void)
*charp++ = so_far; *charp++ = so_far;
my_fgetch(); my_fgetch();
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} else if (ch == '\\') { } else if (ch == '\\') {
*charp++ = so_far; *charp++ = so_far;
my_fgetch(); my_fgetch();
} else { } else {
ErrorMessage = "invalid hexadecimal escape sequence"; _YAP_ErrorMessage = "invalid hexadecimal escape sequence";
} }
} }
break; break;
@ -1436,7 +1439,7 @@ fast_tokenizer(void)
/* accept sequence. Note that the ISO standard does not /* accept sequence. Note that the ISO standard does not
consider this sequence legal, whereas SICStus would consider this sequence legal, whereas SICStus would
eat up the escape sequence. */ eat up the escape sequence. */
ErrorMessage = "invalid escape sequence"; _YAP_ErrorMessage = "invalid escape sequence";
} }
} else { } else {
*charp++ = ch; *charp++ = ch;
@ -1449,7 +1452,7 @@ fast_tokenizer(void)
++len; ++len;
if (charp > (char *)AuxSp - 1024) { if (charp > (char *)AuxSp - 1024) {
/* Not enough space to read in the string. */ /* Not enough space to read in the string. */
ErrorMessage = "not enough heap space to read in string or quoted atom"; _YAP_ErrorMessage = "not enough heap space to read in string or quoted atom";
/* serious error now */ /* serious error now */
kind = eot_tok; kind = eot_tok;
} }
@ -1458,7 +1461,7 @@ fast_tokenizer(void)
if (quote == '"') { if (quote == '"') {
mp = AllocScannerMemory(len + 1); mp = AllocScannerMemory(len + 1);
if (mp == NULL) { if (mp == NULL) {
ErrorMessage = "not enough stack space to read in string or quoted atom"; _YAP_ErrorMessage = "not enough stack space to read in string or quoted atom";
/* serious error now */ /* serious error now */
kind = eot_tok; kind = eot_tok;
} }
@ -1467,7 +1470,7 @@ fast_tokenizer(void)
kind = String_tok; kind = String_tok;
} }
else { else {
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
kind = Name_tok; kind = Name_tok;
@ -1488,12 +1491,12 @@ fast_tokenizer(void)
break; break;
} }
my_fgetch(); my_fgetch();
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
goto get_tok; goto get_tok;
} }
if (och == '.' && (chtype[ch] == BS || chtype[ch] == EF if (och == '.' && (chtype[ch] == BS || chtype[ch] == EF
|| chtype[ch] == CC)) { || chtype[ch] == CC)) {
eot_before_eof = TRUE; _YAP_eot_before_eof = TRUE;
if (chtype[ch] == CC) if (chtype[ch] == CC)
while (my_fgetch() != 10 && chtype[ch] != EF); while (my_fgetch() != 10 && chtype[ch] != EF);
kind = eot_tok; kind = eot_tok;
@ -1503,7 +1506,7 @@ fast_tokenizer(void)
for (; chtype[ch] == SY; my_fgetch()) for (; chtype[ch] == SY; my_fgetch())
*charp++ = ch; *charp++ = ch;
*charp = '\0'; *charp = '\0';
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
kind = Name_tok; kind = Name_tok;
@ -1514,7 +1517,7 @@ fast_tokenizer(void)
*charp++ = ch; *charp++ = ch;
*charp++ = '\0'; *charp++ = '\0';
my_fgetch(); my_fgetch();
TokenInfo = Unsigned(LookupAtom(TokImage)); TokenInfo = Unsigned(_YAP_LookupAtom(TokImage));
if (ch == '(') if (ch == '(')
solo_flag = FALSE; solo_flag = FALSE;
kind = Name_tok; kind = Name_tok;
@ -1549,7 +1552,7 @@ fast_tokenizer(void)
break; break;
#ifdef DEBUG #ifdef DEBUG
default: default:
YP_fprintf(YP_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype[ch]); fprintf(_YAP_stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype[ch]);
kind = eot_tok; kind = eot_tok;
#else #else
default: default:
@ -1560,12 +1563,12 @@ fast_tokenizer(void)
t->Tok = Ord(kind); t->Tok = Ord(kind);
#ifdef DEBUG #ifdef DEBUG
if(Option[2]) YP_fprintf(YP_stderr,"[Token %d %ld]\n",Ord(kind),(unsigned long int)TokenInfo); if(_YAP_Option[2]) fprintf(_YAP_stderr,"[Token %d %ld]\n",Ord(kind),(unsigned long int)TokenInfo);
#endif #endif
t->TokInfo = (Term) TokenInfo; t->TokInfo = (Term) TokenInfo;
t->TokPos = TokenPos; t->TokPos = TokenPos;
t->TokNext = NIL; t->TokNext = NIL;
ReleasePreAllocCodeSpace((CODEADDR)TokImage); _YAP_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
} while (kind != eot_tok); } while (kind != eot_tok);
return (l); return (l);
} }

38
C/sort.c
View File

@ -58,8 +58,8 @@ build_new_list(CELL *pt, Term t)
} }
pt += 2; pt += 2;
if (pt > ASP - 4096) { if (pt > ASP - 4096) {
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -101,7 +101,7 @@ void simple_mergesort(CELL *pt, Int size, int my_p)
/* while there are elements in the left or right vector do compares */ /* while there are elements in the left or right vector do compares */
while (pt_left < end_pt_left && pt_right < end_pt) { while (pt_left < end_pt_left && pt_right < end_pt) {
/* if the element to the left is larger than the one to the right */ /* if the element to the left is larger than the one to the right */
if (compare_terms(pt_left[0], pt_right[0]) <= 0) { if (_YAP_compare_terms(pt_left[0], pt_right[0]) <= 0) {
/* copy the one to the left */ /* copy the one to the left */
pt[0] = pt_left[0]; pt[0] = pt_left[0];
/* and avance the two pointers */ /* and avance the two pointers */
@ -130,7 +130,7 @@ void simple_mergesort(CELL *pt, Int size, int my_p)
} }
} }
} else { } else {
if (size > 1 && (compare_terms(pt[0],pt[2]) > 0)) { if (size > 1 && (_YAP_compare_terms(pt[0],pt[2]) > 0)) {
CELL t = pt[2]; CELL t = pt[2];
pt[2+my_p] = pt[0]; pt[2+my_p] = pt[0];
pt[my_p] = t; pt[my_p] = t;
@ -181,7 +181,7 @@ int key_mergesort(CELL *pt, Int size, int my_p, Functor FuncDMinus)
if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus) if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus)
return(FALSE); return(FALSE);
t1 = ArgOfTerm(1,t1); t1 = ArgOfTerm(1,t1);
if (compare_terms(t0, t1) <= 0) { if (_YAP_compare_terms(t0, t1) <= 0) {
/* copy the one to the left */ /* copy the one to the left */
pt[0] = pt_left[0]; pt[0] = pt_left[0];
/* and avance the two pointers */ /* and avance the two pointers */
@ -218,7 +218,7 @@ int key_mergesort(CELL *pt, Int size, int my_p, Functor FuncDMinus)
if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus) if (IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FuncDMinus)
return(FALSE); return(FALSE);
t1 = ArgOfTerm(1,t1); t1 = ArgOfTerm(1,t1);
if (compare_terms(t0,t1) > 0) { if (_YAP_compare_terms(t0,t1) > 0) {
CELL t = pt[2]; CELL t = pt[2];
pt[2+my_p] = pt[0]; pt[2+my_p] = pt[0];
pt[my_p] = t; pt[my_p] = t;
@ -266,7 +266,7 @@ Int compact_mergesort(CELL *pt, Int size, int my_p)
/* while there are elements in the left or right vector do compares */ /* while there are elements in the left or right vector do compares */
while (pt_left < end_pt_left && pt_right < end_pt_right) { while (pt_left < end_pt_left && pt_right < end_pt_right) {
/* if the element to the left is larger than the one to the right */ /* if the element to the left is larger than the one to the right */
Int cmp = compare_terms(pt_left[0], pt_right[0]); Int cmp = _YAP_compare_terms(pt_left[0], pt_right[0]);
if (cmp < 0) { if (cmp < 0) {
/* copy the one to the left */ /* copy the one to the left */
pt[0] = pt_left[0]; pt[0] = pt_left[0];
@ -302,7 +302,7 @@ Int compact_mergesort(CELL *pt, Int size, int my_p)
} }
return(size); return(size);
} else if (size == 2) { } else if (size == 2) {
Int cmp = compare_terms(pt[0],pt[2]); Int cmp = _YAP_compare_terms(pt[0],pt[2]);
if (cmp > 0) { if (cmp > 0) {
/* swap */ /* swap */
CELL t = pt[2]; CELL t = pt[2];
@ -354,7 +354,7 @@ p_sort(void)
if (size < 0) if (size < 0)
return(FALSE); return(FALSE);
if (size < 2) if (size < 2)
return(unify(ARG1, ARG2)); return(_YAP_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */ pt = H; /* because of possible garbage collection */
/* make sure no one writes on our temp data structure */ /* make sure no one writes on our temp data structure */
H += size*2; H += size*2;
@ -364,7 +364,7 @@ p_sort(void)
H = pt+size*2; H = pt+size*2;
adjust_vector(pt, size); adjust_vector(pt, size);
out = AbsPair(pt); out = AbsPair(pt);
return(unify(out, ARG2)); return(_YAP_unify(out, ARG2));
} }
static Int static Int
@ -379,14 +379,14 @@ p_msort(void)
if (size < 0) if (size < 0)
return(FALSE); return(FALSE);
if (size < 2) if (size < 2)
return(unify(ARG1, ARG2)); return(_YAP_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */ pt = H; /* because of possible garbage collection */
/* reserve the necessary space */ /* reserve the necessary space */
H += size*2; H += size*2;
simple_mergesort(pt, size, M_EVEN); simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size); adjust_vector(pt, size);
out = AbsPair(pt); out = AbsPair(pt);
return(unify(out, ARG2)); return(_YAP_unify(out, ARG2));
} }
static Int static Int
@ -401,21 +401,21 @@ p_ksort(void)
if (size < 0) if (size < 0)
return(FALSE); return(FALSE);
if (size < 2) if (size < 2)
return(unify(ARG1, ARG2)); return(_YAP_unify(ARG1, ARG2));
/* reserve the necessary space */ /* reserve the necessary space */
pt = H; /* because of possible garbage collection */ pt = H; /* because of possible garbage collection */
H += size*2; H += size*2;
if (!key_mergesort(pt, size, M_EVEN, MkFunctor(AtomMinus,2))) if (!key_mergesort(pt, size, M_EVEN, _YAP_MkFunctor(AtomMinus,2)))
return(FALSE); return(FALSE);
adjust_vector(pt, size); adjust_vector(pt, size);
out = AbsPair(pt); out = AbsPair(pt);
return(unify(out, ARG2)); return(_YAP_unify(out, ARG2));
} }
void void
InitSortPreds(void) _YAP_InitSortPreds(void)
{ {
InitCPred("$sort", 2, p_sort, 0); _YAP_InitCPred("$sort", 2, p_sort, 0);
InitCPred("$msort", 2, p_msort, 0); _YAP_InitCPred("$msort", 2, p_msort, 0);
InitCPred("$keysort", 2, p_ksort, 0); _YAP_InitCPred("$keysort", 2, p_ksort, 0);
} }

799
C/stdpreds.c
View File

File diff suppressed because it is too large Load Diff

500
C/sysbits.c
View File

File diff suppressed because it is too large Load Diff

47
C/tracer.c
View File

@ -27,13 +27,12 @@
STATIC_PROTO(int TracePutchar, (int, int)); STATIC_PROTO(int TracePutchar, (int, int));
STATIC_PROTO(void send_tracer_message, (char *, char *, Int, char *, CELL *)); STATIC_PROTO(void send_tracer_message, (char *, char *, Int, char *, CELL *));
int do_low_level_trace = FALSE;
static int do_trace_primitives = TRUE; static int do_trace_primitives = TRUE;
static int static int
TracePutchar(int sno, int ch) TracePutchar(int sno, int ch)
{ {
return(YP_putc(ch, YP_stderr)); /* use standard error stream, which is supposed to be 2*/ return(putc(ch, _YAP_stderr)); /* use standard error stream, which is supposed to be 2*/
} }
static void static void
@ -41,35 +40,35 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
{ {
if (name == NULL) { if (name == NULL) {
#ifdef YAPOR #ifdef YAPOR
YP_fprintf(YP_stderr, "(%d)%s", worker_id, start); fprintf(_YAP_stderr, "(%d)%s", worker_id, start);
#else #else
YP_fprintf(YP_stderr, "%s", start); fprintf(_YAP_stderr, "%s", start);
#endif #endif
} else { } else {
int i; int i;
if (arity) { if (arity) {
YP_fprintf(YP_stderr, "%s %s:%s(", start, mname, name); fprintf(_YAP_stderr, "%s %s:%s(", start, mname, name);
} else { } else {
YP_fprintf(YP_stderr, "%s %s:%s", start, mname, name); fprintf(_YAP_stderr, "%s %s:%s", start, mname, name);
} }
for (i= 0; i < arity; i++) { for (i= 0; i < arity; i++) {
if (i > 0) YP_fprintf(YP_stderr, ","); if (i > 0) fprintf(_YAP_stderr, ",");
#if DEBUG #if DEBUG
#if COROUTINING #if COROUTINING
Portray_delays = TRUE; _YAP_Portray_delays = TRUE;
#endif #endif
#endif #endif
plwrite(args[i], TracePutchar, Handle_vars_f); _YAP_plwrite(args[i], TracePutchar, Handle_vars_f);
#if DEBUG #if DEBUG
#if COROUTINING #if COROUTINING
Portray_delays = FALSE; _YAP_Portray_delays = FALSE;
#endif #endif
#endif #endif
} }
if (arity) YP_fprintf(YP_stderr, ")"); if (arity) fprintf(_YAP_stderr, ")");
} }
YP_fprintf(YP_stderr, "\n"); fprintf(_YAP_stderr, "\n");
} }
#if defined(__GNUC__) #if defined(__GNUC__)
@ -82,7 +81,7 @@ unsigned long vsc_count;
static int static int
check_trail_consistency(void) { check_trail_consistency(void) {
tr_fr_ptr ptr = TR; tr_fr_ptr ptr = TR;
while (ptr > (CELL *)TrailBase) { while (ptr > (CELL *)_YAP_TrailBase) {
ptr = --ptr; ptr = --ptr;
if (!IsVarTerm(TrailTerm(ptr))) { if (!IsVarTerm(TrailTerm(ptr))) {
if (IsApplTerm(TrailTerm(ptr))) { if (IsApplTerm(TrailTerm(ptr))) {
@ -120,7 +119,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* if (vsc_count > 500000) exit(0); */ /* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return; */ /* if (gc_calls < 1) return; */
#if defined(__GNUC__) #if defined(__GNUC__)
YP_fprintf(YP_stderr,"%llu ", vsc_count); fprintf(_YAP_stderr,"%llu ", vsc_count);
#endif #endif
/* check_trail_consistency(); */ /* check_trail_consistency(); */
if (pred == NULL) { if (pred == NULL) {
@ -131,7 +130,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
} }
switch (port) { switch (port) {
case enter_pred: case enter_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -154,7 +153,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
if (pred == NULL) { if (pred == NULL) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args); send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
} else { } else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -171,7 +170,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
if (pred == NULL) { if (pred == NULL) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args); send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
} else { } else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -183,7 +182,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
} }
break; break;
case retry_pred: case retry_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -200,27 +199,27 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
void void
toggle_low_level_trace(void) toggle_low_level_trace(void)
{ {
do_low_level_trace = !do_low_level_trace; _YAP_do_low_level_trace = !_YAP_do_low_level_trace;
} }
static Int p_start_low_level_trace(void) static Int p_start_low_level_trace(void)
{ {
do_low_level_trace = TRUE; _YAP_do_low_level_trace = TRUE;
return(TRUE); return(TRUE);
} }
static Int p_stop_low_level_trace(void) static Int p_stop_low_level_trace(void)
{ {
do_low_level_trace = FALSE; _YAP_do_low_level_trace = FALSE;
do_trace_primitives = TRUE; do_trace_primitives = TRUE;
return(TRUE); return(TRUE);
} }
void void
InitLowLevelTrace(void) _YAP_InitLowLevelTrace(void)
{ {
InitCPred("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag); _YAP_InitCPred("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag);
InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag); _YAP_InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag);
} }
#endif #endif

1170
C/unify.c
View File

File diff suppressed because it is too large Load Diff

123
C/userpreds.c
View File

@ -61,7 +61,6 @@ STATIC_PROTO(int p_trapsignal, (void));
STATIC_PROTO(int subsumes, (Term, Term)); STATIC_PROTO(int subsumes, (Term, Term));
STATIC_PROTO(int p_subsumes, (void)); STATIC_PROTO(int p_subsumes, (void));
STATIC_PROTO(int p_grab_tokens, (void)); STATIC_PROTO(int p_grab_tokens, (void));
/* int PlGetchar(Int *); */
#endif #endif
#ifdef MACYAP #ifdef MACYAP
STATIC_PROTO(typedef int, (*SignalProc) ()); STATIC_PROTO(typedef int, (*SignalProc) ());
@ -140,14 +139,14 @@ Term T1, T2;
Term t2 = Deref(T2); Term t2 = Deref(T2);
if (IsVarTerm(t1)) { /* Testing for variables should be done first */ if (IsVarTerm(t1)) { /* Testing for variables should be done first */
if (IsVarTerm(t2) || IsPrimitiveTerm(t2)) if (IsVarTerm(t2) || IsPrimitiveTerm(t2))
return (unify(T1, t2)); return (_YAP_unify(T1, t2));
if (occurs_check(t1, t2)) if (occurs_check(t1, t2))
return (unify(T1, t2)); return (_YAP_unify(T1, t2));
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
if (occurs_check(t2, t1)) if (occurs_check(t2, t1))
return (unify(T2, t1)); return (_YAP_unify(T2, t1));
return (FALSE); return (FALSE);
} }
if (IsPrimitiveTerm(t1)) { if (IsPrimitiveTerm(t1)) {
@ -221,10 +220,10 @@ p_counter()
return (FALSE); return (FALSE);
a = AtomOfTerm(T1); a = AtomOfTerm(T1);
if (IsVarTerm(T2)) { if (IsVarTerm(T2)) {
TCount = GetValue(a); TCount = _YAP_GetValue(a);
if (!IsIntTerm(TCount)) if (!IsIntTerm(TCount))
return (FALSE); return (FALSE);
unify_constant(ARG2, TCount); /* always succeeds */ _YAP_unify_constant(ARG2, TCount); /* always succeeds */
val = IntOfTerm(TCount); val = IntOfTerm(TCount);
} else { } else {
if (!IsIntTerm(T2)) if (!IsIntTerm(T2))
@ -233,8 +232,8 @@ p_counter()
} }
val++; val++;
/* The atom will now take the incremented value */ /* The atom will now take the incremented value */
PutValue(a, TNext = MkIntTerm(val)); _YAP_PutValue(a, TNext = MkIntTerm(val));
return (unify_constant(ARG3, TNext)); return (_YAP_unify_constant(ARG3, TNext));
} }
/* /*
@ -273,7 +272,7 @@ p_iconcat()
while (L0 = *--Tkp) while (L0 = *--Tkp)
L1 = MkPairTerm(L0, L1); L1 = MkPairTerm(L0, L1);
T2 = L1; T2 = L1;
return (unify(T2, ARG3)); return (_YAP_unify(T2, ARG3));
} }
#endif /* COMMENT */ #endif /* COMMENT */
@ -296,7 +295,7 @@ p_iconcat()
*Tkp++ = Deref(ARG2); *Tkp++ = Deref(ARG2);
T2 = *H; T2 = *H;
H = Tkp; H = Tkp;
return (unify(T2, ARG3)); return (_YAP_unify(T2, ARG3));
} }
#endif /* USERPREDS */ #endif /* USERPREDS */
@ -334,7 +333,7 @@ p_clean() /* predicate clean for ets */
if ((*pt++ = *ntp++) == MkAtomTerm(AtomDollarUndef)) if ((*pt++ = *ntp++) == MkAtomTerm(AtomDollarUndef))
pt -= 2; pt -= 2;
H = pt; H = pt;
return (unify(tn, ARG2)); return (_YAP_unify(tn, ARG2));
} }
#endif #endif
for (i = 1; i <= arity; ++i) { for (i = 1; i <= arity; ++i) {
@ -342,8 +341,8 @@ p_clean() /* predicate clean for ets */
t = MkVarTerm(); t = MkVarTerm();
Args[i - 1] = t; Args[i - 1] = t;
} }
t = MkApplTerm(FunctorOfTerm(t1), arity, Args); t = _YAP_MkApplTerm(FunctorOfTerm(t1), arity, Args);
return (unify(ARG2, t)); return (_YAP_unify(ARG2, t));
} }
static Term *subs_table; static Term *subs_table;
@ -365,7 +364,7 @@ Term T1, T2;
if (subs_table[i] == T2) if (subs_table[i] == T2)
return (FALSE); return (FALSE);
if (T2 < T1) { /* T1 gets instantiated with T2 */ if (T2 < T1) { /* T1 gets instantiated with T2 */
unify(T1, T2); _YAP_unify(T1, T2);
for (i = 0; i < subs_entries; ++i) for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T1) { if (subs_table[i] == T1) {
subs_table[i] = T2; subs_table[i] = T2;
@ -375,7 +374,7 @@ Term T1, T2;
return (TRUE); return (TRUE);
} }
/* T2 gets instantiated with T1 */ /* T2 gets instantiated with T1 */
unify(T1, T2); _YAP_unify(T1, T2);
for (i = 0; i < subs_entries; ++i) for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T1) if (subs_table[i] == T1)
return (TRUE); return (TRUE);
@ -386,7 +385,7 @@ Term T1, T2;
for (i = 0; i < subs_entries; ++i) for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T2) if (subs_table[i] == T2)
return (FALSE); return (FALSE);
return (unify(T1, T2)); return (_YAP_unify(T1, T2));
} }
if (IsPrimitiveTerm(T1)) { if (IsPrimitiveTerm(T1)) {
if (IsFloatTerm(T1)) if (IsFloatTerm(T1))
@ -507,7 +506,7 @@ p_namelength()
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Term tf = MkIntTerm(strlen(RepAtom(AtomOfTerm(t))->StrOfAE)); Term tf = MkIntTerm(strlen(RepAtom(AtomOfTerm(t))->StrOfAE));
return (unify_constant(ARG2, tf)); return (_YAP_unify_constant(ARG2, tf));
} else if (IsIntTerm(t)) { } else if (IsIntTerm(t)) {
register int i = 1, k = IntOfTerm(t); register int i = 1, k = IntOfTerm(t);
if (k < 0) if (k < 0)
@ -515,7 +514,7 @@ p_namelength()
while (k > 10) while (k > 10)
++i, k /= 10; ++i, k /= 10;
tf = MkIntTerm(i); tf = MkIntTerm(i);
return (unify_constant(ARG2, tf)); return (_YAP_unify_constant(ARG2, tf));
} else } else
return (FALSE); return (FALSE);
} }
@ -528,7 +527,7 @@ p_getpid()
#else #else
Term t = MkIntTerm(1); Term t = MkIntTerm(1);
#endif #endif
return (unify_constant(ARG1, t)); return (_YAP_unify_constant(ARG1, t));
} }
static int static int
@ -537,7 +536,7 @@ p_exit()
register Term t = Deref(ARG1); register Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsIntTerm(t)) if (IsVarTerm(t) || !IsIntTerm(t))
return (FALSE); return (FALSE);
exit_yap((int) IntOfTerm(t)); _YAP_exit((int) IntOfTerm(t));
return(FALSE); return(FALSE);
} }
@ -558,7 +557,7 @@ p_setcounter()
{ {
register Term t = Deref(ARG1); register Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsIntTerm(t)) { if (IsVarTerm(t) || !IsIntTerm(t)) {
return (unify_constant(ARG1, MkIntTerm(current_pos))); return (_YAP_unify_constant(ARG1, MkIntTerm(current_pos)));
} else { } else {
current_pos = IntOfTerm(t); current_pos = IntOfTerm(t);
return (TRUE); return (TRUE);
@ -597,34 +596,34 @@ p_grab_tokens()
Functor IdFunctor, VarFunctor; Functor IdFunctor, VarFunctor;
char ch, IdChars[255], *chp; char ch, IdChars[255], *chp;
IdAtom = LookupAtom("id"); IdAtom = _YAP_LookupAtom("id");
IdFunctor = MkFunctor(IdAtom, 1); IdFunctor = _YAP_MkFunctor(IdAtom, 1);
VarAtom = LookupAtom("var"); VarAtom = _YAP_LookupAtom("var");
VarFunctor = MkFunctor(VarAtom, 1); VarFunctor = _YAP_MkFunctor(VarAtom, 1);
p0 = p; p0 = p;
ch = PlGetchar(); ch = _YAP_PlGetchar();
while (1) { while (1) {
while (ch <= ' ' && ch != EOF) while (ch <= ' ' && ch != EOF)
ch = PlGetchar(); ch = _YAP_PlGetchar();
if (ch == '.' || ch == EOF) if (ch == '.' || ch == EOF)
break; break;
if (ch == '%') { if (ch == '%') {
while ((ch = PlGetchar()) != 10); while ((ch = _YAP_PlGetchar()) != 10);
ch = PlGetchar(); ch = _YAP_PlGetchar();
continue; continue;
} }
if (ch == '\'') { if (ch == '\'') {
chp = IdChars; chp = IdChars;
while (1) { while (1) {
ch = PlGetchar(); ch = _YAP_PlGetchar();
if (ch == '\'') if (ch == '\'')
break; break;
*chp++ = ch; *chp++ = ch;
} }
*chp = 0; *chp = 0;
t = MkAtomTerm(LookupAtom(IdChars)); t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = MkApplTerm(IdFunctor, 1, &t); *p-- = _YAP_MkApplTerm(IdFunctor, 1, &t);
ch = PlGetchar(); ch = _YAP_PlGetchar();
continue; continue;
} }
@ -632,40 +631,40 @@ p_grab_tokens()
chp = IdChars; chp = IdChars;
*chp++ = ch; *chp++ = ch;
while (1) { while (1) {
ch = PlGetchar(); ch = _YAP_PlGetchar();
if (!idchar(ch)) if (!idchar(ch))
break; break;
*chp++ = ch; *chp++ = ch;
} }
*chp = 0; *chp = 0;
t = MkAtomTerm(LookupAtom(IdChars)); t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = MkApplTerm(VarFunctor, 1, &t); *p-- = _YAP_MkApplTerm(VarFunctor, 1, &t);
continue; continue;
} }
if (idstarter(ch)) { if (idstarter(ch)) {
chp = IdChars; chp = IdChars;
*chp++ = ch; *chp++ = ch;
while (1) { while (1) {
ch = PlGetchar(); ch = _YAP_PlGetchar();
if (!idchar(ch)) if (!idchar(ch))
break; break;
*chp++ = ch; *chp++ = ch;
} }
*chp = 0; *chp = 0;
t = MkAtomTerm(LookupAtom(IdChars)); t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = MkApplTerm(IdFunctor, 1, &t); *p-- = _YAP_MkApplTerm(IdFunctor, 1, &t);
continue; continue;
} }
IdChars[0] = ch; IdChars[0] = ch;
IdChars[1] = 0; IdChars[1] = 0;
*p-- = MkAtomTerm(LookupAtom(IdChars)); *p-- = MkAtomTerm(_YAP_LookupAtom(IdChars));
ch = PlGetchar(); ch = _YAP_PlGetchar();
} }
t = MkAtomTerm(AtomNil); t = MkAtomTerm(AtomNil);
while (p != p0) { while (p != p0) {
t = MkPairTerm(*++p, t); t = MkPairTerm(*++p, t);
} }
return (unify(ARG1, t)); return (_YAP_unify(ARG1, t));
} }
#endif /* EUROTRA */ #endif /* EUROTRA */
@ -688,8 +687,8 @@ p_softfunctor()
return (FALSE); return (FALSE);
a = AtomOfTerm(t1); a = AtomOfTerm(t1);
WRITE_LOCK(RepAtom(a)->ARWLock); WRITE_LOCK(RepAtom(a)->ARWLock);
if ((p0 = GetAProp(a, SFProperty)) == NIL) { if ((p0 = _YAP_GetAProp(a, SFProperty)) == NIL) {
pe = (SFEntry *) AllocAtomSpace(sizeof(*pe)); pe = (SFEntry *) _YAP_AllocAtomSpace(sizeof(*pe));
pe->NextOfPE = RepAtom(a)->PropsOfAE; pe->NextOfPE = RepAtom(a)->PropsOfAE;
pe->KindOfPE = SFProperty; pe->KindOfPE = SFProperty;
RepAtom(a)->PropsOfAE = AbsSFProp(pe); RepAtom(a)->PropsOfAE = AbsSFProp(pe);
@ -713,34 +712,34 @@ p_matching_distances(void)
*/ */
void void
InitUserCPreds(void) _YAP_InitUserCPreds(void)
{ {
#ifdef XINTERFACE #ifdef XINTERFACE
InitXPreds(); _YAP_InitXPreds();
#endif #endif
#ifdef EUROTRA #ifdef EUROTRA
InitCPred("clean", 2, p_clean, SafePredFlag|SyncPredFlag); _YAP_InitCPred("clean", 2, p_clean, SafePredFlag|SyncPredFlag);
InitCPred("name_length", 2, p_namelength, SafePredFlag|SyncPredFlag); _YAP_InitCPred("name_length", 2, p_namelength, SafePredFlag|SyncPredFlag);
InitCPred("get_pid", 1, p_getpid, SafePredFlag); _YAP_InitCPred("get_pid", 1, p_getpid, SafePredFlag);
InitCPred("exit", 1, p_exit, SafePredFlag|SyncPredFlag); _YAP_InitCPred("exit", 1, p_exit, SafePredFlag|SyncPredFlag);
InitCPred("incr_counter", 1, p_incrcounter, SafePredFlag|SyncPredFlag); _YAP_InitCPred("incr_counter", 1, p_incrcounter, SafePredFlag|SyncPredFlag);
InitCPred("set_counter", 1, p_setcounter, SafePredFlag|SyncPredFlag); _YAP_InitCPred("set_counter", 1, p_setcounter, SafePredFlag|SyncPredFlag);
InitCPred("trap_signal", 0, p_trapsignal, SafePredFlag|SyncPredFlag); _YAP_InitCPred("trap_signal", 0, p_trapsignal, SafePredFlag|SyncPredFlag);
InitCPred("mark2_grab_tokens", 1, p_grab_tokens, SafePredFlag|SyncPredFlag); _YAP_InitCPred("mark2_grab_tokens", 1, p_grab_tokens, SafePredFlag|SyncPredFlag);
InitCPred("subsumes", 2, p_subsumes, SafePredFlag); _YAP_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
#endif #endif
#ifdef SFUNC #ifdef SFUNC
InitCPred("sparse_functor", 2, p_softfunctor, SafePredFlag); _YAP_InitCPred("sparse_functor", 2, p_softfunctor, SafePredFlag);
#endif /* SFUNC */ #endif /* SFUNC */
/* InitCPred("match_distances", 3, p_matching_distances, SafePredFlag); */ /* _YAP_InitCPred("match_distances", 3, p_matching_distances, SafePredFlag); */
/* InitCPred("unify",2,p_unify,SafePredFlag); */ /* _YAP_InitCPred("unify",2,p_unify,SafePredFlag); */
/* InitCPred("occurs_check",2,p_occurs_check,SafePredFlag); */ /* _YAP_InitCPred("occurs_check",2,p_occurs_check,SafePredFlag); */
/* InitCPred("counter",3,p_counter,SafePredFlag); */ /* _YAP_InitCPred("counter",3,p_counter,SafePredFlag); */
/* InitCPred("iconcat",3,p_iconcat,SafePredFlag); */ /* _YAP_InitCPred("iconcat",3,p_iconcat,SafePredFlag); */
} }
void void
InitUserBacks(void) _YAP_InitUserBacks(void)
{ {
} }

121
C/utilpreds.c
View File

@ -86,7 +86,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
*ptf = AbsPair(H); *ptf = AbsPair(H);
ptf++; ptf++;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) { if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -98,7 +98,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
to_visit += 4; to_visit += 4;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) { if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -136,7 +136,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) { if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -148,7 +148,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
to_visit += 4; to_visit += 4;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) { if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -189,7 +189,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
*ptf++ = (CELL) ptd0; *ptf++ = (CELL) ptd0;
} else { } else {
if (dvars == NULL) { if (dvars == NULL) {
dvars = (CELL *)ReadTimedVar(DelayedVars); dvars = (CELL *)_YAP_ReadTimedVar(DelayedVars);
} }
bp[0] = to_visit; bp[0] = to_visit;
CurTR = TR; CurTR = TR;
@ -292,7 +292,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
return(-2); return(-2);
} }
Term static Term
CopyTerm(Term inp) { CopyTerm(Term inp) {
Term t = Deref(inp); Term t = Deref(inp);
@ -309,15 +309,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) { if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) {
ARG1 = t; ARG1 = t;
if (res == -1) { /* handle overflow */ if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
goto restart_attached; goto restart_attached;
} else { /* handle overflow */ } else { /* handle overflow */
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -345,15 +345,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) { if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) {
ARG1 = t; ARG1 = t;
if (res == -1) { /* handle overflow */ if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
goto restart_list; goto restart_list;
} else { /* handle overflow */ } else { /* handle overflow */
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -380,15 +380,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) { if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {
ARG1 = t; ARG1 = t;
if (res == -1) { if (res == -1) {
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
goto restart_appl; goto restart_appl;
} else { /* handle overflow */ } else { /* handle overflow */
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -400,10 +400,15 @@ CopyTerm(Term inp) {
} }
} }
Term
_YAP_CopyTerm(Term inp) {
return CopyTerm(inp);
}
static Int static Int
p_copy_term(void) /* copy term t to a new instance */ p_copy_term(void) /* copy term t to a new instance */
{ {
return(unify(ARG2,CopyTerm(ARG1))); return(_YAP_unify(ARG2,CopyTerm(ARG1)));
} }
static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow) static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *HLow)
@ -434,7 +439,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
*ptf = AbsPair(H); *ptf = AbsPair(H);
ptf++; ptf++;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) { if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -446,7 +451,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
to_visit += 4; to_visit += 4;
#else #else
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) { if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -482,7 +487,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) { if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
to_visit[0] = pt0; to_visit[0] = pt0;
@ -493,7 +498,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
*pt0 = AbsAppl(H); *pt0 = AbsAppl(H);
to_visit += 4; to_visit += 4;
#else #else
if (to_visit + 3 >= (CELL **)GlobalBase) { if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow; goto heap_overflow;
} }
if (pt0 < pt0_end) { if (pt0 < pt0_end) {
@ -613,15 +618,15 @@ CopyTermNoDelays(Term inp) {
res = copy_complex_term_no_delays(ap-1, ap+1, H-2, H-2); res = copy_complex_term_no_delays(ap-1, ap+1, H-2, H-2);
if (res) { if (res) {
if (res == -1) { /* handle overflow */ if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
goto restart_list; goto restart_list;
} else { /* handle overflow */ } else { /* handle overflow */
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -645,15 +650,15 @@ CopyTermNoDelays(Term inp) {
res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0); res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0);
if (res) { if (res) {
if (res == -1) { if (res == -1) {
if (!gc(2, ENV, P)) { if (!_YAP_gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage); _YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
goto restart_appl; goto restart_appl;
} else { /* handle overflow */ } else { /* handle overflow */
if (!growheap(FALSE)) { if (!_YAP_growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage); _YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE); return(FALSE);
} }
t = Deref(ARG1); t = Deref(ARG1);
@ -667,7 +672,7 @@ CopyTermNoDelays(Term inp) {
static Int static Int
p_copy_term_no_delays(void) /* copy term t to a new instance */ p_copy_term_no_delays(void) /* copy term t to a new instance */
{ {
return(unify(ARG2,CopyTermNoDelays(ARG1))); return(_YAP_unify(ARG2,CopyTermNoDelays(ARG1)));
} }
@ -768,7 +773,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end)
Term t2 = Deref(ARG2); Term t2 = Deref(ARG2);
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
RESET_VARIABLE(H-1); RESET_VARIABLE(H-1);
unify((CELL)(H-1),ARG2); _YAP_unify((CELL)(H-1),ARG2);
} else { } else {
H[-1] = t2; /* don't need to trail */ H[-1] = t2; /* don't need to trail */
} }
@ -789,8 +794,8 @@ p_variables_in_term(void) /* variables in term t */
H += 2; H += 2;
RESET_VARIABLE(H-2); RESET_VARIABLE(H-2);
RESET_VARIABLE(H-1); RESET_VARIABLE(H-1);
unify((CELL)(H-2),ARG1); _YAP_unify((CELL)(H-2),ARG1);
unify((CELL)(H-1),ARG2); _YAP_unify((CELL)(H-1),ARG2);
} else if (IsPrimitiveTerm(t)) } else if (IsPrimitiveTerm(t))
out = ARG2; out = ARG2;
else if (IsPairTerm(t)) { else if (IsPairTerm(t)) {
@ -803,7 +808,7 @@ p_variables_in_term(void) /* variables in term t */
RepAppl(t)+ RepAppl(t)+
ArityOfFunctor(f)); ArityOfFunctor(f));
} }
return(unify(ARG3,out)); return(_YAP_unify(ARG3,out));
} }
static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end) static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end)
@ -906,7 +911,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
if (H != InitialH) { if (H != InitialH) {
/* close the list */ /* close the list */
RESET_VARIABLE(H-1); RESET_VARIABLE(H-1);
unify((CELL)(H-1),ARG2); _YAP_unify((CELL)(H-1),ARG2);
return(output); return(output);
} else { } else {
return(ARG2); return(ARG2);
@ -929,7 +934,7 @@ p_non_singletons_in_term(void) /* non_singletons in term t */
else out = non_singletons_in_complex_term(RepAppl(t), else out = non_singletons_in_complex_term(RepAppl(t),
RepAppl(t)+ RepAppl(t)+
ArityOfFunctor(FunctorOfTerm(t))); ArityOfFunctor(FunctorOfTerm(t)));
return(unify(ARG3,out)); return(_YAP_unify(ARG3,out));
} }
static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end) static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
@ -1246,24 +1251,24 @@ GvNTermHash(void)
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"term_hash/4"); _YAP_Error(INSTANTIATION_ERROR,t2,"term_hash/4");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(t2)) { if (!IsIntegerTerm(t2)) {
Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); _YAP_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
return(FALSE); return(FALSE);
} }
depth = IntegerOfTerm(t2); depth = IntegerOfTerm(t2);
if (depth == 0) { if (depth == 0) {
if (IsVarTerm(t1)) return(TRUE); if (IsVarTerm(t1)) return(TRUE);
return(unify(ARG4,MkIntTerm(0))); return(_YAP_unify(ARG4,MkIntTerm(0)));
} }
if (IsVarTerm(t3)) { if (IsVarTerm(t3)) {
Error(INSTANTIATION_ERROR,t3,"term_hash/4"); _YAP_Error(INSTANTIATION_ERROR,t3,"term_hash/4");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(t3)) { if (!IsIntegerTerm(t3)) {
Error(TYPE_ERROR_INTEGER,t3,"term_hash/4"); _YAP_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4");
return(FALSE); return(FALSE);
} }
size = IntegerOfTerm(t3); size = IntegerOfTerm(t3);
@ -1278,7 +1283,7 @@ GvNTermHash(void)
i3 = GvNht[2]; i3 = GvNht[2];
i2 ^= i3; i1 ^= i2; i1 = (((i3 << 7) + i2) << 7) + i1; i2 ^= i3; i1 ^= i2; i1 = (((i3 << 7) + i2) << 7) + i1;
result = MkIntegerTerm(i1 % size); result = MkIntegerTerm(i1 % size);
return(unify(ARG4,result)); return(_YAP_unify(ARG4,result));
} }
static int variant_complex(register CELL *pt0, register CELL *pt0_end, register static int variant_complex(register CELL *pt0, register CELL *pt0_end, register
@ -1680,30 +1685,30 @@ camacho_dum(void)
/* build output list */ /* build output list */
t1 = MkAtomTerm(LookupAtom("[]")); t1 = MkAtomTerm(_YAP_LookupAtom("[]"));
t2 = MkPairTerm(MkIntegerTerm(max), t1); t2 = MkPairTerm(MkIntegerTerm(max), t1);
return(unify(t2, ARG1)); return(_YAP_unify(t2, ARG1));
} }
#endif /* DEBUG */ #endif /* DEBUG */
void InitUtilCPreds(void) void _YAP_InitUtilCPreds(void)
{ {
InitCPred("copy_term", 2, p_copy_term, 0); _YAP_InitCPred("copy_term", 2, p_copy_term, 0);
InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0); _YAP_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
InitCPred("ground", 1, p_ground, SafePredFlag); _YAP_InitCPred("ground", 1, p_ground, SafePredFlag);
InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag); _YAP_InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag);
InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag); _YAP_InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag); _YAP_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag);
InitCPred("term_hash", 4, GvNTermHash, SafePredFlag); _YAP_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
InitCPred("variant", 2, p_variant, SafePredFlag); _YAP_InitCPred("variant", 2, p_variant, SafePredFlag);
InitCPred("subsumes", 2, p_subsumes, SafePredFlag); _YAP_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
#ifdef DEBUG #ifdef DEBUG
InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag); _YAP_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
InitCPred("dum", 1, camacho_dum, SafePredFlag); _YAP_InitCPred("dum", 1, camacho_dum, SafePredFlag);
#endif #endif
} }

70
C/write.c
View File

@ -60,13 +60,7 @@ static int Quote_illegal, Ignore_ops, Handle_vars, Use_portray;
static int keep_terms; static int keep_terms;
#if DEBUG #define wrputc(X) ((*writech)(_YAP_c_output_stream,X)) /* writes a character */
#if COROUTINING
int Portray_delays = FALSE;
#endif
#endif
#define wrputc(X) ((*writech)(c_output_stream,X)) /* writes a character */
static void static void
wrputn(Int n) /* writes an integer */ wrputn(Int n) /* writes an integer */
@ -160,24 +154,24 @@ legalAtom(char *s) /* Is this a legal atom ? */
register int ch = *s; register int ch = *s;
if (ch == '\0') if (ch == '\0')
return(FALSE); return(FALSE);
if (chtype[ch] != LC) { if (_YAP_chtype[ch] != LC) {
if (ch == '[') if (ch == '[')
return (*++s == ']' && !(*++s)); return (*++s == ']' && !(*++s));
else if (ch == '{') else if (ch == '{')
return (*++s == '}' && !(*++s)); return (*++s == '}' && !(*++s));
else if (chtype[ch] == SL) else if (_YAP_chtype[ch] == SL)
return (!*++s); return (!*++s);
else if ((ch == ',' || ch == '.') && !s[1]) else if ((ch == ',' || ch == '.') && !s[1])
return (FALSE); return (FALSE);
else else
while (ch) { while (ch) {
if (chtype[ch] != SY) return (FALSE); if (_YAP_chtype[ch] != SY) return (FALSE);
ch = *++s; ch = *++s;
} }
return (TRUE); return (TRUE);
} else } else
while ((ch = *++s) != 0) while ((ch = *++s) != 0)
if (chtype[ch] > NU) if (_YAP_chtype[ch] > NU)
return (FALSE); return (FALSE);
return (TRUE); return (TRUE);
} }
@ -185,25 +179,25 @@ legalAtom(char *s) /* Is this a legal atom ? */
static int LeftOpToProtect(Atom at, int p) static int LeftOpToProtect(Atom at, int p)
{ {
int op, rp; int op, rp;
Prop opinfo = GetAProp(at, OpProperty); Prop opinfo = _YAP_GetAProp(at, OpProperty);
return(opinfo && IsPrefixOp(opinfo, &op, &rp) ); return(opinfo && _YAP_IsPrefixOp(opinfo, &op, &rp) );
} }
static int RightOpToProtect(Atom at, int p) static int RightOpToProtect(Atom at, int p)
{ {
int op, lp; int op, lp;
Prop opinfo = GetAProp(at, OpProperty); Prop opinfo = _YAP_GetAProp(at, OpProperty);
return(opinfo && IsPosfixOp(opinfo, &op, &lp) ); return(opinfo && _YAP_IsPosfixOp(opinfo, &op, &lp) );
} }
static wtype static wtype
AtomIsSymbols(char *s) /* Is this atom just formed by symbols ? */ AtomIsSymbols(char *s) /* Is this atom just formed by symbols ? */
{ {
int ch; int ch;
if (chtype[(int)s[0]] == SL && s[1] == '\0') if (_YAP_chtype[(int)s[0]] == SL && s[1] == '\0')
return(separator); return(separator);
while ((ch = *s++) != '\0') { while ((ch = *s++) != '\0') {
if (chtype[ch] != SY) if (_YAP_chtype[ch] != SY)
return(alphanum); return(alphanum);
} }
return(symbol); return(symbol);
@ -218,7 +212,7 @@ putAtom(Atom atom) /* writes an atom */
/* #define CRYPT_FOR_STEVE 1*/ /* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE #ifdef CRYPT_FOR_STEVE
if (GetValue(LookupAtom("crypt_atoms")) != TermNil && GetAProp(atom, OpProperty) == NIL) { if (_YAP_GetValue(_YAP_LookupAtom("crypt_atoms")) != TermNil && _YAP_GetAProp(atom, OpProperty) == NIL) {
char s[16]; char s[16];
sprintf(s,"x%x", (CELL)s); sprintf(s,"x%x", (CELL)s);
wrputs(s); wrputs(s);
@ -308,10 +302,10 @@ write_var(CELL *t)
if (CellPtr(t) < H0) { if (CellPtr(t) < H0) {
#if COROUTINING #if COROUTINING
#if DEBUG #if DEBUG
if (Portray_delays) { if (_YAP_Portray_delays) {
exts ext = ExtFromCell(t); exts ext = ExtFromCell(t);
Portray_delays = FALSE; _YAP_Portray_delays = FALSE;
if (ext == susp_ext) { if (ext == susp_ext) {
wrputs("$DL("); wrputs("$DL(");
write_var(t); write_var(t);
@ -352,13 +346,13 @@ write_var(CELL *t)
} }
wrputc(')'); wrputc(')');
} }
Portray_delays = TRUE; _YAP_Portray_delays = TRUE;
return; return;
} }
#endif #endif
#endif #endif
wrputc('D'); wrputc('D');
wrputn(((Int) (t- CellPtr(GlobalBase)))); wrputn(((Int) (t- CellPtr(_YAP_GlobalBase))));
} else { } else {
wrputn(((Int) (t- H0))); wrputn(((Int) (t- H0)));
} }
@ -371,7 +365,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
{ {
if (*max_depth != 0 && depth > *max_depth) { if (*max_depth != 0 && depth > *max_depth) {
putAtom(LookupAtom("...")); putAtom(_YAP_LookupAtom("..."));
return; return;
} }
if (EX != 0) if (EX != 0)
@ -392,9 +386,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
#ifdef USE_GMP #ifdef USE_GMP
} else if (IsBigIntTerm(t)) { } else if (IsBigIntTerm(t)) {
char *s = (char *)TR; char *s = (char *)TR;
while (s+2+mpz_sizeinbase(BigIntOfTerm(t), 10) > (char *)TrailTop) while (s+2+mpz_sizeinbase(_YAP_BigIntOfTerm(t), 10) > (char *)_YAP_TrailTop)
growtrail(64*1024); _YAP_growtrail(64*1024);
mpz_get_str(s, 10, BigIntOfTerm(t)); mpz_get_str(s, 10, _YAP_BigIntOfTerm(t));
wrputs(s); wrputs(s);
#endif #endif
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
@ -407,17 +401,17 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
long sl = 0; long sl = 0;
targs[0] = t; targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil)); _YAP_PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX; if (EX != 0L) old_EX = EX;
/* *--ASP = MkIntTerm(0); */ /* *--ASP = MkIntTerm(0); */
sl = _YAP_InitSlot(t); sl = _YAP_InitSlot(t);
execute_goal(MkApplTerm(FunctorPortray, 1, targs), 0, 1); _YAP_execute_goal(_YAP_MkApplTerm(FunctorPortray, 1, targs), 0, 1);
t = _YAP_GetFromSlot(sl); t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1); _YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX; if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE; Use_portray = TRUE;
Use_portray = TRUE; Use_portray = TRUE;
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue)) if (_YAP_GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
return; return;
} }
if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) { if (yap_flags[WRITE_QUOTED_STRING_FLAG] && IsStringTerm(t)) {
@ -430,7 +424,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
long sl= 0; long sl= 0;
if (*max_list && eldepth > *max_list) { if (*max_list && eldepth > *max_list) {
putAtom(LookupAtom("...")); putAtom(_YAP_LookupAtom("..."));
wrputc(']'); wrputc(']');
lastw = separator; lastw = separator;
return; return;
@ -471,7 +465,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
Arity = ArityOfFunctor(functor); Arity = ArityOfFunctor(functor);
atom = NameOfFunctor(functor); atom = NameOfFunctor(functor);
opinfo = GetAProp(atom, OpProperty); opinfo = _YAP_GetAProp(atom, OpProperty);
#ifdef SFUNC #ifdef SFUNC
if (Arity == SFArity) { if (Arity == SFArity) {
int argno = 1; int argno = 1;
@ -514,19 +508,19 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
long sl = 0; long sl = 0;
targs[0] = t; targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil)); _YAP_PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX; if (EX != 0L) old_EX = EX;
sl = _YAP_InitSlot(t); sl = _YAP_InitSlot(t);
execute_goal(MkApplTerm(FunctorPortray, 1, targs),0, 1); _YAP_execute_goal(_YAP_MkApplTerm(FunctorPortray, 1, targs),0, 1);
t = _YAP_GetFromSlot(sl); t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1); _YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX; if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE; Use_portray = TRUE;
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L) if (_YAP_GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
return; return;
} }
if (!Ignore_ops && if (!Ignore_ops &&
Arity == 1 && opinfo && IsPrefixOp(opinfo, &op, Arity == 1 && opinfo && _YAP_IsPrefixOp(opinfo, &op,
&rp) &rp)
#ifdef DO_NOT_WRITE_PLUS_AND_MINUS_AS_PREFIX #ifdef DO_NOT_WRITE_PLUS_AND_MINUS_AS_PREFIX
&& &&
@ -563,7 +557,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator; lastw = separator;
} }
} else if (!Ignore_ops && } else if (!Ignore_ops &&
Arity == 1 && opinfo && IsPosfixOp(opinfo, &op, &lp)) { Arity == 1 && opinfo && _YAP_IsPosfixOp(opinfo, &op, &lp)) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
long sl = 0; long sl = 0;
int bracket_left = int bracket_left =
@ -600,7 +594,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator; lastw = separator;
} }
} else if (!Ignore_ops && } else if (!Ignore_ops &&
Arity == 2 && opinfo && IsInfixOp(opinfo, &op, &lp, Arity == 2 && opinfo && _YAP_IsInfixOp(opinfo, &op, &lp,
&rp) ) { &rp) ) {
Term tleft = ArgOfTerm(1, t); Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t); Term tright = ArgOfTerm(2, t);
@ -757,7 +751,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
} }
void void
plwrite(Term t, int (*mywrite) (int, int), int flags) _YAP_plwrite(Term t, int (*mywrite) (int, int), int flags)
/* term to be written */ /* term to be written */
/* consumer */ /* consumer */
/* write options */ /* write options */

309
C/ypsocks.c
View File

@ -24,7 +24,7 @@
#if USE_SOCKET #if USE_SOCKET
#if HAVE_UNISTD_H && !HAVE_WINSOCK2_H #if HAVE_UNISTD_H && !defined(__MINGW32__) && !_MSC_VER
#include <unistd.h> #include <unistd.h>
#endif #endif
#if STDC_HEADERS #if STDC_HEADERS
@ -33,7 +33,7 @@
#if HAVE_SYS_TYPES_H #if HAVE_SYS_TYPES_H
#include <sys/types.h> #include <sys/types.h>
#endif #endif
#if HAVE_SYS_TIME_H && !HAVE_WINSOCK2_H && !_MSC_VER #if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER
#include <sys/time.h> #include <sys/time.h>
#endif #endif
#if HAVE_IO_H #if HAVE_IO_H
@ -178,8 +178,6 @@
#define invalid_socket_fd(fd) (fd) < 0 #define invalid_socket_fd(fd) (fd) < 0
#endif #endif
int YP_sockets_io=0;
#define INTERFACE_PORT 8081 #define INTERFACE_PORT 8081
#define HOST "khome.ncc.up.pt" #define HOST "khome.ncc.up.pt"
@ -192,7 +190,8 @@ crash(char *msg)
exit(1); exit(1);
} }
void init_socks(char *host, long interface_port) void
_YAP_init_socks(char *host, long interface_port)
{ {
int s; int s;
int r; int r;
@ -231,57 +230,57 @@ void init_socks(char *host, long interface_port)
r = connect ( s, (struct sockaddr *) &soadr, sizeof(soadr)); r = connect ( s, (struct sockaddr *) &soadr, sizeof(soadr));
if (r<0) { if (r<0) {
YP_fprintf(YP_stderr,"connect failed with %d\n",r); fprintf(_YAP_stderr,"connect failed with %d\n",r);
crash("[ could not connect to interface]"); crash("[ could not connect to interface]");
} }
/* now reopen stdin stdout and stderr */ /* now reopen stdin stdout and stderr */
#if HAVE_DUP2 && !defined(__MINGW32__) #if HAVE_DUP2 && !defined(__MINGW32__)
if(dup2(s,0)<0) { if(dup2(s,0)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdin\n"); fprintf(_YAP_stderr,"could not dup2 stdin\n");
return; return;
} }
if(dup2(s,1)<0) { if(dup2(s,1)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdout\n"); fprintf(_YAP_stderr,"could not dup2 stdout\n");
return; return;
} }
if(dup2(s,2)<0) { if(dup2(s,2)<0) {
YP_fprintf(YP_stderr,"could not dup2 stderr\n"); fprintf(_YAP_stderr,"could not dup2 stderr\n");
return; return;
} }
#elif _MSC_VER || defined(__MINGW32__) #elif _MSC_VER || defined(__MINGW32__)
if(_dup2(s,0)<0) { if(_dup2(s,0)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdin\n"); fprintf(_YAP_stderr,"could not dup2 stdin\n");
return; return;
} }
if(_dup2(s,1)<0) { if(_dup2(s,1)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdout\n"); fprintf(_YAP_stderr,"could not dup2 stdout\n");
return; return;
} }
if(_dup2(s,2)<0) { if(_dup2(s,2)<0) {
YP_fprintf(YP_stderr,"could not dup2 stderr\n"); fprintf(_YAP_stderr,"could not dup2 stderr\n");
return; return;
} }
#else #else
if(dup2(s,0)<0) { if(dup2(s,0)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdin\n"); fprintf(_YAP_stderr,"could not dup2 stdin\n");
return; return;
} }
yp_iob[0].cnt = 0; yp_iob[0].cnt = 0;
yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ; yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ;
if(dup2(s,1)<0) { if(dup2(s,1)<0) {
YP_fprintf(YP_stderr,"could not dup2 stdout\n"); fprintf(_YAP_stderr,"could not dup2 stdout\n");
return; return;
} }
yp_iob[1].cnt = 0; yp_iob[1].cnt = 0;
yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE; yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE;
if(dup2(s,2)<0) { if(dup2(s,2)<0) {
YP_fprintf(YP_stderr,"could not dup2 stderr\n"); fprintf(_YAP_stderr,"could not dup2 stderr\n");
return; return;
} }
yp_iob[2].cnt = 0; yp_iob[2].cnt = 0;
yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE; yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE;
#endif #endif
YP_sockets_io = 1; _YAP_sockets_io = 1;
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
_close(s); _close(s);
#else #else
@ -301,27 +300,27 @@ p_socket(void)
Term out; Term out;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR,t1,"socket/4"); _YAP_Error(INSTANTIATION_ERROR,t1,"socket/4");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(t1)) { if (!IsAtomTerm(t1)) {
Error(TYPE_ERROR_ATOM,t1,"socket/4"); _YAP_Error(TYPE_ERROR_ATOM,t1,"socket/4");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket/4"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket/4");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(t2)) { if (!IsAtomTerm(t2)) {
Error(TYPE_ERROR_ATOM,t2,"socket/4"); _YAP_Error(TYPE_ERROR_ATOM,t2,"socket/4");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t3)) { if (IsVarTerm(t3)) {
Error(INSTANTIATION_ERROR,t3,"socket/4"); _YAP_Error(INSTANTIATION_ERROR,t3,"socket/4");
return(FALSE); return(FALSE);
} }
if (!IsIntTerm(t3)) { if (!IsIntTerm(t3)) {
Error(TYPE_ERROR_ATOM,t3,"socket/4"); _YAP_Error(TYPE_ERROR_ATOM,t3,"socket/4");
return(FALSE); return(FALSE);
} }
sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE; sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE;
@ -422,18 +421,18 @@ p_socket(void)
fd = socket(domain, type, protocol); fd = socket(domain, type, protocol);
if (invalid_socket_fd(fd)) { if (invalid_socket_fd(fd)) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket/4 (socket: %s)", strerror(socket_errno)); "socket/4 (socket: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket/4 (socket)"); "socket/4 (socket)");
#endif #endif
return(FALSE); return(FALSE);
} }
if (domain == AF_UNIX || domain == AF_LOCAL ) if (domain == AF_UNIX || domain == AF_LOCAL )
out = InitSocketStream(fd, new_socket, af_unix); out = _YAP_InitSocketStream(fd, new_socket, af_unix);
else if (domain == AF_INET ) else if (domain == AF_INET )
out = InitSocketStream(fd, new_socket, af_inet); out = _YAP_InitSocketStream(fd, new_socket, af_inet);
else { else {
/* ok, we currently don't support these sockets */ /* ok, we currently don't support these sockets */
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
@ -444,11 +443,11 @@ p_socket(void)
return(FALSE); return(FALSE);
} }
if (out == TermNil) return(FALSE); if (out == TermNil) return(FALSE);
return(unify(out,ARG4)); return(_YAP_unify(out,ARG4));
} }
Int Int
CloseSocket(int fd, socket_info status, socket_domain domain) _YAP_CloseSocket(int fd, socket_info status, socket_domain domain)
{ {
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
/* prevent further writing /* prevent further writing
@ -458,7 +457,7 @@ CloseSocket(int fd, socket_info status, socket_domain domain)
char bfr; char bfr;
if (shutdown(fd, 1) != 0) { if (shutdown(fd, 1) != 0) {
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close)"); "socket_close/1 (close)");
return(FALSE); return(FALSE);
} }
@ -468,7 +467,7 @@ CloseSocket(int fd, socket_info status, socket_domain domain)
/* prevent further reading /* prevent further reading
from the socket */ from the socket */
if (shutdown(fd, 0) < 0) { if (shutdown(fd, 0) < 0) {
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close)"); "socket_close/1 (close)");
return(FALSE); return(FALSE);
} }
@ -476,10 +475,10 @@ CloseSocket(int fd, socket_info status, socket_domain domain)
/* close the socket */ /* close the socket */
if (closesocket(fd) != 0) { if (closesocket(fd) != 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close: %s)", strerror(socket_errno)); "socket_close/1 (close: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close)"); "socket_close/1 (close)");
#endif #endif
} }
@ -488,10 +487,10 @@ CloseSocket(int fd, socket_info status, socket_domain domain)
status == client_socket) { status == client_socket) {
if (shutdown(fd,2) < 0) { if (shutdown(fd,2) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (shutdown: %s)", strerror(socket_errno)); "socket_close/1 (shutdown: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (shutdown)"); "socket_close/1 (shutdown)");
#endif #endif
return(FALSE); return(FALSE);
@ -499,10 +498,10 @@ CloseSocket(int fd, socket_info status, socket_domain domain)
} }
if (close(fd) != 0) { if (close(fd) != 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close: %s)", strerror(socket_errno)); "socket_close/1 (close: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_close/1 (close)"); "socket_close/1 (close)");
#endif #endif
#endif #endif
@ -517,10 +516,10 @@ p_socket_close(void)
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
int sno; int sno;
if ((sno = CheckSocketStream(t1, "socket_close/1")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_close/1")) < 0) {
return (FALSE); return (FALSE);
} }
CloseStream(sno); _YAP_CloseStream(sno);
return(TRUE); return(TRUE);
} }
@ -534,21 +533,21 @@ p_socket_bind(void)
socket_info status; socket_info status;
int fd; int fd;
if ((sno = CheckSocketStream(t1, "socket_bind/2")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_bind/2")) < 0) {
return (FALSE); return (FALSE);
} }
status = GetSocketStatus(sno); status = _YAP_GetSocketStatus(sno);
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
if (status != new_socket) { if (status != new_socket) {
/* ok, this should be an error, as you are trying to bind */ /* ok, this should be an error, as you are trying to bind */
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket_bind/2"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE); return(FALSE);
} }
if (!IsApplTerm(t2)) { if (!IsApplTerm(t2)) {
Error(DOMAIN_ERROR_STREAM,t2,"socket_bind/2"); _YAP_Error(DOMAIN_ERROR_STREAM,t2,"socket_bind/2");
return(FALSE); return(FALSE);
} }
fun = FunctorOfTerm(t2); fun = FunctorOfTerm(t2);
@ -560,17 +559,17 @@ p_socket_bind(void)
int len; int len;
if (IsVarTerm(taddr)) { if (IsVarTerm(taddr)) {
Error(INSTANTIATION_ERROR,t2,"socket_bind/2"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_bind/2");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(taddr)) { if (!IsAtomTerm(taddr)) {
Error(TYPE_ERROR_ATOM,taddr,"socket_bind/2"); _YAP_Error(TYPE_ERROR_ATOM,taddr,"socket_bind/2");
return(FALSE); return(FALSE);
} }
s = RepAtom(AtomOfTerm(taddr))->StrOfAE; s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
sock.sun_family = AF_UNIX; sock.sun_family = AF_UNIX;
if ((len = strlen(s)) > 107) /* hit me with a broomstick */ { if ((len = strlen(s)) > 107) /* hit me with a broomstick */ {
Error(DOMAIN_ERROR_STREAM,taddr,"socket_bind/2"); _YAP_Error(DOMAIN_ERROR_STREAM,taddr,"socket_bind/2");
return(FALSE); return(FALSE);
} }
sock.sun_family=AF_UNIX; sock.sun_family=AF_UNIX;
@ -580,15 +579,15 @@ p_socket_bind(void)
((size_t) (((struct sockaddr_un *) 0)->sun_path) + len)) ((size_t) (((struct sockaddr_un *) 0)->sun_path) + len))
< 0) { < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno)); "socket_bind/2 (bind: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (bind)"); "socket_bind/2 (bind)");
#endif #endif
return(FALSE); return(FALSE);
} }
UpdateSocketStream(sno, server_socket, af_unix); _YAP_UpdateSocketStream(sno, server_socket, af_unix);
return(TRUE); return(TRUE);
} else } else
#endif #endif
@ -604,16 +603,16 @@ p_socket_bind(void)
if (IsVarTerm(thost)) { if (IsVarTerm(thost)) {
saddr.sin_addr.s_addr = INADDR_ANY; saddr.sin_addr.s_addr = INADDR_ANY;
} else if (!IsAtomTerm(thost)) { } else if (!IsAtomTerm(thost)) {
Error(TYPE_ERROR_ATOM,thost,"socket_bind/2"); _YAP_Error(TYPE_ERROR_ATOM,thost,"socket_bind/2");
return(FALSE); return(FALSE);
} else { } else {
shost = RepAtom(AtomOfTerm(thost))->StrOfAE; shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
if((he=gethostbyname(shost))==NULL) { if((he=gethostbyname(shost))==NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (gethostbyname: %s)", strerror(socket_errno)); "socket_bind/2 (gethostbyname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (gethostbyname)"); "socket_bind/2 (gethostbyname)");
#endif #endif
return(FALSE); return(FALSE);
@ -629,10 +628,10 @@ p_socket_bind(void)
saddr.sin_family = AF_INET; saddr.sin_family = AF_INET;
if(bind(fd,(struct sockaddr *)&saddr, sizeof(saddr))==-1) { if(bind(fd,(struct sockaddr *)&saddr, sizeof(saddr))==-1) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (bind: %s)", strerror(socket_errno)); "socket_bind/2 (bind: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (bind)"); "socket_bind/2 (bind)");
#endif #endif
return(FALSE); return(FALSE);
@ -644,18 +643,18 @@ p_socket_bind(void)
Term t; Term t;
if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) { if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (getsockname: %s)", strerror(socket_errno)); "socket_bind/2 (getsockname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_bind/2 (getsockname)"); "socket_bind/2 (getsockname)");
#endif #endif
return(FALSE); return(FALSE);
} }
t = MkIntTerm(ntohs(saddr.sin_port)); t = MkIntTerm(ntohs(saddr.sin_port));
unify(ArgOfTermCell(2, t2),t); _YAP_unify(ArgOfTermCell(2, t2),t);
} }
UpdateSocketStream(sno, server_socket, af_inet); _YAP_UpdateSocketStream(sno, server_socket, af_inet);
return(TRUE); return(TRUE);
} else } else
return(FALSE); return(FALSE);
@ -673,20 +672,20 @@ p_socket_connect(void)
int flag; int flag;
Term out; Term out;
if ((sno = CheckSocketStream(t1, "socket_connect/3")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_connect/3")) < 0) {
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket_connect/3"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_connect/3");
return(FALSE); return(FALSE);
} }
if (!IsApplTerm(t2)) { if (!IsApplTerm(t2)) {
Error(DOMAIN_ERROR_STREAM,t2,"socket_connect/3"); _YAP_Error(DOMAIN_ERROR_STREAM,t2,"socket_connect/3");
return(FALSE); return(FALSE);
} }
fun = FunctorOfTerm(t2); fun = FunctorOfTerm(t2);
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
status = GetSocketStatus(sno); status = _YAP_GetSocketStatus(sno);
if (status != new_socket) { if (status != new_socket) {
/* ok, this should be an error, as you are trying to bind */ /* ok, this should be an error, as you are trying to bind */
return(FALSE); return(FALSE);
@ -699,17 +698,17 @@ p_socket_connect(void)
int len; int len;
if (IsVarTerm(taddr)) { if (IsVarTerm(taddr)) {
Error(INSTANTIATION_ERROR,t2,"socket_connect/3"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_connect/3");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(taddr)) { if (!IsAtomTerm(taddr)) {
Error(TYPE_ERROR_ATOM,taddr,"socket_connect/3"); _YAP_Error(TYPE_ERROR_ATOM,taddr,"socket_connect/3");
return(FALSE); return(FALSE);
} }
s = RepAtom(AtomOfTerm(taddr))->StrOfAE; s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
sock.sun_family = AF_UNIX; sock.sun_family = AF_UNIX;
if ((len = strlen(s)) > 107) /* beat me with a broomstick */ { if ((len = strlen(s)) > 107) /* beat me with a broomstick */ {
Error(DOMAIN_ERROR_STREAM,taddr,"socket_connect/3"); _YAP_Error(DOMAIN_ERROR_STREAM,taddr,"socket_connect/3");
return(FALSE); return(FALSE);
} }
sock.sun_family=AF_UNIX; sock.sun_family=AF_UNIX;
@ -719,15 +718,15 @@ p_socket_connect(void)
((size_t) (((struct sockaddr_un *) 0)->sun_path) + len))) ((size_t) (((struct sockaddr_un *) 0)->sun_path) + len)))
< 0) { < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (connect: %s)", strerror(socket_errno)); "socket_connect/3 (connect: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (connect)"); "socket_connect/3 (connect)");
#endif #endif
return(FALSE); return(FALSE);
} }
UpdateSocketStream(sno, client_socket, af_unix); _YAP_UpdateSocketStream(sno, client_socket, af_unix);
} else } else
#endif #endif
if (fun == FunctorAfInet) { if (fun == FunctorAfInet) {
@ -741,19 +740,19 @@ p_socket_connect(void)
memset((void *)&saddr,(int) 0, sizeof(saddr)); memset((void *)&saddr,(int) 0, sizeof(saddr));
if (IsVarTerm(thost)) { if (IsVarTerm(thost)) {
Error(INSTANTIATION_ERROR,thost,"socket_connect/3"); _YAP_Error(INSTANTIATION_ERROR,thost,"socket_connect/3");
return(FALSE); return(FALSE);
} else if (!IsAtomTerm(thost)) { } else if (!IsAtomTerm(thost)) {
Error(TYPE_ERROR_ATOM,thost,"socket_connect/3"); _YAP_Error(TYPE_ERROR_ATOM,thost,"socket_connect/3");
return(FALSE); return(FALSE);
} else { } else {
shost = RepAtom(AtomOfTerm(thost))->StrOfAE; shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
if((he=gethostbyname(shost))==NULL) { if((he=gethostbyname(shost))==NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (gethostbyname: %s)", strerror(socket_errno)); "socket_connect/3 (gethostbyname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (gethostbyname)"); "socket_connect/3 (gethostbyname)");
#endif #endif
return(FALSE); return(FALSE);
@ -761,10 +760,10 @@ p_socket_connect(void)
memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length); memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
} }
if (IsVarTerm(tport)) { if (IsVarTerm(tport)) {
Error(INSTANTIATION_ERROR,tport,"socket_connect/3"); _YAP_Error(INSTANTIATION_ERROR,tport,"socket_connect/3");
return(FALSE); return(FALSE);
} else if (!IsIntegerTerm(tport)) { } else if (!IsIntegerTerm(tport)) {
Error(TYPE_ERROR_INTEGER,tport,"socket_connect/3"); _YAP_Error(TYPE_ERROR_INTEGER,tport,"socket_connect/3");
return(FALSE); return(FALSE);
} else { } else {
port = (unsigned short int)IntegerOfTerm(tport); port = (unsigned short int)IntegerOfTerm(tport);
@ -776,10 +775,10 @@ p_socket_connect(void)
if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (char *) &ling, if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (char *) &ling,
sizeof(ling)) < 0) { sizeof(ling)) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno)); "socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (setsockopt_linger)"); "socket_connect/3 (setsockopt_linger)");
#endif #endif
return(FALSE); return(FALSE);
@ -787,19 +786,19 @@ p_socket_connect(void)
flag = connect(fd,(struct sockaddr *)&saddr, sizeof(saddr)); flag = connect(fd,(struct sockaddr *)&saddr, sizeof(saddr));
if(flag<0) { if(flag<0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (connect: %s)", strerror(socket_errno)); "socket_connect/3 (connect: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_connect/3 (connect)"); "socket_connect/3 (connect)");
#endif #endif
return(FALSE); return(FALSE);
} }
UpdateSocketStream(sno, client_socket, af_inet); _YAP_UpdateSocketStream(sno, client_socket, af_inet);
} else } else
return(FALSE); return(FALSE);
out = t1; out = t1;
return(unify(out,ARG3)); return(_YAP_unify(out,ARG3));
} }
static Int static Int
@ -812,34 +811,34 @@ p_socket_listen(void)
int fd; int fd;
Int j; Int j;
if ((sno = CheckSocketStream(t1, "socket_listen/2")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_listen/2")) < 0) {
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket_listen/2"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_listen/2");
return(FALSE); return(FALSE);
} }
if (!IsIntTerm(t2)) { if (!IsIntTerm(t2)) {
Error(TYPE_ERROR_INTEGER,t2,"socket_listen/2"); _YAP_Error(TYPE_ERROR_INTEGER,t2,"socket_listen/2");
return(FALSE); return(FALSE);
} }
j = IntOfTerm(t2); j = IntOfTerm(t2);
if (j < 0) { if (j < 0) {
Error(DOMAIN_ERROR_STREAM,t1,"socket_listen/2"); _YAP_Error(DOMAIN_ERROR_STREAM,t1,"socket_listen/2");
return(FALSE); return(FALSE);
} }
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
status = GetSocketStatus(sno); status = _YAP_GetSocketStatus(sno);
if (status != server_socket) { if (status != server_socket) {
/* ok, this should be an error, as you are trying to bind */ /* ok, this should be an error, as you are trying to bind */
return(FALSE); return(FALSE);
} }
if (listen(fd,j) < 0) { if (listen(fd,j) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_listen/2 (listen: %s)", strerror(socket_errno)); "socket_listen/2 (listen: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_listen/2 (listen)"); "socket_listen/2 (listen)");
#endif #endif
} }
@ -856,16 +855,16 @@ p_socket_accept(void)
int ofd, fd; int ofd, fd;
Term out; Term out;
if ((sno = CheckSocketStream(t1, "socket_accept/3")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_accept/3")) < 0) {
return (FALSE); return (FALSE);
} }
ofd = GetStreamFd(sno); ofd = _YAP_GetStreamFd(sno);
status = GetSocketStatus(sno); status = _YAP_GetSocketStatus(sno);
if (status != server_socket) { if (status != server_socket) {
/* ok, this should be an error, as you are trying to bind */ /* ok, this should be an error, as you are trying to bind */
return(FALSE); return(FALSE);
} }
domain = GetSocketDomain(sno); domain = _YAP_GetSocketDomain(sno);
#if HAVE_SYS_UN_H #if HAVE_SYS_UN_H
if (domain == af_unix) { if (domain == af_unix) {
char tmp[sizeof(struct sockaddr_un)+107]; /* hit me with a broomstick */ char tmp[sizeof(struct sockaddr_un)+107]; /* hit me with a broomstick */
@ -876,15 +875,15 @@ p_socket_accept(void)
memset((void *)&caddr,(int) 0, len); memset((void *)&caddr,(int) 0, len);
if ((fd=accept(ofd, (struct sockaddr *)tmp, &len)) < 0) { if ((fd=accept(ofd, (struct sockaddr *)tmp, &len)) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (accept: %s)", strerror(socket_errno)); "socket_accept/3 (accept: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (accept)"); "socket_accept/3 (accept)");
#endif #endif
} }
/* ignore 2nd argument */ /* ignore 2nd argument */
out = InitSocketStream(fd, server_session_socket, af_unix ); out = _YAP_InitSocketStream(fd, server_session_socket, af_unix );
} else } else
#endif #endif
if (domain == af_inet) { if (domain == af_inet) {
@ -897,31 +896,31 @@ p_socket_accept(void)
memset((void *)&caddr,(int) 0, sizeof(caddr)); memset((void *)&caddr,(int) 0, sizeof(caddr));
if (invalid_socket_fd(fd=accept(ofd, (struct sockaddr *)&caddr, &len))) { if (invalid_socket_fd(fd=accept(ofd, (struct sockaddr *)&caddr, &len))) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (accept: %s)", strerror(socket_errno)); "socket_accept/3 (accept: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (accept)"); "socket_accept/3 (accept)");
#endif #endif
return(FALSE); return(FALSE);
} }
if ((s = inet_ntoa(caddr.sin_addr)) == NULL) { if ((s = inet_ntoa(caddr.sin_addr)) == NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno)); "socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_accept/3 (inet_ntoa)"); "socket_accept/3 (inet_ntoa)");
#endif #endif
} }
tcli = MkAtomTerm(LookupAtom(s)); tcli = MkAtomTerm(_YAP_LookupAtom(s));
if (!unify(ARG2,tcli)) if (!_YAP_unify(ARG2,tcli))
return(FALSE); return(FALSE);
out = InitSocketStream(fd, server_session_socket, af_inet ); out = _YAP_InitSocketStream(fd, server_session_socket, af_inet );
} else } else
return(FALSE); return(FALSE);
if (out == TermNil) return(FALSE); if (out == TermNil) return(FALSE);
return(unify(out,ARG3)); return(_YAP_unify(out,ARG3));
} }
static Int static Int
@ -936,15 +935,15 @@ p_socket_buffering(void)
unsigned int bufsize, len; unsigned int bufsize, len;
int sno; int sno;
if ((sno = CheckSocketStream(t1, "socket_buffering/4")) < 0) { if ((sno = _YAP_CheckSocketStream(t1, "socket_buffering/4")) < 0) {
return (FALSE); return (FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket_buffering/4"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_buffering/4");
return(FALSE); return(FALSE);
} }
if (!IsAtomTerm(t2)) { if (!IsAtomTerm(t2)) {
Error(TYPE_ERROR_ATOM,t2,"socket_buffering/4"); _YAP_Error(TYPE_ERROR_ATOM,t2,"socket_buffering/4");
return(FALSE); return(FALSE);
} }
mode = AtomOfTerm(t2); mode = AtomOfTerm(t2);
@ -953,28 +952,28 @@ p_socket_buffering(void)
else if (mode == AtomWrite) else if (mode == AtomWrite)
writing = TRUE; writing = TRUE;
else { else {
Error(DOMAIN_ERROR_IO_MODE,t2,"socket_buffering/4"); _YAP_Error(DOMAIN_ERROR_IO_MODE,t2,"socket_buffering/4");
return(FALSE); return(FALSE);
} }
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
if (writing) { if (writing) {
getsockopt(fd, SOL_SOCKET, SO_SNDBUF, &bufsize, &len); getsockopt(fd, SOL_SOCKET, SO_SNDBUF, &bufsize, &len);
} else { } else {
getsockopt(fd, SOL_SOCKET, SO_RCVBUF, &bufsize, &len); getsockopt(fd, SOL_SOCKET, SO_RCVBUF, &bufsize, &len);
} }
if (!unify(ARG3,MkIntegerTerm(bufsize))) if (!_YAP_unify(ARG3,MkIntegerTerm(bufsize)))
return(FALSE); return(FALSE);
if (IsVarTerm(t4)) { if (IsVarTerm(t4)) {
bufsize = BUFSIZ; bufsize = BUFSIZ;
} else { } else {
Int siz; Int siz;
if (!IsIntegerTerm(t4)) { if (!IsIntegerTerm(t4)) {
Error(TYPE_ERROR_INTEGER,t4,"socket_buffering/4"); _YAP_Error(TYPE_ERROR_INTEGER,t4,"socket_buffering/4");
return(FALSE); return(FALSE);
} }
siz = IntegerOfTerm(t4); siz = IntegerOfTerm(t4);
if (siz < 0) { if (siz < 0) {
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t4,"socket_buffering/4"); _YAP_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t4,"socket_buffering/4");
return(FALSE); return(FALSE);
} }
bufsize = siz; bufsize = siz;
@ -998,8 +997,8 @@ select_out_list(Term t1, fd_set *readfds_ptr)
Term next = select_out_list(TailOfTerm(t1), readfds_ptr); Term next = select_out_list(TailOfTerm(t1), readfds_ptr);
Term Head = HeadOfTerm(t1); Term Head = HeadOfTerm(t1);
sno = CheckIOStream(Head,"stream_select/5"); sno = _YAP_CheckIOStream(Head,"stream_select/5");
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
if (FD_ISSET(fd, readfds_ptr)) if (FD_ISSET(fd, readfds_ptr))
return(MkPairTerm(Head,next)); return(MkPairTerm(Head,next));
else else
@ -1025,27 +1024,27 @@ p_socket_select(void)
Term tout = TermNil, ti, Head; Term tout = TermNil, ti, Head;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR,t1,"socket_select/5"); _YAP_Error(INSTANTIATION_ERROR,t1,"socket_select/5");
return(FALSE); return(FALSE);
} }
if (!IsPairTerm(t1)) { if (!IsPairTerm(t1)) {
Error(TYPE_ERROR_LIST,t1,"socket_select/5"); _YAP_Error(TYPE_ERROR_LIST,t1,"socket_select/5");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"socket_select/5"); _YAP_Error(INSTANTIATION_ERROR,t2,"socket_select/5");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(t2)) { if (!IsIntegerTerm(t2)) {
Error(TYPE_ERROR_INTEGER,t2,"socket_select/5"); _YAP_Error(TYPE_ERROR_INTEGER,t2,"socket_select/5");
return(FALSE); return(FALSE);
} }
if (IsVarTerm(t3)) { if (IsVarTerm(t3)) {
Error(INSTANTIATION_ERROR,t3,"socket_select/5"); _YAP_Error(INSTANTIATION_ERROR,t3,"socket_select/5");
return(FALSE); return(FALSE);
} }
if (!IsIntegerTerm(t3)) { if (!IsIntegerTerm(t3)) {
Error(TYPE_ERROR_INTEGER,t3,"socket_select/5"); _YAP_Error(TYPE_ERROR_INTEGER,t3,"socket_select/5");
return(FALSE); return(FALSE);
} }
FD_ZERO(&readfds); FD_ZERO(&readfds);
@ -1062,10 +1061,10 @@ p_socket_select(void)
int sno; int sno;
Head = HeadOfTerm(ti); Head = HeadOfTerm(ti);
sno = CheckIOStream(Head,"stream_select/5"); sno = _YAP_CheckIOStream(Head,"stream_select/5");
if (sno < 0) if (sno < 0)
return(FALSE); return(FALSE);
fd = GetStreamFd(sno); fd = _YAP_GetStreamFd(sno);
FD_SET(fd, &readfds); FD_SET(fd, &readfds);
if (fd > fdmax) if (fd > fdmax)
fdmax = fd; fdmax = fd;
@ -1084,16 +1083,16 @@ p_socket_select(void)
/* do the real work */ /* do the real work */
if (select(fdmax+1, &readfds, &writefds, &exceptfds, ptime) < 0) { if (select(fdmax+1, &readfds, &writefds, &exceptfds, ptime) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_select/5 (select: %s)", strerror(socket_errno)); "socket_select/5 (select: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"socket_select/5 (select)"); "socket_select/5 (select)");
#endif #endif
} }
tout = select_out_list(t1, &readfds); tout = select_out_list(t1, &readfds);
/* we're done, just pass the info back */ /* we're done, just pass the info back */
return(unify(ARG4,tout)); return(_YAP_unify(ARG4,tout));
} }
@ -1103,16 +1102,16 @@ p_current_host(void) {
Term t1 = Deref(ARG1), out; Term t1 = Deref(ARG1), out;
if (!IsVarTerm(t1) && !IsAtomTerm(t1)) { if (!IsVarTerm(t1) && !IsAtomTerm(t1)) {
Error(TYPE_ERROR_ATOM,t1,"current_host/2"); _YAP_Error(TYPE_ERROR_ATOM,t1,"current_host/2");
return(FALSE); return(FALSE);
} }
name = oname; name = oname;
if (gethostname(name, sizeof(oname)) < 0) { if (gethostname(name, sizeof(oname)) < 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"current_host/2 (gethostname: %s)", strerror(socket_errno)); "current_host/2 (gethostname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"current_host/2 (gethostname)"); "current_host/2 (gethostname)");
#endif #endif
return(FALSE); return(FALSE);
@ -1123,10 +1122,10 @@ p_current_host(void) {
/* not a fully qualified name, ask the name server */ /* not a fully qualified name, ask the name server */
if((he=gethostbyname(name))==NULL) { if((he=gethostbyname(name))==NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"current_host/2 (gethostbyname: %s)", strerror(socket_errno)); "current_host/2 (gethostbyname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"current_host/2 (gethostbyname)"); "current_host/2 (gethostbyname)");
#endif #endif
return(FALSE); return(FALSE);
@ -1146,7 +1145,7 @@ p_current_host(void) {
else { else {
int isize = strlen(sin); int isize = strlen(sin);
if (isize >= 256) { if (isize >= 256) {
Error(SYSTEM_ERROR, ARG1, _YAP_Error(SYSTEM_ERROR, ARG1,
"current_host/2 (input longer than longest FAQ host name)"); "current_host/2 (input longer than longest FAQ host name)");
return(FALSE); return(FALSE);
} }
@ -1159,8 +1158,8 @@ p_current_host(void) {
#endif #endif
} }
} else { } else {
out = MkAtomTerm(LookupAtom(name)); out = MkAtomTerm(_YAP_LookupAtom(name));
return(unify(ARG1,out)); return(_YAP_unify(ARG1,out));
} }
} }
@ -1174,62 +1173,62 @@ p_hostname_address(void) {
if (!IsVarTerm(t1)) { if (!IsVarTerm(t1)) {
if (!IsAtomTerm(t1)) { if (!IsAtomTerm(t1)) {
Error(TYPE_ERROR_ATOM,t1,"hostname_address/2"); _YAP_Error(TYPE_ERROR_ATOM,t1,"hostname_address/2");
return(FALSE); return(FALSE);
} else tin = t1; } else tin = t1;
} else if (IsVarTerm(t2)) { } else if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t1,"hostname_address/5"); _YAP_Error(INSTANTIATION_ERROR,t1,"hostname_address/5");
return(FALSE); return(FALSE);
} else if (!IsAtomTerm(t2)) { } else if (!IsAtomTerm(t2)) {
Error(TYPE_ERROR_ATOM,t2,"hostname_address/2"); _YAP_Error(TYPE_ERROR_ATOM,t2,"hostname_address/2");
return(FALSE); return(FALSE);
} else tin = t2; } else tin = t2;
s = RepAtom(AtomOfTerm(tin))->StrOfAE; s = RepAtom(AtomOfTerm(tin))->StrOfAE;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
if ((he = gethostbyaddr(s, strlen(s), AF_INET)) == NULL) { if ((he = gethostbyaddr(s, strlen(s), AF_INET)) == NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"hostname_address/2 (gethostbyname)"); "hostname_address/2 (gethostbyname)");
#endif #endif
} }
out = MkAtomTerm(LookupAtom((char *)(he->h_name))); out = MkAtomTerm(_YAP_LookupAtom((char *)(he->h_name)));
return(unify(out, ARG1)); return(_YAP_unify(out, ARG1));
} else { } else {
struct in_addr adr; struct in_addr adr;
if ((he = gethostbyname(s)) == NULL) { if ((he = gethostbyname(s)) == NULL) {
#if HAVE_STRERROR #if HAVE_STRERROR
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno));
#else #else
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"hostname_address/2 (gethostbyname)"); "hostname_address/2 (gethostbyname)");
#endif #endif
} }
memcpy((char *) &adr, memcpy((char *) &adr,
(char *) he->h_addr_list[0], (size_t) he->h_length); (char *) he->h_addr_list[0], (size_t) he->h_length);
out = MkAtomTerm(LookupAtom(inet_ntoa(adr))); out = MkAtomTerm(_YAP_LookupAtom(inet_ntoa(adr)));
return(unify(out, ARG2)); return(_YAP_unify(out, ARG2));
} }
} }
#endif #endif
void void
InitSockets(void) _YAP_InitSockets(void)
{ {
#ifdef USE_SOCKET #ifdef USE_SOCKET
InitCPred("socket", 4, p_socket, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket", 4, p_socket, SafePredFlag|SyncPredFlag);
InitCPred("socket_close", 1, p_socket_close, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket_close", 1, p_socket_close, SafePredFlag|SyncPredFlag);
InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag|SyncPredFlag);
InitCPred("socket_connect", 3, p_socket_connect, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket_connect", 3, p_socket_connect, SafePredFlag|SyncPredFlag);
InitCPred("socket_listen", 2, p_socket_listen, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket_listen", 2, p_socket_listen, SafePredFlag|SyncPredFlag);
InitCPred("socket_accept", 3, p_socket_accept, SafePredFlag|SyncPredFlag); _YAP_InitCPred("socket_accept", 3, p_socket_accept, SafePredFlag|SyncPredFlag);
InitCPred("$socket_buffering", 4, p_socket_buffering, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$socket_buffering", 4, p_socket_buffering, SafePredFlag|SyncPredFlag);
InitCPred("$socket_select", 4, p_socket_select, SafePredFlag|SyncPredFlag); _YAP_InitCPred("$socket_select", 4, p_socket_select, SafePredFlag|SyncPredFlag);
InitCPred("current_host", 1, p_current_host, SafePredFlag); _YAP_InitCPred("current_host", 1, p_current_host, SafePredFlag);
InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag); _YAP_InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag);
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
{ {
WSADATA info; WSADATA info;

2
C/ypstdio.c
View File

@ -128,7 +128,7 @@ YP_fputs(char *s, YP_FILE *f)
{ {
int count = 0; int count = 0;
while (*s) { while (*s) {
if (YP_putc(*s++,f)<0) return -1; if (putc(*s++,f)<0) return -1;
++count; ++count;
} }
return count; return count;

12
H/Foreign.h
View File

@ -80,8 +80,6 @@
#endif #endif
#endif /* LOAD_DYLD */ #endif /* LOAD_DYLD */
extern char LoadMsg[];
#define LOAD_SUCCEEDED 0 #define LOAD_SUCCEEDED 0
#define LOAD_FAILLED -1 #define LOAD_FAILLED -1
@ -105,11 +103,11 @@ typedef void (*YapInitProc)(void);
#define STD_PROTO(F,A) F A #define STD_PROTO(F,A) F A
#endif #endif
void STD_PROTO(YAP_FindExecutable,(char *)); void STD_PROTO(_YAP_FindExecutable,(char *));
Int STD_PROTO(LoadForeign,(StringList, StringList, char *, YapInitProc *)); Int STD_PROTO(_YAP_LoadForeign,(StringList, StringList, char *, YapInitProc *));
Int STD_PROTO(ReLoadForeign,(StringList, StringList, char *, YapInitProc *)); Int STD_PROTO(_YAP_ReLoadForeign,(StringList, StringList, char *, YapInitProc *));
void STD_PROTO(ReOpenLoadForeign,(void)); void STD_PROTO(_YAP_ReOpenLoadForeign,(void));
void STD_PROTO(ShutdownLoadForeign,(void)); void STD_PROTO(_YAP_ShutdownLoadForeign,(void));

72
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.33 2002-10-21 22:52:36 vsc Exp $ * * version: $Id: Heap.h,v 1.34 2002-11-11 17:37:58 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -121,8 +121,11 @@ typedef struct various_codes {
struct pred_entry *creep_code; struct pred_entry *creep_code;
struct pred_entry *undef_code; struct pred_entry *undef_code;
struct pred_entry *spy_code; struct pred_entry *spy_code;
int profiling; int system_profiling;
int call_counting; int system_call_counting;
int compiler_optimizer_on;
int compiler_compile_mode;
struct pred_entry *compiler_current_pred;
AtomHashEntry invisiblechain; AtomHashEntry invisiblechain;
OPCODE dummycode; OPCODE dummycode;
Int maxdepth, maxlist; Int maxdepth, maxlist;
@ -293,14 +296,40 @@ typedef struct various_codes {
struct pred_entry *pred_handle_throw; struct pred_entry *pred_handle_throw;
struct array_entry *dyn_array_list; struct array_entry *dyn_array_list;
struct DB_STRUCT *db_erased_marker; struct DB_STRUCT *db_erased_marker;
struct stream_desc *yap_streams;
#ifdef DEBUG
int debugger_output_msg;
#endif
UInt n_of_file_aliases; UInt n_of_file_aliases;
UInt sz_of_file_aliases; UInt sz_of_file_aliases;
struct AliasDescS * file_aliases; struct AliasDescS * file_aliases;
struct reduction_counters call_counters; struct reduction_counters call_counters;
void *foreign_code_loaded;
char *yap_lib_dir; char *yap_lib_dir;
Agc_hook agc_hook; Agc_hook agc_hook;
void *foreign_code_loaded;
ADDR foreign_code_base;
ADDR foreign_code_top;
ADDR foreign_code_max;
int parser_error_style; int parser_error_style;
char *compiler_freep;
char *compiler_freep0;
struct PSEUDO *compiler_cpc;
struct PSEUDO *compiler_CodeStart;
struct PSEUDO *compiler_icpc;
struct PSEUDO *compiler_BlobsStart;
int compiler_clause_mask;
CELL compiler_clause_store;
int *compiler_label_offset;
UInt i_pred_arity;
int compiler_profiling;
int compiler_call_counting;
/********* whether we should try to compile array references ******************/
int compiler_compile_arrays;
/*
PREG just before we enter $spy. We use that to find out the clause which
was calling the debugged goal.
*/
yamop *debugger_p_before_spy;
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
struct global_data global; struct global_data global;
struct local_data remote[MAX_WORKERS]; struct local_data remote[MAX_WORKERS];
@ -312,7 +341,7 @@ typedef struct various_codes {
#define HeapUsed heap_regs->heap_used #define HeapUsed heap_regs->heap_used
#define HeapMax heap_regs->heap_max #define HeapMax heap_regs->heap_max
#define HeapTop heap_regs->heap_top #define HeapTop heap_regs->heap_top
#ifdef YAPOR #ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT heap_regs->seq_def #define SEQUENTIAL_IS_DEFAULT heap_regs->seq_def
#define GETWORK (&(heap_regs->getworkcode )) #define GETWORK (&(heap_regs->getworkcode ))
@ -339,8 +368,8 @@ typedef struct various_codes {
#if USE_THREADED_CODE #if USE_THREADED_CODE
#define OP_RTABLE heap_regs->op_rtable #define OP_RTABLE heap_regs->op_rtable
#endif #endif
#define PROFILING heap_regs->profiling #define PROFILING heap_regs->system_profiling
#define CALL_COUNTING heap_regs->call_counting #define CALL_COUNTING heap_regs->system_call_counting
#define UPDATE_MODE heap_regs->update_mode #define UPDATE_MODE heap_regs->update_mode
#define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code #define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code
#define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code #define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code
@ -359,8 +388,8 @@ typedef struct various_codes {
#define INT_BB_KEYS heap_regs->IntBBKeys #define INT_BB_KEYS heap_regs->IntBBKeys
#define CharConversionTable heap_regs->char_conversion_table #define CharConversionTable heap_regs->char_conversion_table
#define CharConversionTable2 heap_regs->char_conversion_table2 #define CharConversionTable2 heap_regs->char_conversion_table2
#define NUMBER_OF_CPREDS heap_regs->number_of_cpreds #define NumberOfCPreds heap_regs->number_of_cpreds
#define NUMBER_OF_CMPFUNCS heap_regs->number_of_cmpfuncs #define NumberOfCmpFuncs heap_regs->number_of_cmpfuncs
#define ModuleName heap_regs->module_name #define ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred #define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module #define PrimitivesModule heap_regs->primitives_module
@ -491,6 +520,8 @@ typedef struct various_codes {
#define PredHandleThrow heap_regs->pred_handle_throw #define PredHandleThrow heap_regs->pred_handle_throw
#define DynArrayList heap_regs->dyn_array_list #define DynArrayList heap_regs->dyn_array_list
#define DBErasedMarker heap_regs->db_erased_marker #define DBErasedMarker heap_regs->db_erased_marker
#define Stream heap_regs->yap_streams
#define output_msg heap_regs->debugger_output_msg
#define NOfFileAliases heap_regs->n_of_file_aliases #define NOfFileAliases heap_regs->n_of_file_aliases
#define SzOfFileAliases heap_regs->sz_of_file_aliases #define SzOfFileAliases heap_regs->sz_of_file_aliases
#define FileAliases heap_regs->file_aliases #define FileAliases heap_regs->file_aliases
@ -500,10 +531,31 @@ typedef struct various_codes {
#define ReductionsCounterOn heap_regs->call_counters.reductions_on #define ReductionsCounterOn heap_regs->call_counters.reductions_on
#define PredEntriesCounterOn heap_regs->call_counters.reductions_retries_on #define PredEntriesCounterOn heap_regs->call_counters.reductions_retries_on
#define RetriesCounterOn heap_regs->call_counters.retries_on #define RetriesCounterOn heap_regs->call_counters.retries_on
#define ForeignCodeLoaded heap_regs->foreign_code_loaded
#define Yap_LibDir heap_regs->yap_lib_dir #define Yap_LibDir heap_regs->yap_lib_dir
#define AGCHook heap_regs->agc_hook #define AGCHook heap_regs->agc_hook
#define ParserErrorStyle heap_regs->parser_error_style #define ParserErrorStyle heap_regs->parser_error_style
#define freep heap_regs->compiler_freep
#define freep0 heap_regs->compiler_freep0
#define cpc heap_regs->compiler_cpc
#define CodeStart heap_regs->compiler_CodeStart
#define icpc heap_regs->compiler_icpc
#define BlobsStart heap_regs->compiler_BlobsStart
#define clause_mask heap_regs->compiler_clause_mask
#define clause_store heap_regs->compiler_clause_store
#define label_offset heap_regs->compiler_label_offset
#define IPredArity heap_regs->i_pred_arity
#define profiling heap_regs->compiler_profiling
#define call_counting heap_regs->compiler_call_counting
#define compile_arrays heap_regs->compiler_compile_arrays
#define optimizer_on heap_regs->compiler_optimizer_on
#define compile_mode heap_regs->compiler_compile_mode
#define P_before_spy heap_regs->debugger_p_before_spy
#define CurrentPred heap_regs->compiler_current_pred
#define ForeignCodeBase heap_regs->foreign_code_base;
#define ForeignCodeTop heap_regs->foreign_code_top;
#define ForeignCodeMax heap_regs->foreign_code_max;
#define ForeignCodeLoaded heap_regs->foreign_code_loaded
#define ParserErrorStyle heap_regs->parser_error_style
#define DeadClauses heap_regs->dead_clauses #define DeadClauses heap_regs->dead_clauses
#define SizeOfOverflow heap_regs->size_of_overflow #define SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime #define LastWtimePtr heap_regs->last_wtime

283
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h * * File: Regs.h *
* mods: * * mods: *
* comments: YAP abstract machine registers * * comments: YAP abstract machine registers *
* version: $Id: Regs.h,v 1.16 2002-10-21 22:14:28 vsc Exp $ * * version: $Id: Regs.h,v 1.17 2002-11-11 17:37:58 vsc Exp $ *
*************************************************************************/ *************************************************************************/
@ -132,70 +132,73 @@ typedef struct
REGSTORE; REGSTORE;
extern REGSTORE *regp; extern REGSTORE *_YAP_regp;
#if !PUSH_X #if !PUSH_X
/* keep X as a global variable */ /* keep X as a global variable */
Term XREGS[MaxTemps]; /* 29 */ Term _YAP_XREGS[MaxTemps]; /* 29 */
#define XREGS _YAP_XREGS
#endif #endif
#define REGS (*regp) #define _YAP_REGS (*_YAP_regp)
#else /* PUSH_REGS */ #else /* PUSH_REGS */
Term X[MaxTemps]; /* 29 */ Term X[MaxTemps]; /* 29 */
#define XREGS REGS.X #define XREGS _YAP_REGS.X
} }
REGSTORE; REGSTORE;
extern REGSTORE REGS; extern REGSTORE _YAP_REGS;
#endif /* PUSH_REGS */ #endif /* PUSH_REGS */
#define MinTrailGap (sizeof(CELL)*1024) #define MinTrailGap (sizeof(CELL)*1024)
#define MinHeapGap (sizeof(CELL)*4096) #define MinHeapGap (sizeof(CELL)*4096)
#define MinStackGap (sizeof(CELL)*8*1024) #define MinStackGap (sizeof(CELL)*8*1024)
extern int stack_overflows; extern int _YAP_stack_overflows;
#define ENV REGS.ENV_ /* current environment */ #define ENV _YAP_REGS.ENV_ /* current environment */
#define ASP REGS.ASP_ /* top of local stack */ #define ASP _YAP_REGS.ASP_ /* top of local stack */
#define H0 REGS.H0_ /* base of heap (global) stack */ #define H0 _YAP_REGS.H0_ /* base of heap (global) stack */
#define LCL0 REGS.LCL0_ /* local stack base */ #define LCL0 _YAP_REGS.LCL0_ /* local stack base */
#if defined(__GNUC__) && defined(sparc) && !defined(__NetBSD__) #if defined(__GNUC__) && defined(sparc) && !defined(__NetBSD__)
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
#define YENV REGS.YENV_ /* current environment (may differ from ENV)*/ #define YENV _YAP_REGS.YENV_ /* current environment (may differ from ENV)*/
#define S REGS.S_ /* structure pointer */ #define S _YAP_REGS.S_ /* structure pointer */
register CELL *H asm ("g6"); register CELL *H asm ("g6");
register tr_fr_ptr TR asm ("g7"); register tr_fr_ptr TR asm ("g7");
#ifdef __svr4__ #ifdef __svr4__
register choiceptr B asm ("g5"); register choiceptr B asm ("g5");
#else #else
#define B REGS.B_ /* latest choice point */ #define B _YAP_REGS.B_ /* latest choice point */
#endif #endif
#define CP REGS.CP_ /* continuation program counter */ #define CP _YAP_REGS.CP_ /* continuation program counter */
#define HB REGS.HB_ /* heap (global) stack top at time of latest c.p. */ #define HB _YAP_REGS.HB_ /* heap (global) stack top at time of latest c.p. */
#define CreepFlag REGS.CreepFlag_ #define CreepFlag _YAP_REGS.CreepFlag_
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
#ifdef __svr4__ #ifdef __svr4__
REGS.B_ = B; _YAP_REGS.B_ = B;
#endif #endif
} }
EXTERN inline void restore_machine_regs(void) { EXTERN inline void restore_machine_regs(void) {
H = REGS.H_; H = _YAP_REGS.H_;
TR = REGS.TR_; TR = _YAP_REGS.TR_;
#ifdef __svr4__ #ifdef __svr4__
B = REGS.B_; B = _YAP_REGS.B_;
#endif #endif
} }
@ -212,11 +215,11 @@ EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
EXTERN inline void save_H(void) { EXTERN inline void save_H(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
} }
EXTERN inline void restore_H(void) { EXTERN inline void restore_H(void) {
H = REGS.H_; H = _YAP_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = H; restore_H()
@ -225,13 +228,13 @@ EXTERN inline void restore_H(void) {
EXTERN inline void save_B(void) { EXTERN inline void save_B(void) {
#ifdef __svr4__ #ifdef __svr4__
REGS.B_ = B; _YAP_REGS.B_ = B;
#endif #endif
} }
EXTERN inline void restore_B(void) { EXTERN inline void restore_B(void) {
#ifdef __svr4__ #ifdef __svr4__
B = REGS.B_; B = _YAP_REGS.B_;
#endif #endif
} }
@ -247,8 +250,8 @@ EXTERN inline void restore_B(void) {
#elif defined(__GNUC__) && defined(__alpha) #elif defined(__GNUC__) && defined(__alpha)
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
#define YENV REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV _YAP_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("$9"); register CELL *H asm ("$9");
register CELL *HB asm ("$10"); register CELL *HB asm ("$10");
register choiceptr B asm ("$11"); register choiceptr B asm ("$11");
@ -257,7 +260,7 @@ register CELL *S asm ("$13");
register tr_fr_ptr TR asm ("$14"); register tr_fr_ptr TR asm ("$14");
/* gcc+debug chokes if $15 is in use on alphas */ /* gcc+debug chokes if $15 is in use on alphas */
#ifdef DEBUG #ifdef DEBUG
#define CreepFlag REGS.CreepFlag_ #define CreepFlag _YAP_REGS.CreepFlag_
#else #else
register CELL CreepFlag asm ("$15"); register CELL CreepFlag asm ("$15");
#endif #endif
@ -265,25 +268,25 @@ register CELL CreepFlag asm ("$15");
/* Interface with foreign code, make sure the foreign code sees all the /* Interface with foreign code, make sure the foreign code sees all the
registers the way they used to be */ registers the way they used to be */
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
REGS.HB_ = HB; _YAP_REGS.HB_ = HB;
REGS.B_ = B; _YAP_REGS.B_ = B;
REGS.CP_ = CP; _YAP_REGS.CP_ = CP;
#ifndef DEBUG #ifndef DEBUG
REGS.CreepFlag_ = CreepFlag; _YAP_REGS.CreepFlag_ = CreepFlag;
#endif #endif
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_machine_regs(void) { EXTERN inline void restore_machine_regs(void) {
H = REGS.H_; H = _YAP_REGS.H_;
HB = REGS.HB_; HB = _YAP_REGS.HB_;
B = REGS.B_; B = _YAP_REGS.B_;
CP = REGS.CP_; CP = _YAP_REGS.CP_;
#ifndef DEBUG #ifndef DEBUG
CreepFlag = REGS.CreepFlag_; CreepFlag = _YAP_REGS.CreepFlag_;
#endif #endif
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
@ -305,11 +308,11 @@ EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
EXTERN inline void save_H(void) { EXTERN inline void save_H(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
} }
EXTERN inline void restore_H(void) { EXTERN inline void restore_H(void) {
H = REGS.H_; H = _YAP_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = H; restore_H()
@ -317,11 +320,11 @@ EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); H = BK_H
EXTERN inline void save_B(void) { EXTERN inline void save_B(void) {
REGS.B_ = B; _YAP_REGS.B_ = B;
} }
EXTERN inline void restore_B(void) { EXTERN inline void restore_B(void) {
B = REGS.B_; B = _YAP_REGS.B_;
} }
#define BACKUP_B() choiceptr BK_B = B; restore_B() #define BACKUP_B() choiceptr BK_B = B; restore_B()
@ -329,17 +332,17 @@ EXTERN inline void restore_B(void) {
#define RECOVER_B() save_B(); B = BK_B #define RECOVER_B() save_B(); B = BK_B
EXTERN inline void save_TR(void) { EXTERN inline void save_TR(void) {
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_TR(void) { EXTERN inline void restore_TR(void) {
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#elif defined(__GNUC__) && defined(mips) #elif defined(__GNUC__) && defined(mips)
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
#define YENV REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV _YAP_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("$16"); register CELL *H asm ("$16");
register CELL *HB asm ("$17"); register CELL *HB asm ("$17");
register choiceptr B asm ("$18"); register choiceptr B asm ("$18");
@ -349,21 +352,21 @@ register CELL CreepFlag asm ("$21");
register tr_fr_ptr TR asm ("$22"); register tr_fr_ptr TR asm ("$22");
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
REGS.HB_ = HB; _YAP_REGS.HB_ = HB;
REGS.B_ = B; _YAP_REGS.B_ = B;
REGS.CP_ = CP; _YAP_REGS.CP_ = CP;
REGS.CreepFlag_ = CreepFlag; _YAP_REGS.CreepFlag_ = CreepFlag;
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_machine_regs(void) { EXTERN inline void restore_machine_regs(void) {
H = REGS.H_; H = _YAP_REGS.H_;
HB = REGS.HB_; HB = _YAP_REGS.HB_;
B = REGS.B_; B = _YAP_REGS.B_;
CP = REGS.CP_; CP = _YAP_REGS.CP_;
CreepFlag = REGS.CreepFlag_; CreepFlag = _YAP_REGS.CreepFlag_;
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
@ -385,11 +388,11 @@ EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
EXTERN inline void save_H(void) { EXTERN inline void save_H(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
} }
EXTERN inline void restore_H(void) { EXTERN inline void restore_H(void) {
H = REGS.H_; H = _YAP_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = H; restore_H()
@ -397,11 +400,11 @@ EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); H = BK_H
EXTERN inline void save_B(void) { EXTERN inline void save_B(void) {
REGS.B_ = B; _YAP_REGS.B_ = B;
} }
EXTERN inline void restore_B(void) { EXTERN inline void restore_B(void) {
B = REGS.B_; B = _YAP_REGS.B_;
} }
#define BACKUP_B() choiceptr BK_B = B; restore_B() #define BACKUP_B() choiceptr BK_B = B; restore_B()
@ -410,8 +413,8 @@ EXTERN inline void restore_B(void) {
#elif defined(__GNUC__) && defined(hppa) #elif defined(__GNUC__) && defined(hppa)
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
#define YENV REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV _YAP_REGS.YENV_ /* current environment (may differ from ENV) */
register CELL *H asm ("r12"); register CELL *H asm ("r12");
register CELL *HB asm ("r13"); register CELL *HB asm ("r13");
register choiceptr B asm ("r14"); register choiceptr B asm ("r14");
@ -421,21 +424,21 @@ register CELL CreepFlag asm ("r17");
register tr_fr_ptr TR asm ("r18"); register tr_fr_ptr TR asm ("r18");
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
REGS.HB_ = HB; _YAP_REGS.HB_ = HB;
REGS.B_ = B; _YAP_REGS.B_ = B;
REGS.CP_ = CP; _YAP_REGS.CP_ = CP;
REGS.CreepFlag_ = CreepFlag; _YAP_REGS.CreepFlag_ = CreepFlag;
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_machine_regs(void) { EXTERN inline void restore_machine_regs(void) {
H = REGS.H_; H = _YAP_REGS.H_;
HB = REGS.HB_; HB = _YAP_REGS.HB_;
B = REGS.B_; B = _YAP_REGS.B_;
CP = REGS.CP_; CP = _YAP_REGS.CP_;
CreepFlag = REGS.CreepFlag_; CreepFlag = _YAP_REGS.CreepFlag_;
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
@ -457,11 +460,11 @@ EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
EXTERN inline void save_H(void) { EXTERN inline void save_H(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
} }
EXTERN inline void restore_H(void) { EXTERN inline void restore_H(void) {
H = REGS.H_; H = _YAP_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = H; restore_H()
@ -469,11 +472,11 @@ EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); H = BK_H
EXTERN inline void save_B(void) { EXTERN inline void save_B(void) {
REGS.B_ = B; _YAP_REGS.B_ = B;
} }
EXTERN inline void restore_B(void) { EXTERN inline void restore_B(void) {
B = REGS.B_; B = _YAP_REGS.B_;
} }
#define BACKUP_B() choiceptr BK_B = B; restore_B() #define BACKUP_B() choiceptr BK_B = B; restore_B()
@ -481,11 +484,11 @@ EXTERN inline void restore_B(void) {
#define RECOVER_B() save_B(); B = BK_B #define RECOVER_B() save_B(); B = BK_B
EXTERN inline void save_TR(void) { EXTERN inline void save_TR(void) {
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_TR(void) { EXTERN inline void restore_TR(void) {
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#elif defined(__GNUC__) && defined(_POWER) #elif defined(__GNUC__) && defined(_POWER)
@ -513,26 +516,26 @@ register yamop *CP asm ("r17");
register CELL *S asm ("r18"); register CELL *S asm ("r18");
register CELL *YENV asm ("r19"); register CELL *YENV asm ("r19");
register tr_fr_ptr TR asm ("r20"); register tr_fr_ptr TR asm ("r20");
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
REGS.CreepFlag_ = CreepFlag; _YAP_REGS.CreepFlag_ = CreepFlag;
REGS.H_ = H; _YAP_REGS.H_ = H;
REGS.HB_ = HB; _YAP_REGS.HB_ = HB;
REGS.B_ = B; _YAP_REGS.B_ = B;
REGS.CP_ = CP; _YAP_REGS.CP_ = CP;
REGS.YENV_ = YENV; _YAP_REGS.YENV_ = YENV;
REGS.TR_ = TR; _YAP_REGS.TR_ = TR;
} }
EXTERN inline void restore_machine_regs(void) { EXTERN inline void restore_machine_regs(void) {
CreepFlag = REGS.CreepFlag_; CreepFlag = _YAP_REGS.CreepFlag_;
H = REGS.H_; H = _YAP_REGS.H_;
HB = REGS.HB_; HB = _YAP_REGS.HB_;
B = REGS.B_; B = _YAP_REGS.B_;
CP = REGS.CP_; CP = _YAP_REGS.CP_;
YENV = REGS.YENV_; YENV = _YAP_REGS.YENV_;
TR = REGS.TR_; TR = _YAP_REGS.TR_;
} }
#define BACKUP_MACHINE_REGS() \ #define BACKUP_MACHINE_REGS() \
@ -554,11 +557,11 @@ EXTERN inline void restore_machine_regs(void) {
TR = BK_TR TR = BK_TR
EXTERN inline void save_H(void) { EXTERN inline void save_H(void) {
REGS.H_ = H; _YAP_REGS.H_ = H;
} }
EXTERN inline void restore_H(void) { EXTERN inline void restore_H(void) {
H = REGS.H_; H = _YAP_REGS.H_;
} }
#define BACKUP_H() CELL *BK_H = H; restore_H() #define BACKUP_H() CELL *BK_H = H; restore_H()
@ -566,11 +569,11 @@ EXTERN inline void restore_H(void) {
#define RECOVER_H() save_H(); H = BK_H #define RECOVER_H() save_H(); H = BK_H
EXTERN inline void save_B(void) { EXTERN inline void save_B(void) {
REGS.B_ = B; _YAP_REGS.B_ = B;
} }
EXTERN inline void restore_B(void) { EXTERN inline void restore_B(void) {
B = REGS.B_; B = _YAP_REGS.B_;
} }
#define BACKUP_B() choiceptr BK_B = B; restore_B() #define BACKUP_B() choiceptr BK_B = B; restore_B()
@ -579,15 +582,15 @@ EXTERN inline void restore_B(void) {
#else #else
#define CP REGS.CP_ /* continuation program counter */ #define CP _YAP_REGS.CP_ /* continuation program counter */
#define P REGS.P_ /* prolog machine program counter */ #define P _YAP_REGS.P_ /* prolog machine program counter */
#define YENV REGS.YENV_ /* current environment (may differ from ENV) */ #define YENV _YAP_REGS.YENV_ /* current environment (may differ from ENV) */
#define S REGS.S_ /* structure pointer */ #define S _YAP_REGS.S_ /* structure pointer */
#define H REGS.H_ /* top of heap (global) stack */ #define H _YAP_REGS.H_ /* top of heap (global) stack */
#define B REGS.B_ /* latest choice point */ #define B _YAP_REGS.B_ /* latest choice point */
#define TR REGS.TR_ /* top of trail */ #define TR _YAP_REGS.TR_ /* top of trail */
#define HB REGS.HB_ /* heap (global) stack top at time of latest c.p. */ #define HB _YAP_REGS.HB_ /* heap (global) stack top at time of latest c.p. */
#define CreepFlag REGS.CreepFlag_ #define CreepFlag _YAP_REGS.CreepFlag_
EXTERN inline void save_machine_regs(void) { EXTERN inline void save_machine_regs(void) {
} }
@ -621,36 +624,36 @@ EXTERN inline void restore_B(void) {
#endif #endif
#define AuxSp REGS.AuxSp_ #define AuxSp _YAP_REGS.AuxSp_
#define AuxTop REGS.AuxTop_ #define AuxTop _YAP_REGS.AuxTop_
#define HeapPlus REGS.HeapPlus_ /*To avoid any chock with HeapTop */ #define HeapPlus _YAP_REGS.HeapPlus_ /*To avoid any chock with HeapTop */
#define MyTR REGS.MyTR_ #define MyTR _YAP_REGS.MyTR_
#define TopB REGS.TopB_ #define TopB _YAP_REGS.TopB_
#define DelayedB REGS.DelayedB_ #define DelayedB _YAP_REGS.DelayedB_
#define FlipFlop REGS.FlipFlop_ #define FlipFlop _YAP_REGS.FlipFlop_
#define EX REGS.EX_ #define EX _YAP_REGS.EX_
#define DEPTH REGS.DEPTH_ #define DEPTH _YAP_REGS.DEPTH_
#if (defined(YAPOR) && defined(SBA)) || defined(TABLING) #if (defined(YAPOR) && defined(SBA)) || defined(TABLING)
#define H_FZ REGS.H_FZ_ #define H_FZ _YAP_REGS.H_FZ_
#define B_FZ REGS.B_FZ_ #define B_FZ _YAP_REGS.B_FZ_
#define TR_FZ REGS.TR_FZ_ #define TR_FZ _YAP_REGS.TR_FZ_
#endif #endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define worker_id (REGS.worker_id_) #define worker_id (_YAP_REGS.worker_id_)
#ifdef SBA #ifdef SBA
#define BSEG REGS.BSEG_ #define BSEG _YAP_REGS.BSEG_
#define binding_array REGS.binding_array_ #define binding_array _YAP_REGS.binding_array_
#define sba_offset REGS.sba_offset_ #define sba_offset _YAP_REGS.sba_offset_
#define sba_end REGS.sba_end_ #define sba_end _YAP_REGS.sba_end_
#define sba_size REGS.sba_size_ #define sba_size _YAP_REGS.sba_size_
#define frame_head REGS.frame_head_ #define frame_head _YAP_REGS.frame_head_
#define frame_tail REGS.frame_tail_ #define frame_tail _YAP_REGS.frame_tail_
#endif /* SBA */ #endif /* SBA */
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef COROUTINING #ifdef COROUTINING
#define DelayedVars REGS.DelayedVars_ #define DelayedVars _YAP_REGS.DelayedVars_
#endif #endif
#define CurrentModule REGS.CurrentModule_ #define CurrentModule _YAP_REGS.CurrentModule_
#define REG_SIZE sizeof(REGS)/sizeof(CELL *) #define REG_SIZE sizeof(REGS)/sizeof(CELL *)
@ -680,7 +683,7 @@ EXTERN inline void restore_B(void) {
#define HBREG HB #define HBREG HB
#if (defined(YAPOR) && defined(SBA)) || defined(TABLING) #if (defined(YAPOR) && defined(SBA)) || defined(TABLING)
#define BB REGS.BB_ #define BB _YAP_REGS.BB_
#define BBREG BB #define BBREG BB
#endif #endif
@ -697,12 +700,10 @@ EXTERN inline void restore_B(void) {
when we come from a longjmp */ when we come from a longjmp */
#if PUSH_REGS #if PUSH_REGS
/* In this case we need to initialise the abstract registers */ /* In this case we need to initialise the abstract registers */
REGSTORE standard_regs; REGSTORE _YAP_standard_regs;
#endif /* PUSH_REGS */ #endif /* PUSH_REGS */
/******************* controlling debugging ****************************/ /******************* controlling debugging ****************************/
extern int creep_on;
static inline UInt static inline UInt
CalculateStackGap(void) CalculateStackGap(void)
{ {

330
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.27 2002-10-30 17:27:17 vsc Exp $ * * version: $Id: Yapproto.h,v 1.28 2002-11-11 17:37:58 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -25,29 +25,24 @@ typedef Int (*CmpPredicate)(Term, Term);
/* absmi.c */ /* absmi.c */
Int STD_PROTO(absmi,(int)); Int STD_PROTO(_YAP_absmi,(int));
/* adtdefs.c */ /* adtdefs.c */
Term STD_PROTO(ArrayToList,(Term *,int)); Term STD_PROTO(_YAP_ArrayToList,(Term *,int));
int STD_PROTO(GetName,(char *,UInt,Term)); int STD_PROTO(_YAP_GetName,(char *,UInt,Term));
Term STD_PROTO(GetValue,(Atom)); Term STD_PROTO(_YAP_GetValue,(Atom));
Atom STD_PROTO(LookupAtom,(char *)); Atom STD_PROTO(_YAP_LookupAtom,(char *));
Atom STD_PROTO(FullLookupAtom,(char *)); Atom STD_PROTO(_YAP_FullLookupAtom,(char *));
void STD_PROTO(LookupAtomWithAddress,(char *,AtomEntry *)); void STD_PROTO(_YAP_LookupAtomWithAddress,(char *,AtomEntry *));
Term STD_PROTO(MkApplTerm,(Functor,unsigned int,Term *)); Prop STD_PROTO(_YAP_NewPredPropByFunctor,(struct FunctorEntryStruct *, SMALLUNSGN));
Term STD_PROTO(MkNewApplTerm,(Functor,unsigned int)); Prop STD_PROTO(_YAP_NewPredPropByAtom,(struct AtomEntryStruct *, SMALLUNSGN));
Prop STD_PROTO(NewPredPropByFunctor,(struct FunctorEntryStruct *, SMALLUNSGN)); Functor STD_PROTO(_YAP_UnlockedMkFunctor,(AtomEntry *,unsigned int));
Prop STD_PROTO(NewPredPropByAtom,(struct AtomEntryStruct *, SMALLUNSGN)); Functor STD_PROTO(_YAP_MkFunctor,(Atom,unsigned int));
Functor STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int)); void STD_PROTO(_YAP_MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
Functor STD_PROTO(MkFunctor,(Atom,unsigned int)); void STD_PROTO(_YAP_PutValue,(Atom,Term));
void STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *)); void STD_PROTO(_YAP_ReleaseAtom,(Atom));
Term STD_PROTO(MkPairTerm,(Term,Term)); Term STD_PROTO(_YAP_StringToList,(char *));
Term STD_PROTO(MkNewPairTerm,(void)); Term STD_PROTO(_YAP_StringToListOfAtoms,(char *));
void STD_PROTO(PutValue,(Atom,Term));
void STD_PROTO(ReleaseAtom,(Atom));
Term STD_PROTO(StringToList,(char *));
Term STD_PROTO(StringToListOfAtoms,(char *));
long STD_PROTO(_YAP_InitSlot,(Term)); long STD_PROTO(_YAP_InitSlot,(Term));
long STD_PROTO(_YAP_NewSlots,(int)); long STD_PROTO(_YAP_NewSlots,(int));
@ -63,255 +58,246 @@ Term STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
CELL STD_PROTO(*ArgsOfSFTerm,(Term)); CELL STD_PROTO(*ArgsOfSFTerm,(Term));
#endif #endif
SMALLUNSGN STD_PROTO(LookupModule,(Term)); Prop STD_PROTO(_YAP_GetPredPropByAtom,(Atom, SMALLUNSGN));
Prop STD_PROTO(GetPredPropByAtom,(Atom, SMALLUNSGN)); Prop STD_PROTO(_YAP_GetPredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(GetPredPropByFunc,(Functor, SMALLUNSGN)); Prop STD_PROTO(_YAP_GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN));
Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN)); Prop STD_PROTO(_YAP_GetExpProp,(Atom,unsigned int));
Prop STD_PROTO(GetExpProp,(Atom,unsigned int)); Prop STD_PROTO(_YAP_GetExpPropHavingLock,(AtomEntry *,unsigned int));
Prop STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int));
Term STD_PROTO(Module_Name, (CODEADDR));
/* agc.c */ /* agc.c */
void STD_PROTO(atom_gc, (void)); void STD_PROTO(_YAP_atom_gc, (void));
void STD_PROTO(init_agc, (void)); void STD_PROTO(_YAP_init_agc, (void));
/* alloc.c */ /* alloc.c */
int STD_PROTO(SizeOfBlock,(CODEADDR)); int STD_PROTO(_YAP_SizeOfBlock,(CODEADDR));
void STD_PROTO(FreeCodeSpace,(char *)); void STD_PROTO(_YAP_FreeCodeSpace,(char *));
ADDR STD_PROTO(PreAllocCodeSpace, (void)); char *STD_PROTO(_YAP_AllocAtomSpace,(unsigned int));
char *STD_PROTO(AllocAtomSpace,(unsigned int)); char *STD_PROTO(_YAP_AllocCodeSpace,(unsigned int));
char STD_PROTO(*AllocScannerMemory,(unsigned int)); ADDR STD_PROTO(_YAP_AllocFromForeignArea,(Int));
char STD_PROTO(*AllocCodeSpace,(unsigned int)); int STD_PROTO(_YAP_ExtendWorkSpace,(Int));
ADDR STD_PROTO(AllocFromForeignArea,(Int)); void STD_PROTO(_YAP_FreeAtomSpace,(char *));
int STD_PROTO(ExtendWorkSpace,(Int)); int STD_PROTO(_YAP_FreeWorkSpace, (void));
void STD_PROTO(FreeAtomSpace,(char *)); void STD_PROTO(_YAP_InitMemory,(int,int,int));
int STD_PROTO(FreeWorkSpace, (void));
void STD_PROTO(InitMemory,(int,int,int));
MALLOC_T STD_PROTO(InitWorkSpace, (Int));
/* amasm.c */ /* amasm.c */
OPCODE STD_PROTO(opcode,(op_numbers)); OPCODE STD_PROTO(_YAP_opcode,(op_numbers));
CODEADDR STD_PROTO(assemble,(int));
/* analyst.c */ /* analyst.c */
#ifdef ANALYST #ifdef ANALYST
void STD_PROTO(InitAnalystPreds,(void)); void STD_PROTO(_YAP_InitAnalystPreds,(void));
#endif /* ANALYST */ #endif /* ANALYST */
/* arrays.c */ /* arrays.c */
void STD_PROTO(InitArrayPreds,(void)); void STD_PROTO(_YAP_InitArrayPreds,(void));
CELL *STD_PROTO(ClearNamedArray,(CELL *));
/* attvar.c */ /* attvar.c */
Term STD_PROTO(CurrentAttVars,(void)); Term STD_PROTO(_YAP_CurrentAttVars,(void));
void STD_PROTO(InitAttVarPreds,(void)); void STD_PROTO(_YAP_InitAttVarPreds,(void));
/* bb.c */ /* bb.c */
void STD_PROTO(InitBBPreds,(void)); void STD_PROTO(_YAP_InitBBPreds,(void));
/* bignum.c */ /* bignum.c */
void STD_PROTO(InitBigNums,(void)); void STD_PROTO(_YAP_InitBigNums,(void));
/* c_interface.c */ /* c_interface.c */
Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate)); Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */ /* cdmgr.c */
Term STD_PROTO(all_calls,(void)); void STD_PROTO(_YAP_addclause,(Term,CODEADDR,int,int));
void STD_PROTO(mark_as_fast,(Term)); Term STD_PROTO(_YAP_all_calls,(void));
void STD_PROTO(IPred,(CODEADDR sp)); Atom STD_PROTO(_YAP_ConsultingFile,(void));
Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *)); Int STD_PROTO(_YAP_PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *));
void STD_PROTO(InitCdMgr,(void)); void STD_PROTO(_YAP_InitCdMgr,(void));
#if EMACS #if EMACS
int STD_PROTO(where_new_clause, (Prop, int)); int STD_PROTO(where_new_clause, (Prop, int));
#endif #endif
void STD_PROTO(init_consult,(int, char *)); void STD_PROTO(_YAP_init_consult,(int, char *));
void STD_PROTO(end_consult,(void)); void STD_PROTO(_YAP_end_consult,(void));
/* cmppreds.c */ /* cmppreds.c */
int STD_PROTO(compare_terms,(Term,Term)); int STD_PROTO(_YAP_compare_terms,(Term,Term));
int STD_PROTO(iequ,(Term,Term)); void STD_PROTO(_YAP_InitCmpPreds,(void));
void STD_PROTO(InitCmpPreds,(void));
/* compiler.c */ /* compiler.c */
CODEADDR STD_PROTO(cclause,(Term, int, int)); CODEADDR STD_PROTO(_YAP_cclause,(Term, int, int));
/* computils.c */ /* computils.c */
/* corout.c */ /* corout.c */
void STD_PROTO(InitCoroutPreds,(void)); void STD_PROTO(_YAP_InitCoroutPreds,(void));
#ifdef COROUTINING #ifdef COROUTINING
Term STD_PROTO(ListOfWokenGoals,(void)); Term STD_PROTO(_YAP_ListOfWokenGoals,(void));
void STD_PROTO(WakeUp,(CELL *)); void STD_PROTO(_YAP_WakeUp,(CELL *));
void STD_PROTO(mark_all_suspended_goals,(void)); void STD_PROTO(_YAP_mark_all_suspended_goals,(void));
#endif #endif
/* dbase.c */ /* dbase.c */
int STD_PROTO(DBTrailOverflow,(void)); int STD_PROTO(_YAP_DBTrailOverflow,(void));
CELL STD_PROTO(EvalMasks,(Term,CELL *)); CELL STD_PROTO(_YAP_EvalMasks,(Term,CELL *));
void STD_PROTO(InitBackDB,(void)); void STD_PROTO(_YAP_InitBackDB,(void));
void STD_PROTO(InitDBPreds,(void)); void STD_PROTO(_YAP_InitDBPreds,(void));
/* errors.c */ /* errors.c */
void STD_PROTO(exit_yap,(int)); void STD_PROTO(_YAP_exit,(int));
yamop *STD_PROTO(Error,(yap_error_number,Term,char *msg, ...)); yamop *STD_PROTO(_YAP_Error,(yap_error_number,Term,char *msg, ...));
#if DEBUG
void STD_PROTO(bug_location,(yamop *));
#endif
/* eval.c */ /* eval.c */
void STD_PROTO(InitEval,(void)); void STD_PROTO(_YAP_InitEval,(void));
Int STD_PROTO(EvFArt,(Term));
/* exec.c */ /* exec.c */
Term STD_PROTO(ExecuteCallMetaCall,(SMALLUNSGN mod)); Term STD_PROTO(_YAP_ExecuteCallMetaCall,(SMALLUNSGN mod));
void STD_PROTO(InitExecFs,(void)); void STD_PROTO(_YAP_InitExecFs,(void));
Int STD_PROTO(JumpToEnv,(Term)); Int STD_PROTO(_YAP_JumpToEnv,(Term));
int STD_PROTO(RunTopGoal,(Term)); int STD_PROTO(_YAP_RunTopGoal,(Term));
Int STD_PROTO(execute_goal,(Term, int, SMALLUNSGN)); Int STD_PROTO(_YAP_execute_goal,(Term, int, SMALLUNSGN));
int STD_PROTO(exec_absmi,(int)); int STD_PROTO(_YAP_exec_absmi,(int));
void STD_PROTO(trust_last,(void)); void STD_PROTO(_YAP_trust_last,(void));
/* grow.c */ /* grow.c */
Int STD_PROTO(total_stack_shift_time,(void)); Int STD_PROTO(_YAP_total_stack_shift_time,(void));
void STD_PROTO(InitGrowPreds, (void)); void STD_PROTO(_YAP_InitGrowPreds, (void));
int STD_PROTO(growheap, (int)); int STD_PROTO(_YAP_growheap, (int));
int STD_PROTO(growstack, (long)); int STD_PROTO(_YAP_growstack, (long));
int STD_PROTO(growtrail, (long)); int STD_PROTO(_YAP_growtrail, (long));
int STD_PROTO(growglobal, (CELL **)); int STD_PROTO(_YAP_growglobal, (CELL **));
/* heapgc.c */ /* heapgc.c */
Int STD_PROTO(total_gc_time,(void)); Int STD_PROTO(_YAP_total_gc_time,(void));
void STD_PROTO(init_gc,(void)); void STD_PROTO(_YAP_init_gc,(void));
int STD_PROTO(is_gc_verbose, (void)); int STD_PROTO(_YAP_is_gc_verbose, (void));
int STD_PROTO(gc, (Int, CELL *, yamop *)); int STD_PROTO(_YAP_gc, (Int, CELL *, yamop *));
/* init.c */ /* init.c */
#ifdef DEBUG #ifdef DEBUG
int STD_PROTO(DebugPutc,(int,int)); int STD_PROTO(_YAP_DebugPutc,(int,int));
void STD_PROTO(DebugSetIFile,(char *)); void STD_PROTO(_YAP_DebugSetIFile,(char *));
void STD_PROTO(DebugEndline,(void)); void STD_PROTO(_YAP_DebugEndline,(void));
int STD_PROTO(DebugGetc,(void)); int STD_PROTO(_YAP_DebugGetc,(void));
#endif #endif
int STD_PROTO(IsOpType,(char *)); int STD_PROTO(_YAP_IsOpType,(char *));
void STD_PROTO(InitStacks,(int,int,int,int,int,int)); void STD_PROTO(_YAP_InitStacks,(int,int,int,int,int,int));
void STD_PROTO(InitCPred,(char *, unsigned long int, CPredicate, int)); void STD_PROTO(_YAP_InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(InitAsmPred,(char *, unsigned long int, int, CPredicate, int)); void STD_PROTO(_YAP_InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int)); void STD_PROTO(_YAP_InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int));
void STD_PROTO(InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int)); void STD_PROTO(_YAP_InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(InitYaamRegs,(void)); void STD_PROTO(_YAP_InitYaamRegs,(void));
void STD_PROTO(ReInitWallTime, (void)); void STD_PROTO(_YAP_ReInitWallTime, (void));
int STD_PROTO(OpDec,(int,char *,Atom)); int STD_PROTO(_YAP_OpDec,(int,char *,Atom));
/* inlines.c */
void STD_PROTO(_YAP_InitInlines,(void));
/* iopreds.c */ /* iopreds.c */
void STD_PROTO(CloseStreams,(int)); void STD_PROTO(_YAP_InitPlIO,(void));
void STD_PROTO(InitPlIO,(void)); void STD_PROTO(_YAP_InitBackIO,(void));
void STD_PROTO(InitBackIO,(void)); void STD_PROTO(_YAP_InitIOPreds,(void));
void STD_PROTO(InitIOPreds,(void));
Atom STD_PROTO(YapConsultingFile,(void));
/* depth_lim.c */ /* depth_lim.c */
void STD_PROTO(InitItDeepenPreds,(void)); void STD_PROTO(_YAP_InitItDeepenPreds,(void));
/* load_foreign.c */ /* load_foreign.c */
void STD_PROTO(InitLoadForeign,(void)); void STD_PROTO(_YAP_InitLoadForeign,(void));
/* mavar.c */ /* mavar.c */
void STD_PROTO(InitMaVarCPreds,(void)); void STD_PROTO(_YAP_InitMaVarCPreds,(void));
Term STD_PROTO(NewTimedVar,(Term)); Term STD_PROTO(_YAP_NewTimedVar,(Term));
Term STD_PROTO(NewEmptyTimedVar,(void)); Term STD_PROTO(_YAP_NewEmptyTimedVar,(void));
Term STD_PROTO(ReadTimedVar,(Term)); Term STD_PROTO(_YAP_ReadTimedVar,(Term));
Term STD_PROTO(UpdateTimedVar,(Term, Term)); Term STD_PROTO(_YAP_UpdateTimedVar,(Term, Term));
/* modules.c */
SMALLUNSGN STD_PROTO(_YAP_LookupModule,(Term));
Term STD_PROTO(_YAP_Module_Name, (CODEADDR));
void STD_PROTO(_YAP_InitModules, (void));
#if HAVE_MPI #if HAVE_MPI
/* mpi.c */ /* mpi.c */
void STD_PROTO(InitMPI,(void)); void STD_PROTO(_YAP_InitMPI,(void));
#endif #endif
#if HAVE_MPE #if HAVE_MPE
/* mpe.c */ /* mpe.c */
void STD_PROTO(InitMPE,(void)); void STD_PROTO(_YAP_InitMPE,(void));
#endif #endif
/* other.c */
Term STD_PROTO(_YAP_MkApplTerm,(Functor,unsigned int,Term *));
Term STD_PROTO(_YAP_MkNewApplTerm,(Functor,unsigned int));
Term STD_PROTO(_YAP_MkNewPairTerm,(void));
/* parser.c */ /* parser.c */
int STD_PROTO(IsPrefixOp,(Prop,int *,int *)); int STD_PROTO(_YAP_IsPrefixOp,(Prop,int *,int *));
int STD_PROTO(IsInfixOp,(Prop,int *,int *,int *)); int STD_PROTO(_YAP_IsInfixOp,(Prop,int *,int *,int *));
int STD_PROTO(IsPosfixOp,(Prop,int *,int *)); int STD_PROTO(_YAP_IsPosfixOp,(Prop,int *,int *));
Term STD_PROTO(Parse,(void)); Term STD_PROTO(_YAP_Parse,(void));
/* save.c */ /* save.c */
int STD_PROTO(SavedInfo,(char *,char *,CELL *,CELL *,CELL *)); int STD_PROTO(_YAP_SavedInfo,(char *,char *,CELL *,CELL *,CELL *));
int STD_PROTO(Restore,(char *, char *)); int STD_PROTO(_YAP_Restore,(char *, char *));
void STD_PROTO(InitSavePreds,(void)); void STD_PROTO(_YAP_InitSavePreds,(void));
/* scanner.c */ /* scanner.c */
/* sort.c */ /* sort.c */
void STD_PROTO(InitSortPreds,(void)); void STD_PROTO(_YAP_InitSortPreds,(void));
/* stdpreds.c */ /* stdpreds.c */
#ifdef undefined void STD_PROTO(_YAP_InitBackCPreds,(void));
CELL STD_PROTO(FindWhatCreep,(CELL)); void STD_PROTO(_YAP_InitCPreds,(void));
#endif /* undefined */ void STD_PROTO(_YAP_show_statistics,(void));
void STD_PROTO(InitBackCPreds,(void)); Int STD_PROTO(_YAP_creep,(void));
void STD_PROTO(InitCPreds,(void));
Int STD_PROTO(p_creep,(void));
/* sysbits.c */ /* sysbits.c */
void STD_PROTO(set_fpu_exceptions,(int)); void STD_PROTO(_YAP_set_fpu_exceptions,(int));
Int STD_PROTO(cputime,(void)); Int STD_PROTO(_YAP_cputime,(void));
Int STD_PROTO(runtime,(void)); Int STD_PROTO(_YAP_walltime,(void));
Int STD_PROTO(walltime,(void)); int STD_PROTO(_YAP_dir_separator,(int));
int STD_PROTO(dir_separator,(int)); int STD_PROTO(_YAP_volume_header,(char *));
int STD_PROTO(volume_header,(char *)); void STD_PROTO(_YAP_InitSysPath,(void));
void STD_PROTO(InitSysPath,(void)); #if MAC
void STD_PROTO(SetTextFile,(char *)); void STD_PROTO(_YAP_SetTextFile,(char *));
void STD_PROTO(cputime_interval,(Int *,Int *)); #endif
void STD_PROTO(walltime_interval,(Int *,Int *)); void STD_PROTO(_YAP_cputime_interval,(Int *,Int *));
void STD_PROTO(InitSysbits,(void)); void STD_PROTO(_YAP_walltime_interval,(Int *,Int *));
void STD_PROTO(InitSysPreds,(void)); void STD_PROTO(_YAP_InitSysbits,(void));
int STD_PROTO(TrueFileName, (char *, char *, int)); void STD_PROTO(_YAP_InitSysPreds,(void));
int STD_PROTO(ProcessSIGINT,(void)); int STD_PROTO(_YAP_TrueFileName, (char *, char *, int));
double STD_PROTO(yap_random, (void)); int STD_PROTO(_YAP_ProcessSIGINT,(void));
void STD_PROTO(set_fpu_exceptions, (int)); double STD_PROTO(_YAP_random, (void));
/* tracer.c */ /* tracer.c */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
void STD_PROTO(InitLowLevelTrace,(void)); void STD_PROTO(_YAP_InitLowLevelTrace,(void));
#endif #endif
/* unify.c */ /* unify.c */
void STD_PROTO(InitAbsmi,(void)); void STD_PROTO(_YAP_InitAbsmi,(void));
void STD_PROTO(InitUnify,(void)); void STD_PROTO(_YAP_InitUnify,(void));
int STD_PROTO(IUnify,(register CELL d0,register CELL d1)); int STD_PROTO(_YAP_IUnify,(register CELL d0,register CELL d1));
EXTERN Term STD_PROTO(Deref,(Term)); op_numbers STD_PROTO(_YAP_op_from_opcode,(OPCODE));
EXTERN Term STD_PROTO(Derefa,(CELL *));
EXTERN Int STD_PROTO(unify,(Term, Term));
EXTERN Int STD_PROTO(unify_constant,(Term,Term));
op_numbers STD_PROTO(op_from_opcode,(OPCODE));
/* userpreds.c */ /* userpreds.c */
void STD_PROTO(InitUserCPreds,(void)); void STD_PROTO(_YAP_InitUserCPreds,(void));
void STD_PROTO(InitUserBacks,(void)); void STD_PROTO(_YAP_InitUserBacks,(void));
/* utilpreds.c */ /* utilpreds.c */
Term STD_PROTO(CopyTerm,(Term)); Term STD_PROTO(_YAP_CopyTerm,(Term));
void STD_PROTO(InitUtilCPreds,(void)); void STD_PROTO(_YAP_InitUtilCPreds,(void));
/* yap.c */ /* yap.c */
void STD_PROTO(addclause,(Term,CODEADDR,int,int));
/* ypsocks.c */ /* ypsocks.c */
void STD_PROTO(InitSockets,(void)); void STD_PROTO(_YAP_InitSockets,(void));
#ifdef USE_SOCKET #ifdef USE_SOCKET
void STD_PROTO(init_socks,(char *, long)); void STD_PROTO(_YAP_init_socks,(char *, long));
#endif #endif
/* opt.preds.c */ /* opt.preds.c */
void STD_PROTO(init_optyap_preds,(void)); void STD_PROTO(_YAP_init_optyap_preds,(void));

453
H/absmi.h
View File

@ -145,10 +145,6 @@ register void* P1REG asm ("bp"); /* can't use yamop before Yap.h */
**********************************************************************/ **********************************************************************/
#include <stdio.h> #include <stdio.h>
#endif #endif
int STD_PROTO(IUnify_complex, (CELL *, CELL *,CELL *));
int STD_PROTO(iequ_complex, (CELL *, CELL *,CELL *));
#ifdef ANALYST #ifdef ANALYST
static char *op_names[_std_top + 1] = static char *op_names[_std_top + 1] =
@ -172,14 +168,14 @@ static char *op_names[_std_top + 1] =
inline EXTERN void inline EXTERN void
init_absmi_regs(REGSTORE * absmi_regs) init_absmi_regs(REGSTORE * absmi_regs)
{ {
memcpy(absmi_regs, regp, sizeof(REGSTORE)); memcpy(absmi_regs, _YAP_regp, sizeof(REGSTORE));
} }
inline EXTERN void inline EXTERN void
restore_absmi_regs(REGSTORE * old_regs) restore_absmi_regs(REGSTORE * old_regs)
{ {
memcpy(old_regs, regp, sizeof(REGSTORE)); memcpy(old_regs, _YAP_regp, sizeof(REGSTORE));
regp = old_regs; _YAP_regp = old_regs;
} }
#endif /* PUSH_REGS */ #endif /* PUSH_REGS */
@ -216,25 +212,25 @@ restore_absmi_regs(REGSTORE * old_regs)
#define ENDCHO(TMP) } #define ENDCHO(TMP) }
/*************************************************************** /***************************************************************
* Y is usually, but not always, a register. This affects * * YREG is usually, but not always, a register. This affects *
* choicepoints * * choicepoints *
***************************************************************/ ***************************************************************/
#if Y_IN_MEM #if Y_IN_MEM
#define CACHE_Y(A) { register CELL *S_Y = ((CELL *)(A)) #define CACHE_Y(A) { register CELL *S_YREG = ((CELL *)(A))
#define ENDCACHE_Y() Y = S_Y; } #define ENDCACHE_Y() YREG = S_YREG; }
#define B_Y ((choiceptr)(S_Y)) #define B_YREG ((choiceptr)(S_YREG))
#else #else
#define S_Y (Y) #define S_YREG (YREG)
#define B_Y ((choiceptr)(Y)) #define B_YREG ((choiceptr)(YREG))
#define CACHE_Y(A) { Y = ((CELL *)(A)) #define CACHE_Y(A) { YREG = ((CELL *)(A))
#define ENDCACHE_Y() } #define ENDCACHE_Y() }
@ -242,19 +238,19 @@ restore_absmi_regs(REGSTORE * old_regs)
#if Y_IN_MEM #if Y_IN_MEM
#define CACHE_Y_AS_ENV(A) { register CELL *E_Y = (A) #define CACHE_Y_AS_ENV(A) { register CELL *E_YREG = (A)
#define WRITEBACK_Y_AS_ENV() Y = E_Y #define WRITEBACK_Y_AS_ENV() YREG = E_YREG
#define ENDCACHE_Y_AS_ENV() } #define ENDCACHE_Y_AS_ENV() }
#else #else
#define E_Y (Y) #define E_YREG (YREG)
#define WRITEBACK_Y_AS_ENV() #define WRITEBACK_Y_AS_ENV()
#define CACHE_Y_AS_ENV(A) { Y = (A) #define CACHE_Y_AS_ENV(A) { YREG = (A)
#define ENDCACHE_Y_AS_ENV() } #define ENDCACHE_Y_AS_ENV() }
@ -606,12 +602,12 @@ typedef CELL label;
* Next, Y * Next, Y
*/ */
#if SHADOW_Y #if SHADOW_Y
#define set_y() Y = YENV #define set_y() YREG = YENV
#define save_y() YENV = Y #define save_y() YENV = YREG
#else #else
#define set_y() #define set_y()
#define save_y() #define save_y()
#define Y YENV #define YREG YENV
#endif #endif
/* /*
@ -692,12 +688,12 @@ Macros to check the limits of stacks
#if defined(SBA) && defined(YAPOR) #if defined(SBA) && defined(YAPOR)
#define check_stack(Label, GLOB) \ #define check_stack(Label, GLOB) \
if ( (Int)(Unsigned(E_Y) - CFREG) < (Int)(GLOB) && \ if ( (Int)(Unsigned(E_YREG) - CFREG) < (Int)(GLOB) && \
(choiceptr)E_Y < B_FZ && E_Y > H_FZ && \ (choiceptr)E_YREG < B_FZ && E_Y > H_FZ && \
(GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label (GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label
#else #else
#define check_stack(Label, GLOB) \ #define check_stack(Label, GLOB) \
if ( (Int)(Unsigned(E_Y) - CFREG) < (Int)(GLOB) ) goto Label if ( (Int)(Unsigned(E_YREG) - CFREG) < (Int)(GLOB) ) goto Label
#endif /* SBA && YAPOR */ #endif /* SBA && YAPOR */
/*************************************************************** /***************************************************************
@ -718,9 +714,9 @@ Macros to check the limits of stacks
pt0 = XREGS+(arity); \ pt0 = XREGS+(arity); \
while ( pt0 > XREGS ) \ while ( pt0 > XREGS ) \
{ register CELL x = pt0[0]; \ { register CELL x = pt0[0]; \
S_Y = S_Y-1; \ S_YREG = S_YREG-1; \
--pt0; \ --pt0; \
(S_Y)[0] = x; \ (S_YREG)[0] = x; \
} \ } \
ENDP(pt0) ENDP(pt0)
@ -728,9 +724,9 @@ Macros to check the limits of stacks
BEGP(pt0); \ BEGP(pt0); \
pt0 = XREGS+(arity); \ pt0 = XREGS+(arity); \
do { register CELL x = pt0[0]; \ do { register CELL x = pt0[0]; \
S_Y = (S_Y)-1; \ S_YREG = (S_YREG)-1; \
--pt0; \ --pt0; \
(S_Y)[0] = x; \ (S_YREG)[0] = x; \
} \ } \
while ( pt0 > XREGS ); \ while ( pt0 > XREGS ); \
ENDP(pt0) ENDP(pt0)
@ -753,16 +749,16 @@ Macros to check the limits of stacks
{ register yamop *x1 = (yamop *)(AP); \ { register yamop *x1 = (yamop *)(AP); \
register CELL *x2 = ENV; \ register CELL *x2 = ENV; \
/* Jump to CP_BASE */ \ /* Jump to CP_BASE */ \
S_Y = (CELL *)((choiceptr)((S_Y)-(I))-1); \ S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
/* Save Information */ \ /* Save Information */ \
HBREG = H; \ HBREG = H; \
B_Y->cp_tr = TR; \ B_YREG->cp_tr = TR; \
B_Y->cp_h = H; \ B_YREG->cp_h = H; \
B_Y->cp_b = B; \ B_YREG->cp_b = B; \
store_yaam_reg_cpdepth(B_Y); \ store_yaam_reg_cpdepth(B_YREG); \
B_Y->cp_cp = CPREG; \ B_YREG->cp_cp = CPREG; \
B_Y->cp_ap = x1; \ B_YREG->cp_ap = x1; \
B_Y->cp_env= x2; \ B_YREG->cp_env= x2; \
} }
#define store_yaam_regs_for_either(AP,d0) \ #define store_yaam_regs_for_either(AP,d0) \
@ -832,16 +828,16 @@ Macros to check the limits of stacks
#endif /* TABLING */ #endif /* TABLING */
#define restore_yaam_regs(AP) \ #define restore_yaam_regs(AP) \
{ register CELL *x1 = B_Y->cp_env; \ { register CELL *x1 = B_YREG->cp_env; \
register yamop *x2; \ register yamop *x2; \
H = HBREG = PROTECT_FROZEN_H(B_Y); \ H = HBREG = PROTECT_FROZEN_H(B_YREG); \
restore_yaam_reg_cpdepth(B_Y); \ restore_yaam_reg_cpdepth(B_YREG); \
CPREG = B_Y->cp_cp; \ CPREG = B_YREG->cp_cp; \
/* AP may depend on H */ \ /* AP may depend on H */ \
x2 = (yamop *)AP; \ x2 = (yamop *)AP; \
ENV = x1; \ ENV = x1; \
YAPOR_update_alternative(PREG, x2) \ YAPOR_update_alternative(PREG, x2) \
B_Y->cp_ap = x2; \ B_YREG->cp_ap = x2; \
} }
/*************************************************************** /***************************************************************
@ -852,7 +848,7 @@ Macros to check the limits of stacks
d0 = Nargs; \ d0 = Nargs; \
BEGP(pt0); \ BEGP(pt0); \
BEGP(pt1); \ BEGP(pt1); \
pt1 = (CELL *)(B_Y+1)+d0; \ pt1 = (CELL *)(B_YREG+1)+d0; \
pt0 = XREGS+1+d0; \ pt0 = XREGS+1+d0; \
while (pt0 > XREGS +1 ) \ while (pt0 > XREGS +1 ) \
{ register CELL x = pt1[-1]; \ { register CELL x = pt1[-1]; \
@ -869,7 +865,7 @@ Macros to check the limits of stacks
d0 = Nargs; \ d0 = Nargs; \
BEGP(pt0); \ BEGP(pt0); \
BEGP(pt1); \ BEGP(pt1); \
pt1 = (CELL *)(B_Y+1)+d0; \ pt1 = (CELL *)(B_YREG+1)+d0; \
pt0 = XREGS+1+d0; \ pt0 = XREGS+1+d0; \
do { register CELL x = pt1[-1]; \ do { register CELL x = pt1[-1]; \
--pt0; \ --pt0; \
@ -898,12 +894,12 @@ Macros to check the limits of stacks
#define pop_yaam_regs() \ #define pop_yaam_regs() \
{ register CELL *ptr1; \ { register CELL *ptr1; \
H = PROTECT_FROZEN_H(B_Y); \ H = PROTECT_FROZEN_H(B_YREG); \
B = B_Y->cp_b; \ B = B_YREG->cp_b; \
pop_yaam_reg_cpdepth(B_Y); \ pop_yaam_reg_cpdepth(B_YREG); \
CPREG = B_Y->cp_cp; \ CPREG = B_YREG->cp_cp; \
ptr1 = B_Y->cp_env; \ ptr1 = B_YREG->cp_env; \
TABLING_close_alt(B_Y); \ TABLING_close_alt(B_YREG); \
HBREG = PROTECT_FROZEN_H(B); \ HBREG = PROTECT_FROZEN_H(B); \
ENV = ptr1; \ ENV = ptr1; \
} }
@ -913,16 +909,16 @@ Macros to check the limits of stacks
d0 = (NArgs); \ d0 = (NArgs); \
BEGP(pt0); \ BEGP(pt0); \
BEGP(pt1); \ BEGP(pt1); \
S_Y = (CELL *)(B_Y+1); \ S_YREG = (CELL *)(B_YREG+1); \
pt0 = XREGS + 1 ; \ pt0 = XREGS + 1 ; \
pt1 = S_Y ; \ pt1 = S_YREG ; \
while (pt0 < XREGS+1+d0) \ while (pt0 < XREGS+1+d0) \
{ register CELL x = pt1[0]; \ { register CELL x = pt1[0]; \
pt1++; \ pt1++; \
pt0++; \ pt0++; \
pt0[-1] = x; \ pt0[-1] = x; \
} \ } \
S_Y = pt1; \ S_YREG = pt1; \
ENDP(pt1); \ ENDP(pt1); \
ENDP(pt0); \ ENDP(pt0); \
ENDD(d0); ENDD(d0);
@ -932,7 +928,7 @@ Macros to check the limits of stacks
d0 = (NArgs); \ d0 = (NArgs); \
BEGP(pt0); \ BEGP(pt0); \
BEGP(pt1); \ BEGP(pt1); \
pt1 = (CELL *)(B_Y+1); \ pt1 = (CELL *)(B_YREG+1); \
pt0 = XREGS + 1 ; \ pt0 = XREGS + 1 ; \
do { register CELL x = pt1[0]; \ do { register CELL x = pt1[0]; \
pt1++; \ pt1++; \
@ -940,7 +936,7 @@ Macros to check the limits of stacks
pt0[-1] = x; \ pt0[-1] = x; \
} \ } \
while (pt0 < XREGS+1+d0); \ while (pt0 < XREGS+1+d0); \
S_Y = pt1; \ S_YREG = pt1; \
ENDP(pt1); \ ENDP(pt1); \
ENDP(pt0); \ ENDP(pt0); \
ENDD(d0); ENDD(d0);
@ -1151,4 +1147,353 @@ trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
#if IN_ABSMI_C || IN_UNIFY_C
static int
IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
#if SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &_YAP_REGS;
#define _YAP_REGS (*regp)
#endif /* defined(B) || defined(TR) || defined(HB) */
#endif
#if SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
CELL **to_visit = (CELL **)AuxSp;
loop:
while (pt0 < pt0_end) {
register CELL *ptd0 = pt0+1;
register CELL d0;
++pt1;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, unify_comp_unk);
unify_comp_nvar:
{
register CELL *ptd1 = pt1;
register CELL d1 = *ptd1;
deref_head(d1, unify_comp_nvar_unk);
unify_comp_nvar_nvar:
if (d0 == d1)
continue;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
goto cufail;
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 4;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 3;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
}
#endif
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt1 = RepPair(d1) - 1;
continue;
}
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
goto cufail;
}
/* store the terms to visit */
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor) (*ap2);
/* compare functors */
if (f != (Functor) *ap3)
goto cufail;
if (IsExtensionFunctor(f)) {
if (unify_extension(f, d0, ap2, d1))
continue;
goto cufail;
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 4;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 3;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
}
goto cufail;
derefa_body(d1, ptd1, unify_comp_nvar_unk, unify_comp_nvar_nvar);
/* d1 and pt2 have the unbound value, whereas d0 is bound */
BIND_GLOBALCELL(ptd1, d0);
}
derefa_body(d0, ptd0, unify_comp_unk, unify_comp_nvar);
/* first arg var */
{
register CELL d1;
register CELL *ptd1;
ptd1 = pt1;
d1 = ptd1[0];
/* pt2 is unbound */
deref_head(d1, unify_comp_var_unk);
unify_comp_var_nvar:
/* pt2 is unbound and d1 is bound */
BIND_GLOBALCELL(ptd0, d1);
derefa_body(d1, ptd1, unify_comp_var_unk, unify_comp_var_nvar);
/* ptd0 and ptd1 are unbound */
UnifyGlobalCells(ptd0, ptd1);
}
}
/* Do we still have compound terms to visit */
if (to_visit < (CELL **) AuxSp) {
#ifdef RATIONAL_TREES
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
to_visit += 4;
#else
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
to_visit += 3;
#endif
goto loop;
}
return (TRUE);
cufail:
#ifdef RATIONAL_TREES
/* failure */
while (to_visit < (CELL **) AuxSp) {
CELL *pt0;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[3];
to_visit += 4;
}
#endif
return (FALSE);
#if SHADOW_REGS
#if defined(B) || defined(TR)
#undef _YAP_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
#endif
#if IN_ABSMI_C || IN_INLINES_C
static int
iequ_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1
)
{
register CELL **to_visit = (CELL **) H;
#ifdef RATIONAL_TREES
register CELL *visited = AuxSp;
#endif
loop:
while (pt0 < pt0_end) {
register CELL *ptd0 = ++pt0;
register CELL d0 = *ptd0;
++pt1;
deref_head(d0, eq_comp_unk);
eq_comp_nvar:
{
register CELL *ptd1 = pt1;
register CELL d1 = *ptd1;
deref_head(d1, eq_comp_nvar_unk);
eq_comp_nvar_nvar:
if (d0 == d1)
continue;
else if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
UNWIND_CUNIF();
return (FALSE);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
if (d0 > d1) {
visited -= 2;
visited[0] = (CELL) pt0;
visited[1] = *pt0;
*pt0 = d1;
}
else {
visited -= 2;
visited[0] = (CELL) pt1;
visited[1] = *pt1;
*pt1 = d0;
}
#endif
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
}
else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor) (*ap2);
if (IsExtensionFunctor(f)) {
switch ((CELL)f) {
case (CELL)FunctorDBRef:
if (d0 == d1) continue;
UNWIND_CUNIF();
return (FALSE);
case (CELL)FunctorLongInt:
if (IsLongIntTerm(d1) && (Int)(ap2[1]) == LongIntOfTerm(d1)) continue;
UNWIND_CUNIF();
return (FALSE);
case (CELL)FunctorDouble:
if (IsFloatTerm(d1) && FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
UNWIND_CUNIF();
return (FALSE);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
if (IsBigIntTerm(d1) && mpz_cmp((MP_INT *)(ap2+1),_YAP_BigIntOfTerm(d1)) == 0) continue;
UNWIND_CUNIF();
return (FALSE);
#endif /* USE_GMP */
default:
break;
}
}
if (!IsApplTerm(d1)) {
UNWIND_CUNIF();
return (FALSE);
}
ap3 = RepAppl(d1);
/* compare functors */
if (f != (Functor) *ap3) {
UNWIND_CUNIF();
return (FALSE);
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
if (d0 > d1) {
visited -= 2;
visited[0] = (CELL) pt0;
visited[1] = *pt0;
*pt0 = d1;
}
else {
visited -= 2;
visited[0] = (CELL) pt1;
visited[1] = *pt1;
*pt1 = d0;
}
#endif
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
} else {
UNWIND_CUNIF();
return (FALSE);
}
derefa_body(d1, ptd1, eq_comp_nvar_unk, eq_comp_nvar_nvar);
/* d1 and pt2 have the unbound value, whereas d0 is bound */
UNWIND_CUNIF();
return (FALSE);
}
derefa_body(d0, ptd0, eq_comp_unk, eq_comp_nvar);
{
register CELL d1;
register CELL *ptd1;
d1 = *( ptd1 = pt1);
/* pt2 is unbound */
deref_head(d1, eq_comp_var_unk);
eq_comp_var_nvar:
/* pt2 is unbound and d1 is bound */
UNWIND_CUNIF();
return (FALSE);
derefa_body(d1, ptd1, eq_comp_var_unk, eq_comp_var_nvar);
/* pt2 and pt3 are unbound */
if (ptd0 == ptd1)
continue;
UNWIND_CUNIF();
return (FALSE);
}
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **) H) {
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
goto loop;
}
/* successful exit */
UNWIND_CUNIF();
return (TRUE);
}
#endif

11
H/alloc.h
View File

@ -1,6 +1,6 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog %W% %G% * * YAP Prolog %W% %G% *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
@ -77,8 +77,8 @@ typedef struct FREEB {
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1)) #define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
/* I'll assume page size is always a power of two */ /* I'll assume page size is always a power of two */
#define AdjustPageSize(X) ((X) & (page_size-1) ? \ #define AdjustPageSize(X) ((X) & (_YAP_page_size-1) ? \
((X) + page_size) & (~(page_size-1)) : \ ((X) + _YAP_page_size) & (~(_YAP_page_size-1)) : \
(X) ) (X) )
#define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size] #define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size]
@ -86,10 +86,9 @@ typedef struct FREEB {
#define FreeBlocks heap_regs->free_blocks #define FreeBlocks heap_regs->free_blocks
/* Operating system and architecture dependent page size */ /* Operating system and architecture dependent page size */
extern int page_size; extern int _YAP_page_size;
void STD_PROTO(YAP_InitHeap, (void *));
void STD_PROTO(_YAP_InitHeap, (void *));
#if USE_MMAP #if USE_MMAP

98
H/amidefs.h
View File

@ -33,14 +33,14 @@
/* /*
Possible arguments to YAP emulator: Possible arguments to YAP emulator:
AREG describes an A or X register; wamreg describes an A or X register;
YREG describes an Y register yslot describes an Y slot
COUNT is a small number (eg, number of arguments to a choicepoint, COUNT is a small number (eg, number of arguments to a choicepoint,
number of permanent variables in a environment number of permanent variables in a environment
*/ */
typedef OPREG AREG; typedef OPREG wamreg;
typedef OPREG YREG; typedef OPREG yslot;
typedef OPREG COUNT; typedef OPREG COUNT;
@ -231,25 +231,25 @@ typedef struct yami {
struct { struct {
struct pred_entry *p; struct pred_entry *p;
CODEADDR l; CODEADDR l;
AREG x1; wamreg x1;
AREG x2; wamreg x2;
AREG flags; wamreg flags;
CELL next; CELL next;
} lxx; } lxx;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
CODEADDR l; CODEADDR l;
AREG x; wamreg x;
YREG y; yslot y;
AREG flags; wamreg flags;
CELL next; CELL next;
} lxy; } lxy;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
CODEADDR l; CODEADDR l;
AREG y1; wamreg y1;
YREG y2; yslot y2;
AREG flags; wamreg flags;
CELL next; CELL next;
} lyy; } lyy;
struct { struct {
@ -288,18 +288,18 @@ typedef struct yami {
} os; } os;
struct { struct {
OPCODE opcw; OPCODE opcw;
AREG x; wamreg x;
CELL next; CELL next;
} ox; } ox;
struct { struct {
OPCODE opcw; OPCODE opcw;
AREG xl; wamreg xl;
AREG xr; wamreg xr;
CELL next; CELL next;
} oxx; } oxx;
struct { struct {
OPCODE opcw; OPCODE opcw;
YREG y; yslot y;
CELL next; CELL next;
} oy; } oy;
struct { struct {
@ -335,79 +335,79 @@ typedef struct yami {
CELL next; CELL next;
} sla; /* also check env for yes and trustfail code before making any changes */ } sla; /* also check env for yes and trustfail code before making any changes */
struct { struct {
AREG x; wamreg x;
CELL next; CELL next;
} x; } x;
struct { struct {
AREG x; wamreg x;
CELL c; CELL c;
CELL next; CELL next;
} xc; } xc;
struct { struct {
AREG x; wamreg x;
Functor f; Functor f;
Int a; Int a;
CELL next; CELL next;
} xf; } xf;
struct { struct {
AREG xl; wamreg xl;
AREG xr; wamreg xr;
CELL next; CELL next;
} xx; } xx;
struct { struct {
AREG x; wamreg x;
AREG x1; wamreg x1;
AREG x2; wamreg x2;
CELL next; CELL next;
} xxx; } xxx;
struct { struct {
AREG x; wamreg x;
Int c; Int c;
AREG xi; wamreg xi;
CELL next; CELL next;
} xcx, xxc; } xcx, xxc;
struct { struct {
AREG x; wamreg x;
YREG y; yslot y;
CELL next; CELL next;
} xy; } xy;
struct { struct {
AREG x; wamreg x;
YREG y2; yslot y2;
AREG x1; wamreg x1;
CELL next; CELL next;
} xyx; } xyx;
struct { struct {
YREG y; yslot y;
CELL next; CELL next;
} y; } y;
struct { struct {
YREG y; yslot y;
AREG x; wamreg x;
CELL next; CELL next;
} yx; } yx;
struct { struct {
YREG y; yslot y;
AREG x1; wamreg x1;
AREG x2; wamreg x2;
CELL next; CELL next;
} yxx; } yxx;
struct { struct {
YREG y1; yslot y1;
YREG y2; yslot y2;
AREG x; wamreg x;
CELL next; CELL next;
} yyx; } yyx;
struct { struct {
YREG y; yslot y;
YREG y1; yslot y1;
YREG y2; yslot y2;
CELL next; CELL next;
} yyy; } yyy;
struct { struct {
YREG y; yslot y;
Int c; Int c;
AREG xi; wamreg xi;
CELL next; CELL next;
} ycx, yxc; } ycx, yxc;
} u; } u;
@ -554,16 +554,16 @@ typedef struct choicept {
/* access to instructions */ /* access to instructions */
#if USE_THREADED_CODE #if USE_THREADED_CODE
extern void **ABSMI_OPCODES; extern void **_YAP_ABSMI_OPCODES;
#define absmadr(i) ((OPCODE)(ABSMI_OPCODES[(i)])) #define absmadr(i) ((OPCODE)(_YAP_ABSMI_OPCODES[(i)]))
#else #else
#define absmadr(i) ((OPCODE)(i)) #define absmadr(i) ((OPCODE)(i))
#endif #endif
/* used to find out how many instructions of each kind are executed */ /* used to find out how many instructions of each kind are executed */
#ifdef ANALYST #ifdef ANALYST
extern int opcount[_std_top+1]; extern int _YAP_opcount[_std_top+1];
#endif /* ANALYST */ #endif /* ANALYST */
#if DEPTH_LIMIT #if DEPTH_LIMIT

19
H/amiops.h
View File

@ -74,6 +74,9 @@ Dereferencing macros
#endif /* UNIQUE_TAG_FOR_PAIRS */ #endif /* UNIQUE_TAG_FOR_PAIRS */
EXTERN Term STD_PROTO(Deref,(Term));
EXTERN Term STD_PROTO(Derefa,(CELL *));
EXTERN inline Term Deref(Term a) EXTERN inline Term Deref(Term a)
{ {
while(IsVarTerm(a)) { while(IsVarTerm(a)) {
@ -321,7 +324,7 @@ Binding Macros for Multiple Assignment Variables.
#define BIND_GLOBALCELL(A,D) *(A) = (D); \ #define BIND_GLOBALCELL(A,D) *(A) = (D); \
if ((A) >= HBREG) continue; \ if ((A) >= HBREG) continue; \
TRAIL_GLOBAL(A,D); if ((A) >= H0) continue; \ TRAIL_GLOBAL(A,D); if ((A) >= H0) continue; \
WakeUp((A)); continue _YAP_WakeUp((A)); continue
#else #else
#define BIND_GLOBAL2(A,D,LAB,LAB1) BIND_GLOBAL(A,D,LAB) #define BIND_GLOBAL2(A,D,LAB,LAB1) BIND_GLOBAL(A,D,LAB)
@ -362,12 +365,14 @@ Unification Routines
*************************************************************/ *************************************************************/
EXTERN Int STD_PROTO(_YAP_unify,(Term,Term));
EXTERN inline EXTERN inline
Int unify(Term t0, Term t1) Int _YAP_unify(Term t0, Term t1)
{ {
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) { if (_YAP_IUnify(t0,t1)) {
return(TRUE); return(TRUE);
} else { } else {
while(TR != TR0) { while(TR != TR0) {
@ -398,8 +403,10 @@ Int unify(Term t0, Term t1)
} }
} }
EXTERN Int STD_PROTO(_YAP_unify_constant,(Term,Term));
EXTERN inline Int EXTERN inline Int
unify_constant(register Term a, register Term cons) _YAP_unify_constant(register Term a, register Term cons)
{ {
CELL *pt; CELL *pt;
deref_head(a,unify_cons_unk); deref_head(a,unify_cons_unk);
@ -423,7 +430,7 @@ unify_constant(register Term a, register Term cons)
return(FloatOfTerm(a) == FloatOfTerm(cons)); return(FloatOfTerm(a) == FloatOfTerm(cons));
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
return(mpz_cmp(BigIntOfTerm(a),BigIntOfTerm(cons)) == 0); return(mpz_cmp(_YAP_BigIntOfTerm(a),_YAP_BigIntOfTerm(cons)) == 0);
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
return(FALSE); return(FALSE);
@ -437,7 +444,7 @@ unify_constant(register Term a, register Term cons)
BIND(pt,cons,wake_for_cons); BIND(pt,cons,wake_for_cons);
#ifdef COROUTINING #ifdef COROUTINING
DO_TRAIL(pt, cons); DO_TRAIL(pt, cons);
if (pt < H0) WakeUp(pt); if (pt < H0) _YAP_WakeUp(pt);
wake_for_cons: wake_for_cons:
#endif #endif
return(TRUE); return(TRUE);

272
H/arith2.h
View File

@ -25,7 +25,7 @@ add_int(Int i, Int j E_ARGS)
Int x = i+j; Int x = i+j;
#if USE_GMP #if USE_GMP
if ((i^j) >= 0 && (i^x) < 0) { if ((i^j) >= 0 && (i^x) < 0) {
MP_INT *new = InitBigNum(i); MP_INT *new = _YAP_InitBigNum(i);
if (j > 0) { if (j > 0) {
mpz_add_ui(new, new, j); mpz_add_ui(new, new, j);
RBIG(new); RBIG(new);
@ -69,16 +69,16 @@ p_plus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
MP_INT *l2 = BigIntOfTerm(t2); MP_INT *l2 = _YAP_BigIntOfTerm(t2);
if (i1 > 0) { if (i1 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, l2, i1); mpz_add_ui(new, l2, i1);
RBIG(new); RBIG(new);
} else if (i1 == 0) { } else if (i1 == 0) {
RBIG(l2); RBIG(l2);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, l2, -i1); mpz_sub_ui(new, l2, -i1);
RBIG(new); RBIG(new);
@ -103,7 +103,7 @@ p_plus(Term t1, Term t2 E_ARGS)
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2)); RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
RFLOAT(FloatOfTerm(t1)+mpz_get_d(BigIntOfTerm(t2))); RFLOAT(FloatOfTerm(t1)+mpz_get_d(_YAP_BigIntOfTerm(t2)));
#endif #endif
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
@ -120,17 +120,17 @@ p_plus(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, l1, i2); mpz_add_ui(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
RBIG(l1); RBIG(l1);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, l1, -i2); mpz_sub_ui(new, l1, -i2);
RBIG(new); RBIG(new);
@ -139,16 +139,16 @@ p_plus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_add(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
RFLOAT(mpz_get_d(BigIntOfTerm(t1))+FloatOfTerm(t2)); RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))+FloatOfTerm(t2));
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -174,14 +174,14 @@ p_plus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
if (v1.Int > 0) { if (v1.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, v2.big, v1.Int); mpz_add_ui(new, v2.big, v1.Int);
RBIG(new); RBIG(new);
} else if (v1.Int == 0) { } else if (v1.Int == 0) {
RBIG(v2.big); RBIG(v2.big);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, v2.big, -v1.Int); mpz_add_ui(new, v2.big, -v1.Int);
RBIG(new); RBIG(new);
@ -215,14 +215,14 @@ p_plus(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* big * integer */ /* big * integer */
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, v1.big, v2.Int); mpz_add_ui(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
RBIG(v1.big); RBIG(v1.big);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, v2.big, -v1.Int); mpz_sub_ui(new, v2.big, -v1.Int);
RBIG(new); RBIG(new);
@ -233,7 +233,7 @@ p_plus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add(new, v1.big, v2.big); mpz_add(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -279,20 +279,20 @@ p_minus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
MP_INT *l2 = BigIntOfTerm(t2); MP_INT *l2 = _YAP_BigIntOfTerm(t2);
if (i1 > 0) { if (i1 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, l2, i1); mpz_sub_ui(new, l2, i1);
mpz_neg(new, new); mpz_neg(new, new);
RBIG(new); RBIG(new);
} else if (i1 == 0) { } else if (i1 == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_neg(new, l2); mpz_neg(new, l2);
RBIG(new); RBIG(new);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, l2, -i1); mpz_add_ui(new, l2, -i1);
mpz_neg(new,new); mpz_neg(new,new);
@ -321,7 +321,7 @@ p_minus(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
RFLOAT(FloatOfTerm(t1)-mpz_get_d(BigIntOfTerm(t2))); RFLOAT(FloatOfTerm(t1)-mpz_get_d(_YAP_BigIntOfTerm(t2)));
} }
#endif #endif
default: default:
@ -339,17 +339,17 @@ p_minus(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, l1, i2); mpz_sub_ui(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
RBIG(l1); RBIG(l1);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, l1, -i2); mpz_add_ui(new, l1, -i2);
RBIG(new); RBIG(new);
@ -358,18 +358,18 @@ p_minus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_sub(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
{ {
RFLOAT(mpz_get_d(BigIntOfTerm(t1))-FloatOfTerm(t2)); RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))-FloatOfTerm(t2));
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -397,17 +397,17 @@ p_minus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
if (v1.Int > 0) { if (v1.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, v2.big, v1.Int); mpz_sub_ui(new, v2.big, v1.Int);
mpz_neg(new, new); mpz_neg(new, new);
RBIG(new); RBIG(new);
} else if (v1.Int == 0) { } else if (v1.Int == 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_neg(new, v2.big); mpz_neg(new, v2.big);
RBIG(new); RBIG(new);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, v2.big, -v1.Int); mpz_add_ui(new, v2.big, -v1.Int);
mpz_neg(new, new); mpz_neg(new, new);
@ -442,14 +442,14 @@ p_minus(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* big * integer */ /* big * integer */
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub_ui(new, v1.big, v2.Int); mpz_sub_ui(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
RBIG(v1.big); RBIG(v1.big);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_add_ui(new, v2.big, -v1.Int); mpz_add_ui(new, v2.big, -v1.Int);
RBIG(new); RBIG(new);
@ -460,7 +460,7 @@ p_minus(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_sub(new, v1.big, v2.big); mpz_sub(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -504,7 +504,7 @@ times_int(Int i1, Int i2 E_ARGS) {
RINT(z); RINT(z);
overflow: overflow:
{ {
MP_INT *new = InitBigNum(i1); MP_INT *new = _YAP_InitBigNum(i1);
if (i2 > 0) { if (i2 > 0) {
mpz_mul_ui(new, new, i2); mpz_mul_ui(new, new, i2);
RBIG(new); RBIG(new);
@ -549,16 +549,16 @@ p_times(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
Int i1 = IntegerOfTerm(t1); Int i1 = IntegerOfTerm(t1);
MP_INT *l2 = BigIntOfTerm(t2); MP_INT *l2 = _YAP_BigIntOfTerm(t2);
if (i1 > 0) { if (i1 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, l2, i1); mpz_mul_ui(new, l2, i1);
RBIG(new); RBIG(new);
} else if (i1 == 0) { } else if (i1 == 0) {
RINT(0); RINT(0);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, l2, -i1); mpz_mul_ui(new, l2, -i1);
mpz_neg(new, new); mpz_neg(new, new);
@ -587,7 +587,7 @@ p_times(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
RFLOAT(FloatOfTerm(t1)*mpz_get_d(BigIntOfTerm(t2))); RFLOAT(FloatOfTerm(t1)*mpz_get_d(_YAP_BigIntOfTerm(t2)));
} }
#endif #endif
default: default:
@ -605,17 +605,17 @@ p_times(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, l1, i2); mpz_mul_ui(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
RINT(0); RINT(0);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, l1, -i2); mpz_mul_ui(new, l1, -i2);
mpz_neg(new, new); mpz_neg(new, new);
@ -625,18 +625,18 @@ p_times(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_mul(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
{ {
RFLOAT(mpz_get_d(BigIntOfTerm(t1))*FloatOfTerm(t2)); RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))*FloatOfTerm(t2));
} }
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -664,14 +664,14 @@ p_times(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
{ {
if (v1.Int > 0) { if (v1.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, v2.big, v1.Int); mpz_mul_ui(new, v2.big, v1.Int);
RBIG(new); RBIG(new);
} else if (v1.Int == 0) { } else if (v1.Int == 0) {
RINT(0); RINT(0);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, v2.big, -v1.Int); mpz_mul_ui(new, v2.big, -v1.Int);
mpz_neg(new, new); mpz_neg(new, new);
@ -706,14 +706,14 @@ p_times(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* big * integer */ /* big * integer */
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, v1.big, v2.Int); mpz_mul_ui(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
RINT(0); RINT(0);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_ui(new, v2.big, -v1.Int); mpz_mul_ui(new, v2.big, -v1.Int);
mpz_neg(new, new); mpz_neg(new, new);
@ -725,7 +725,7 @@ p_times(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul(new, v1.big, v2.big); mpz_mul(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -762,7 +762,7 @@ p_div(Term t1, Term t2 E_ARGS)
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
if (i2 == 0) { if (i2 == 0) {
Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2"); _YAP_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -770,7 +770,7 @@ p_div(Term t1, Term t2 E_ARGS)
RINT(IntegerOfTerm(t1) / i2); RINT(IntegerOfTerm(t1) / i2);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -787,7 +787,7 @@ p_div(Term t1, Term t2 E_ARGS)
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "// /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -799,20 +799,20 @@ p_div(Term t1, Term t2 E_ARGS)
/* dividing a bignum by an integer */ /* dividing a bignum by an integer */
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_ui(new, l1, i2); mpz_tdiv_q_ui(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2"); _YAP_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_ui(new, l1, -i2); mpz_tdiv_q_ui(new, l1, -i2);
mpz_neg(new, new); mpz_neg(new, new);
@ -822,19 +822,19 @@ p_div(Term t1, Term t2 E_ARGS)
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_tdiv_q(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -853,14 +853,14 @@ p_div(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* two integers */ /* two integers */
if (v2.Int == 0) { if (v2.Int == 0) {
Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2"); _YAP_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} }
RINT(v1.Int / v2.Int); RINT(v1.Int / v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -870,11 +870,11 @@ p_div(Term t1, Term t2 E_ARGS)
RINT(0); RINT(0);
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "// /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -883,17 +883,17 @@ p_div(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* big // integer */ /* big // integer */
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_ui(new, v1.big, v2.Int); mpz_tdiv_q_ui(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2"); _YAP_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_ui(new, v2.big, -v1.Int); mpz_tdiv_q_ui(new, v2.big, -v1.Int);
mpz_neg(new, new); mpz_neg(new, new);
@ -901,14 +901,14 @@ p_div(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q(new, v1.big, v2.big); mpz_tdiv_q(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -943,13 +943,13 @@ p_and(Term t1, Term t2 E_ARGS)
/* two integers */ /* two integers */
RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2)); RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2));
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
unsigned long int i2 = mpz_get_ui(BigIntOfTerm(t2)); unsigned long int i2 = mpz_get_ui(_YAP_BigIntOfTerm(t2));
RINT(IntegerOfTerm(t1) & i2); RINT(IntegerOfTerm(t1) & i2);
} }
#endif #endif
@ -961,7 +961,7 @@ p_and(Term t1, Term t2 E_ARGS)
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "/\\ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -972,25 +972,25 @@ p_and(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* anding a bignum with an integer is easy */ /* anding a bignum with an integer is easy */
{ {
unsigned long int i1 = mpz_get_ui(BigIntOfTerm(t1)); unsigned long int i1 = mpz_get_ui(_YAP_BigIntOfTerm(t1));
RINT(i1 & IntegerOfTerm(t2)); RINT(i1 & IntegerOfTerm(t2));
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_and(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_and(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -1009,7 +1009,7 @@ p_and(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
RINT(v1.Int & v2.Int); RINT(v1.Int & v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
@ -1021,11 +1021,11 @@ p_and(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "/\\ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1039,14 +1039,14 @@ p_and(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_and(new, v1.big, v2.big); mpz_and(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -1081,16 +1081,16 @@ p_or(Term t1, Term t2 E_ARGS)
/* two integers */ /* two integers */
RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2)); RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2));
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t1)); mpz_set_si(new,IntOfTerm(t1));
mpz_ior(new, new, BigIntOfTerm(t2)); mpz_ior(new, new, _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
#endif #endif
@ -1102,7 +1102,7 @@ p_or(Term t1, Term t2 E_ARGS)
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "\\/ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1112,28 +1112,28 @@ p_or(Term t1, Term t2 E_ARGS)
switch (BlobOfFunctor(f2)) { switch (BlobOfFunctor(f2)) {
case long_int_e: case long_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t2)); mpz_set_si(new,IntOfTerm(t2));
mpz_ior(new, BigIntOfTerm(t1), new); mpz_ior(new, _YAP_BigIntOfTerm(t1), new);
RBIG(new); RBIG(new);
} }
case big_int_e: case big_int_e:
/* two bignums */ /* two bignums */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_ior(new, BigIntOfTerm(t1), BigIntOfTerm(t2)); mpz_ior(new, _YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2));
RBIG(new); RBIG(new);
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -1152,14 +1152,14 @@ p_or(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
RINT(v1.Int | v2.Int); RINT(v1.Int | v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,v1.Int); mpz_set_si(new,v1.Int);
@ -1168,11 +1168,11 @@ p_or(Term t1, Term t2 E_ARGS)
} }
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "\\/ /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1181,7 +1181,7 @@ p_or(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
/* anding a bignum with an integer is easy */ /* anding a bignum with an integer is easy */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new, v2.Int); mpz_set_si(new, v2.Int);
mpz_ior(new, v1.big, new); mpz_ior(new, v1.big, new);
@ -1189,14 +1189,14 @@ p_or(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big // float */ /* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big * big */ /* big * big */
{ {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_ior(new, v1.big, v2.big); mpz_ior(new, v1.big, v2.big);
RBIG(new); RBIG(new);
@ -1234,12 +1234,12 @@ p_sll(Term t1, Term t2 E_ARGS)
/* two integers */ /* two integers */
RINT(IntegerOfTerm(t1) << IntegerOfTerm(t2)); RINT(IntegerOfTerm(t1) << IntegerOfTerm(t2));
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "<</2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#endif #endif
@ -1251,7 +1251,7 @@ p_sll(Term t1, Term t2 E_ARGS)
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, "<< /2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, "<< /2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1262,33 +1262,33 @@ p_sll(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_2exp(new, l1, i2); mpz_mul_2exp(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
RBIG(l1); RBIG(l1);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_2exp(new, l1, -i2); mpz_tdiv_q_2exp(new, l1, -i2);
RBIG(new); RBIG(new);
} }
} }
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, "<</2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, "<</2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -1307,22 +1307,22 @@ p_sll(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
RINT(v1.Int << v2.Int); RINT(v1.Int << v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "<</2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1332,13 +1332,13 @@ p_sll(Term t1, Term t2 E_ARGS)
/* big << int */ /* big << int */
{ {
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_2exp(new, v1.big, v2.Int); mpz_mul_2exp(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
RBIG(v1.big); RBIG(v1.big);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_2exp(new, v1.big, -v2.Int); mpz_tdiv_q_2exp(new, v1.big, -v2.Int);
RBIG(new); RBIG(new);
@ -1346,13 +1346,13 @@ p_sll(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big << float */ /* big << float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big << big */ /* big << big */
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
@ -1388,12 +1388,12 @@ p_slr(Term t1, Term t2 E_ARGS)
/* two integers */ /* two integers */
RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2)); RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2));
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#endif #endif
@ -1405,7 +1405,7 @@ p_slr(Term t1, Term t2 E_ARGS)
} }
break; break;
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t1, ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, t1, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1416,33 +1416,33 @@ p_slr(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
{ {
Int i2 = IntegerOfTerm(t2); Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1); MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) { if (i2 > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_2exp(new, l1, i2); mpz_tdiv_q_2exp(new, l1, i2);
RBIG(new); RBIG(new);
} else if (i2 == 0) { } else if (i2 == 0) {
RBIG(l1); RBIG(l1);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_2exp(new, l1, -i2); mpz_mul_2exp(new, l1, -i2);
RBIG(new); RBIG(new);
} }
} }
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, t2, ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:
/* we've got a full term, need to evaluate it first */ /* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1); v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e; bt1 = big_int_e;
bt2 = ArithIEval(t2, &v2); bt2 = ArithIEval(t2, &v2);
break; break;
@ -1461,22 +1461,22 @@ p_slr(Term t1, Term t2 E_ARGS)
case long_int_e: case long_int_e:
RINT(v1.Int >> v2.Int); RINT(v1.Int >> v2.Int);
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
case big_int_e: case big_int_e:
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#endif #endif
default: default:
/* Error */ /* _YAP_Error */
RERROR(); RERROR();
} }
case double_e: case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
#ifdef USE_GMP #ifdef USE_GMP
@ -1486,13 +1486,13 @@ p_slr(Term t1, Term t2 E_ARGS)
/* big >> int */ /* big >> int */
{ {
if (v2.Int > 0) { if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_tdiv_q_2exp(new, v1.big, v2.Int); mpz_tdiv_q_2exp(new, v1.big, v2.Int);
RBIG(new); RBIG(new);
} else if (v2.Int == 0) { } else if (v2.Int == 0) {
RBIG(v1.big); RBIG(v1.big);
} else { } else {
MP_INT *new = PreAllocBigNum(); MP_INT *new = _YAP_PreAllocBigNum();
mpz_mul_2exp(new, v1.big, -v2.Int); mpz_mul_2exp(new, v1.big, -v2.Int);
RBIG(new); RBIG(new);
@ -1500,13 +1500,13 @@ p_slr(Term t1, Term t2 E_ARGS)
} }
case double_e: case double_e:
/* big >> float */ /* big >> float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2"); _YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2");
/* make GCC happy */ /* make GCC happy */
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
case big_int_e: case big_int_e:
/* big >> big */ /* big >> big */
Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); _YAP_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
RERROR(); RERROR();
default: default:

21
H/clause.h
View File

@ -116,24 +116,9 @@ typedef struct clause_struct {
#define CL_IN_USE(X) ((X)->ClFlags & InUseMask) #define CL_IN_USE(X) ((X)->ClFlags & InUseMask)
#endif #endif
extern int c_mask;
extern CELL c_store;
extern int pred_type;
extern PredEntry *pred_p;
extern PredEntry *CurrentPred;
/* debugger info */
extern yamop *P_before_spy;
/* cdmgr.c */ /* cdmgr.c */
void STD_PROTO(RemoveLogUpdIndex,(Clause *)); void STD_PROTO(_YAP_RemoveLogUpdIndex,(Clause *));
void STD_PROTO(IPred,(CODEADDR sp)); void STD_PROTO(_YAP_IPred,(CODEADDR sp));
/* dbase.c */ /* dbase.c */
void STD_PROTO(ErCl,(Clause *)); void STD_PROTO(_YAP_ErCl,(Clause *));

31
H/compile.h
View File

@ -250,30 +250,17 @@ typedef struct CEXPENTRY {
#define Two 2 #define Two 2
void STD_PROTO(emit,(compiler_vm_op,Int,CELL)); CODEADDR STD_PROTO(_YAP_assemble,(int));
void STD_PROTO(emit_3ops,(compiler_vm_op,CELL,CELL,CELL)); void STD_PROTO(_YAP_emit,(compiler_vm_op,Int,CELL));
CELL *STD_PROTO(emit_extra_size,(compiler_vm_op,CELL,int)); void STD_PROTO(_YAP_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
char *STD_PROTO(AllocCMem,(int)); CELL *STD_PROTO(_YAP_emit_extra_size,(compiler_vm_op,CELL,int));
int STD_PROTO(is_a_test_pred,(Term, SMALLUNSGN)); char *STD_PROTO(_YAP_AllocCMem,(int));
void STD_PROTO(bip_name,(Int, char *)); int STD_PROTO(_YAP_is_a_test_pred,(Term, SMALLUNSGN));
void STD_PROTO(_YAP_bip_name,(Int, char *));
#ifdef DEBUG #ifdef DEBUG
void STD_PROTO(ShowCode,(void)); void STD_PROTO(_YAP_ShowCode,(void));
#endif /* DEBUG */ #endif /* DEBUG */
extern PInstr *cpc, *CodeStart; extern jmp_buf _YAP_CompilerBotch;
extern PInstr *icpc, *BlobsStart;
extern char *freep, *freep0;
extern int *label_offset;
extern int IPredArity;
extern jmp_buf CompilerBotch;
extern int profiling;
extern int call_counting;

20
H/eval.h
View File

@ -50,8 +50,8 @@ typedef union arith_ret {
/* /*
#define RINT(v) return(MkIntegerTerm(v)) #define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v)) #define RFLOAT(v) return(MkFloatTerm(v))
#define RBIG(v) return(MkBigIntTerm(v)) #define RBIG(v) return(_YAP_MkBigIntTerm(v))
#define RBIG_FL(v) return(MkBigIntTerm((MP_INT *)(Int)v)) #define RBIG_FL(v) return(_YAP_MkBigIntTerm((MP_INT *)(Int)v))
#define RERROR() return(MkIntTerm(0)) #define RERROR() return(MkIntTerm(0))
*/ */
@ -88,14 +88,14 @@ Functor STD_PROTO(EvalArg,(Term,arith_retptr));
#define FL(X) ((double)(X)) #define FL(X) ((double)(X))
#endif #endif
extern yap_error_number YAP_matherror; extern yap_error_number _YAP_matherror;
void STD_PROTO(InitConstExps,(void)); void STD_PROTO(_YAP_InitConstExps,(void));
void STD_PROTO(InitUnaryExps,(void)); void STD_PROTO(_YAP_InitUnaryExps,(void));
void STD_PROTO(InitBinaryExps,(void)); void STD_PROTO(_YAP_InitBinaryExps,(void));
int STD_PROTO(ReInitConstExps,(void)); int STD_PROTO(_YAP_ReInitConstExps,(void));
int STD_PROTO(ReInitUnaryExps,(void)); int STD_PROTO(_YAP_ReInitUnaryExps,(void));
int STD_PROTO(ReInitBinaryExps,(void)); int STD_PROTO(_YAP_ReInitBinaryExps,(void));
blob_type STD_PROTO(Eval,(Term, union arith_ret *)); blob_type STD_PROTO(_YAP_Eval,(Term, union arith_ret *));

10
H/heapgc.h
View File

@ -51,7 +51,7 @@
#define ONHEAP(ptr) (CellPtr(ptr) >= H0 && CellPtr(ptr) < H) #define ONHEAP(ptr) (CellPtr(ptr) >= H0 && CellPtr(ptr) < H)
/* is ptr a pointer to code space? */ /* is ptr a pointer to code space? */
#define ONCODE(ptr) (Addr(ptr) < HeapTop && Addr(ptr) >= HeapBase) #define ONCODE(ptr) (Addr(ptr) < HeapTop && Addr(ptr) >= _YAP_HeapBase)
/* is val pointing to something bound to the heap? */ /* is val pointing to something bound to the heap? */
@ -138,9 +138,9 @@ typedef CELL *CELL_PTR;
#define ENVSIZE(E) EnvSize(((CELL *)E)[E_CP]) #define ENVSIZE(E) EnvSize(((CELL *)E)[E_CP])
extern Int total_marked; void STD_PROTO(_YAP_mark_variable, (CELL *));
void STD_PROTO(_YAP_mark_external_reference, (CELL *));
void STD_PROTO(mark_variable, (CELL *)); void STD_PROTO(_YAP_inc_mark_variable, (void));
void STD_PROTO(mark_external_reference, (CELL *));

15
H/iopreds.h
View File

@ -23,9 +23,6 @@ static char SccsId[] = "%W% %G%";
* *
*/ */
/* if we botched in a LongIO operation */
jmp_buf IOBotch;
#if HAVE_LIBREADLINE #if HAVE_LIBREADLINE
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
@ -34,7 +31,7 @@ FILE *rl_instream, *rl_outstream;
#endif #endif
typedef struct typedef struct stream_desc
{ {
union { union {
struct { struct {
@ -77,8 +74,6 @@ StreamDesc;
#define MaxStreams 32 #define MaxStreams 32
StreamDesc Stream[MaxStreams];
#define Free_Stream_f 0x000001 #define Free_Stream_f 0x000001
#define Output_Stream_f 0x000002 #define Output_Stream_f 0x000002
#define Input_Stream_f 0x000004 #define Input_Stream_f 0x000004
@ -108,15 +103,11 @@ StreamDesc Stream[MaxStreams];
#define ALIASES_BLOCK_SIZE 8 #define ALIASES_BLOCK_SIZE 8
#if USE_SOCKET void STD_PROTO (_YAP_InitStdStreams, (void));
extern int YP_sockets_io;
#endif
void STD_PROTO (InitStdStreams, (void));
EXTERN inline int EXTERN inline int
GetCurInpPos (void) GetCurInpPos (void)
{ {
return (Stream[c_input_stream].linecount); return (Stream[_YAP_c_input_stream].linecount);
} }

74
H/rheap.h
View File

@ -39,37 +39,37 @@ restore_codes(void)
{ {
heap_regs->heap_top = AddrAdjust(OldHeapTop); heap_regs->heap_top = AddrAdjust(OldHeapTop);
#ifdef YAPOR #ifdef YAPOR
heap_regs->getworkfirsttimecode.opc = opcode(_getwork_first_time); heap_regs->getworkfirsttimecode.opc = _YAP_opcode(_getwork_first_time);
heap_regs->getworkcode.opc = opcode(_getwork); heap_regs->getworkcode.opc = _YAP_opcode(_getwork);
INIT_YAMOP_LTT(&(heap_regs->getworkcode), 0); INIT_YAMOP_LTT(&(heap_regs->getworkcode), 0);
heap_regs->getworkcode_seq.opc = opcode(_getwork_seq); heap_regs->getworkcode_seq.opc = _YAP_opcode(_getwork_seq);
INIT_YAMOP_LTT(&(heap_regs->getworkcode_seq), 0); INIT_YAMOP_LTT(&(heap_regs->getworkcode_seq), 0);
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
heap_regs->tablecompletioncode.opc = opcode(_table_completion); heap_regs->tablecompletioncode.opc = _YAP_opcode(_table_completion);
heap_regs->tableanswerresolutioncode.opc = opcode(_table_answer_resolution); heap_regs->tableanswerresolutioncode.opc = _YAP_opcode(_table_answer_resolution);
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->tablecompletioncode), 0); INIT_YAMOP_LTT(&(heap_regs->tablecompletioncode), 0);
INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0); INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0);
#endif /* YAPOR */ #endif /* YAPOR */
#endif /* TABLING */ #endif /* TABLING */
heap_regs->failcode = opcode(_op_fail); heap_regs->failcode = _YAP_opcode(_op_fail);
heap_regs->failcode_1 = opcode(_op_fail); heap_regs->failcode_1 = _YAP_opcode(_op_fail);
heap_regs->failcode_2 = opcode(_op_fail); heap_regs->failcode_2 = _YAP_opcode(_op_fail);
heap_regs->failcode_3 = opcode(_op_fail); heap_regs->failcode_3 = _YAP_opcode(_op_fail);
heap_regs->failcode_4 = opcode(_op_fail); heap_regs->failcode_4 = _YAP_opcode(_op_fail);
heap_regs->failcode_5 = opcode(_op_fail); heap_regs->failcode_5 = _YAP_opcode(_op_fail);
heap_regs->failcode_6 = opcode(_op_fail); heap_regs->failcode_6 = _YAP_opcode(_op_fail);
heap_regs->env_for_trustfail_code.op = opcode(_call); heap_regs->env_for_trustfail_code.op = _YAP_opcode(_call);
heap_regs->trustfailcode = opcode(_trust_fail); heap_regs->trustfailcode = _YAP_opcode(_trust_fail);
heap_regs->env_for_yes_code.op = opcode(_call); heap_regs->env_for_yes_code.op = _YAP_opcode(_call);
heap_regs->yescode.opc = opcode(_Ystop); heap_regs->yescode.opc = _YAP_opcode(_Ystop);
heap_regs->undef_op = opcode(_undef_p); heap_regs->undef_op = _YAP_opcode(_undef_p);
heap_regs->index_op = opcode(_index_pred); heap_regs->index_op = _YAP_opcode(_index_pred);
heap_regs->fail_op = opcode(_op_fail); heap_regs->fail_op = _YAP_opcode(_op_fail);
heap_regs->nocode.opc = opcode(_Nstop); heap_regs->nocode.opc = _YAP_opcode(_Nstop);
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->nocode), 1); INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
#endif /* YAPOR */ #endif /* YAPOR */
@ -77,7 +77,7 @@ restore_codes(void)
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1); INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1);
#endif /* YAPOR */ #endif /* YAPOR */
((yamop *)(&heap_regs->rtrycode))->opc = opcode(_retry_and_mark); ((yamop *)(&heap_regs->rtrycode))->opc = _YAP_opcode(_retry_and_mark);
if (((yamop *)(&heap_regs->rtrycode))->u.ld.d != NIL) if (((yamop *)(&heap_regs->rtrycode))->u.ld.d != NIL)
((yamop *)(&heap_regs->rtrycode))->u.ld.d = ((yamop *)(&heap_regs->rtrycode))->u.ld.d =
CodeAddrAdjust(((yamop *)(&heap_regs->rtrycode))->u.ld.d); CodeAddrAdjust(((yamop *)(&heap_regs->rtrycode))->u.ld.d);
@ -305,6 +305,10 @@ restore_codes(void)
heap_regs->dyn_array_list = heap_regs->dyn_array_list =
(struct array_entry *)AddrAdjust((ADDR)heap_regs->dyn_array_list); (struct array_entry *)AddrAdjust((ADDR)heap_regs->dyn_array_list);
} }
if (heap_regs->file_aliases != NULL) {
heap_regs->yap_streams =
(struct stream_desc *)AddrAdjust((ADDR)heap_regs->yap_streams);
}
if (heap_regs->file_aliases != NULL) { if (heap_regs->file_aliases != NULL) {
heap_regs->file_aliases = heap_regs->file_aliases =
(struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases); (struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases);
@ -486,7 +490,7 @@ RestoreDBEntry(DBRef dbr)
if (dbr->Flags & DBWithRefs) { if (dbr->Flags & DBWithRefs) {
DBRef *cp; DBRef *cp;
DBRef tm; DBRef tm;
cp = (DBRef *) ((CODEADDR) dbr + SizeOfBlock(CodePtr(dbr))); cp = (DBRef *) ((CODEADDR) dbr + _YAP_SizeOfBlock(CodePtr(dbr)));
while ((tm = *--cp) != 0) while ((tm = *--cp) != 0)
*cp = DBRefAdjust(tm); *cp = DBRefAdjust(tm);
} }
@ -584,8 +588,8 @@ RestoreClause(Clause *Cl, int mode)
/* Get the stored operator */ /* Get the stored operator */
pc = Cl->ClCode; pc = Cl->ClCode;
do { do {
op_numbers op = op_from_opcode(pc->opc); op_numbers op = _YAP_op_from_opcode(pc->opc);
pc->opc = opcode(op); pc->opc = _YAP_opcode(op);
#ifdef DEBUG_RESTORE2 #ifdef DEBUG_RESTORE2
YP_fprintf(errout, "%s\n", op_names[op]); YP_fprintf(errout, "%s\n", op_names[op]);
#endif #endif
@ -864,7 +868,7 @@ RestoreClause(Clause *Cl, int mode)
case _save_pair_x: case _save_pair_x:
case _save_appl_x_write: case _save_appl_x_write:
case _save_appl_x: case _save_appl_x:
pc->u.ox.opcw = opcode(op_from_opcode(pc->u.ox.opcw)); pc->u.ox.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.ox.opcw));
pc->u.ox.x = XAdjust(pc->u.ox.x); pc->u.ox.x = XAdjust(pc->u.ox.x);
pc = NEXTOP(pc,ox); pc = NEXTOP(pc,ox);
break; break;
@ -873,7 +877,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_x_var2_write: case _unify_x_var2_write:
case _unify_l_x_var2: case _unify_l_x_var2:
case _unify_l_x_var2_write: case _unify_l_x_var2_write:
pc->u.oxx.opcw = opcode(op_from_opcode(pc->u.oxx.opcw)); pc->u.oxx.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.oxx.opcw));
pc->u.oxx.xl = XAdjust(pc->u.oxx.xl); pc->u.oxx.xl = XAdjust(pc->u.oxx.xl);
pc->u.oxx.xr = XAdjust(pc->u.oxx.xr); pc->u.oxx.xr = XAdjust(pc->u.oxx.xr);
pc = NEXTOP(pc,oxx); pc = NEXTOP(pc,oxx);
@ -895,7 +899,7 @@ RestoreClause(Clause *Cl, int mode)
case _save_pair_y: case _save_pair_y:
case _save_appl_y_write: case _save_appl_y_write:
case _save_appl_y: case _save_appl_y:
pc->u.oy.opcw = opcode(op_from_opcode(pc->u.oy.opcw)); pc->u.oy.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.oy.opcw));
pc->u.oy.y = YAdjust(pc->u.oy.y); pc->u.oy.y = YAdjust(pc->u.oy.y);
pc = NEXTOP(pc,oy); pc = NEXTOP(pc,oy);
break; break;
@ -908,7 +912,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_list: case _unify_list:
case _unify_l_list_write: case _unify_l_list_write:
case _unify_l_list: case _unify_l_list:
pc->u.o.opcw = opcode(op_from_opcode(pc->u.o.opcw)); pc->u.o.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.o.opcw));
pc = NEXTOP(pc,o); pc = NEXTOP(pc,o);
break; break;
/* instructions type os */ /* instructions type os */
@ -916,7 +920,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_n_voids: case _unify_n_voids:
case _unify_l_n_voids_write: case _unify_l_n_voids_write:
case _unify_l_n_voids: case _unify_l_n_voids:
pc->u.os.opcw = opcode(op_from_opcode(pc->u.os.opcw)); pc->u.os.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.os.opcw));
pc = NEXTOP(pc,os); pc = NEXTOP(pc,os);
break; break;
/* instructions type oc */ /* instructions type oc */
@ -930,7 +934,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_l_longint: case _unify_l_longint:
case _unify_bigint: case _unify_bigint:
case _unify_l_bigint: case _unify_l_bigint:
pc->u.oc.opcw = opcode(op_from_opcode(pc->u.oc.opcw)); pc->u.oc.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.oc.opcw));
{ {
Term t = pc->u.oc.c; Term t = pc->u.oc.c;
if (IsAtomTerm(t)) if (IsAtomTerm(t))
@ -943,7 +947,7 @@ RestoreClause(Clause *Cl, int mode)
/* instructions type osc */ /* instructions type osc */
case _unify_n_atoms_write: case _unify_n_atoms_write:
case _unify_n_atoms: case _unify_n_atoms:
pc->u.osc.opcw = opcode(op_from_opcode(pc->u.osc.opcw)); pc->u.osc.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.osc.opcw));
{ {
Term t = pc->u.osc.c; Term t = pc->u.osc.c;
if (IsAtomTerm(t)) if (IsAtomTerm(t))
@ -956,7 +960,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_struct: case _unify_struct:
case _unify_l_struc_write: case _unify_l_struc_write:
case _unify_l_struc: case _unify_l_struc:
pc->u.of.opcw = opcode(op_from_opcode(pc->u.of.opcw)); pc->u.of.opcw = _YAP_opcode(_YAP_op_from_opcode(pc->u.of.opcw));
pc->u.of.f = FuncAdjust(pc->u.of.f); pc->u.of.f = FuncAdjust(pc->u.of.f);
pc = NEXTOP(pc,of); pc = NEXTOP(pc,of);
break; break;
@ -1059,7 +1063,7 @@ RestoreClause(Clause *Cl, int mode)
break; break;
/* instructions type ollll */ /* instructions type ollll */
case _switch_list_nl_prefetch: case _switch_list_nl_prefetch:
pc->u.ollll.pop = opcode(op_from_opcode(pc->u.ollll.pop)); pc->u.ollll.pop = _YAP_opcode(_YAP_op_from_opcode(pc->u.ollll.pop));
pc->u.ollll.l1 = CodeAddrAdjust(pc->u.ollll.l1); pc->u.ollll.l1 = CodeAddrAdjust(pc->u.ollll.l1);
pc->u.ollll.l2 = CodeAddrAdjust(pc->u.ollll.l2); pc->u.ollll.l2 = CodeAddrAdjust(pc->u.ollll.l2);
pc->u.ollll.l3 = CodeAddrAdjust(pc->u.ollll.l3); pc->u.ollll.l3 = CodeAddrAdjust(pc->u.ollll.l3);
@ -1454,7 +1458,7 @@ CleanCode(PredEntry *pp)
pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred)); pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
if (pp->OwnerFile) if (pp->OwnerFile)
pp->OwnerFile = AtomAdjust(pp->OwnerFile); pp->OwnerFile = AtomAdjust(pp->OwnerFile);
pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred)); pp->OpcodeOfPred = _YAP_opcode(_YAP_op_from_opcode(pp->OpcodeOfPred));
if (pp->PredFlags & CPredFlag) { if (pp->PredFlags & CPredFlag) {
if (pp->PredFlags & BinaryTestPredFlag) { if (pp->PredFlags & BinaryTestPredFlag) {
pp->TrueCodeOfPred = DirectCCodeAdjust(pp,pp->TrueCodeOfPred); pp->TrueCodeOfPred = DirectCCodeAdjust(pp,pp->TrueCodeOfPred);
@ -1615,7 +1619,7 @@ RestoreEntries(PropEntry *pp)
break; break;
default: default:
/* OOPS */ /* OOPS */
Error(SYSTEM_ERROR, TermNil, _YAP_Error(SYSTEM_ERROR, TermNil,
"Invalid Atom Property %d at %p", pp->KindOfPE, pp); "Invalid Atom Property %d at %p", pp->KindOfPE, pp);
return; return;
} }

4
H/tracer.h
View File

@ -27,10 +27,10 @@ typedef enum {
} yap_low_level_port; } yap_low_level_port;
void STD_PROTO(low_level_trace,(yap_low_level_port, PredEntry *, CELL *)); void STD_PROTO(low_level_trace,(yap_low_level_port, PredEntry *, CELL *));
void STD_PROTO(InitLowLevelTrace,(void)); void STD_PROTO(_YAP_InitLowLevelTrace,(void));
void STD_PROTO(toggle_low_level_trace,(void)); void STD_PROTO(toggle_low_level_trace,(void));
extern int do_low_level_trace; extern int _YAP_do_low_level_trace;
#endif #endif

89
H/yapio.h
View File

@ -62,13 +62,11 @@
#endif #endif
#define YP_FILE FILE #define YP_FILE FILE
extern int YP_stdin; extern YP_FILE *_YAP_stdin;
extern int YP_stdout; extern YP_FILE *_YAP_stdout;
extern int YP_stderr; extern YP_FILE *_YAP_stderr;
int STD_PROTO(YP_fprintf,(int, char *, ...));
int STD_PROTO(YP_putc,(int, int)); int STD_PROTO(YP_putc,(int, int));
int STD_PROTO(YP_fflush,(int));
#else #else
@ -100,7 +98,6 @@ int STD_PROTO(YP_fflush,(int));
/* flags for files in IOSTREAM struct */ /* flags for files in IOSTREAM struct */
#define _YP_IO_WRITE 1 #define _YP_IO_WRITE 1
#define _YP_IO_READ 2 #define _YP_IO_READ 2
@ -171,7 +168,7 @@ extern YP_FILE yp_iob[YP_MAX_FILES];
#define YAP_FILENAME_MAX 1024 /* This is ok for Linux, should be ok for everyone */ #define YAP_FILENAME_MAX 1024 /* This is ok for Linux, should be ok for everyone */
#endif #endif
extern char FileNameBuf[YAP_FILENAME_MAX], FileNameBuf2[YAP_FILENAME_MAX]; extern char _YAP_FileNameBuf[YAP_FILENAME_MAX], _YAP_FileNameBuf2[YAP_FILENAME_MAX];
typedef YP_FILE *YP_File; typedef YP_FILE *YP_File;
@ -230,14 +227,14 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
af_unix /* or AF_FILE */ af_unix /* or AF_FILE */
} socket_domain; } socket_domain;
Term STD_PROTO(InitSocketStream,(int, socket_info, socket_domain)); Term STD_PROTO(_YAP_InitSocketStream,(int, socket_info, socket_domain));
int STD_PROTO(CheckSocketStream,(Term, char *)); int STD_PROTO(_YAP_CheckSocketStream,(Term, char *));
socket_domain STD_PROTO(GetSocketDomain,(int)); socket_domain STD_PROTO(_YAP_GetSocketDomain,(int));
socket_info STD_PROTO(GetSocketStatus,(int)); socket_info STD_PROTO(_YAP_GetSocketStatus,(int));
void STD_PROTO(UpdateSocketStream,(int, socket_info, socket_domain)); void STD_PROTO(_YAP_UpdateSocketStream,(int, socket_info, socket_domain));
/* routines in ypsocks.c */ /* routines in ypsocks.c */
Int CloseSocket(int, socket_info, socket_domain); Int STD_PROTO(_YAP_CloseSocket,(int, socket_info, socket_domain));
#endif /* USE_SOCKET */ #endif /* USE_SOCKET */
@ -249,36 +246,42 @@ typedef struct AliasDescS {
/****************** character definition table **************************/ /****************** character definition table **************************/
#define NUMBER_OF_CHARS 256 #define NUMBER_OF_CHARS 256
extern char *chtype; extern char *_YAP_chtype;
/*************** variables concerned with parsing *********************/ /*************** variables concerned with parsing *********************/
extern TokEntry *tokptr, *toktide; extern TokEntry *_YAP_tokptr, *_YAP_toktide;
extern VarEntry *VarTable, *AnonVarTable; extern VarEntry *_YAP_VarTable, *_YAP_AnonVarTable;
extern int eot_before_eof; extern int _YAP_eot_before_eof;
/* parser stack, used to be AuxSp, now is ASP */ /* parser stack, used to be AuxSp, now is ASP */
#define ParserAuxSp (TR) #define ParserAuxSp (TR)
/* routines in parser.c */ /* routines in parser.c */
VarEntry STD_PROTO(*LookupVar,(char *)); VarEntry STD_PROTO(*_YAP_LookupVar,(char *));
Term STD_PROTO(VarNames,(VarEntry *,Term)); Term STD_PROTO(_YAP_VarNames,(VarEntry *,Term));
/* routines ins scanner.c */ /* routines ins scanner.c */
TokEntry STD_PROTO(*tokenizer,(int (*)(int), int (*)(int))); TokEntry STD_PROTO(*_YAP_tokenizer,(int (*)(int), int (*)(int)));
TokEntry STD_PROTO(*fast_tokenizer,(void)); TokEntry STD_PROTO(*_YAP_fast_tokenizer,(void));
Term STD_PROTO(scan_num,(int (*)(int))); Term STD_PROTO(_YAP_scan_num,(int (*)(int)));
char STD_PROTO(*_YAP_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */ /* routines in iopreds.c */
Int STD_PROTO(FirstLineInParse,(void)); Int STD_PROTO(_YAP_FirstLineInParse,(void));
int STD_PROTO(CheckIOStream,(Term, char *)); int STD_PROTO(_YAP_CheckIOStream,(Term, char *));
int STD_PROTO(GetStreamFd,(int)); int STD_PROTO(_YAP_GetStreamFd,(int));
void STD_PROTO(CloseStream,(int)); void STD_PROTO(_YAP_CloseStreams,(int));
int STD_PROTO(PlGetchar,(void)); void STD_PROTO(_YAP_CloseStream,(int));
int STD_PROTO(PlFGetchar,(void)); int STD_PROTO(_YAP_PlGetchar,(void));
int STD_PROTO(StreamToFileNo,(Term)); int STD_PROTO(_YAP_PlFGetchar,(void));
int STD_PROTO(_YAP_GetCharForSIGINT,(void));
int STD_PROTO(_YAP_StreamToFileNo,(Term));
Term STD_PROTO(_YAP_OpenStream,(FILE *,char *,Term,int));
extern int c_input_stream, c_output_stream, c_error_stream; extern int
_YAP_c_input_stream,
_YAP_c_output_stream,
_YAP_c_error_stream;
#define YAP_INPUT_STREAM 0x01 #define YAP_INPUT_STREAM 0x01
#define YAP_OUTPUT_STREAM 0x02 #define YAP_OUTPUT_STREAM 0x02
@ -289,21 +292,19 @@ extern int c_input_stream, c_output_stream, c_error_stream;
#define YAP_BINARY_STREAM 0x40 #define YAP_BINARY_STREAM 0x40
#define YAP_SEEKABLE_STREAM 0x80 #define YAP_SEEKABLE_STREAM 0x80
Term STD_PROTO(OpenStream,(FILE *,char *,Term,int));
#define Quote_illegal_f 1 #define Quote_illegal_f 1
#define Ignore_ops_f 2 #define Ignore_ops_f 2
#define Handle_vars_f 4 #define Handle_vars_f 4
#define Use_portray_f 8 #define Use_portray_f 8
/* routines in sysbits.c */
char *STD_PROTO(pfgets,(char *,int,YP_File));
/* write.c */ /* write.c */
void STD_PROTO(plwrite,(Term,int (*)(int, int),int)); void STD_PROTO(_YAP_plwrite,(Term,int (*)(int, int),int));
/* grow.c */ /* grow.c */
int STD_PROTO(growstack_in_parser, (tr_fr_ptr *, TokEntry **, VarEntry **)); int STD_PROTO(_YAP_growstack_in_parser, (tr_fr_ptr *, TokEntry **, VarEntry **));
#if HAVE_ERRNO_H #if HAVE_ERRNO_H
#include <errno.h> #include <errno.h>
@ -313,7 +314,7 @@ extern int errno;
#if DEBUG #if DEBUG
#if COROUTINING #if COROUTINING
extern int Portray_delays; extern int _YAP_Portray_delays;
#endif #endif
#endif #endif
@ -324,11 +325,13 @@ extern int Portray_delays;
#define CONTINUE_ON_PARSER_ERROR 2 #define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3 #define EXCEPTION_ON_PARSER_ERROR 3
extern jmp_buf IOBotch; extern jmp_buf _YAP_IOBotch;
extern int in_getc; #ifdef DEBUG
extern YP_FILE *_YAP_logfile;
#ifdef HAVE_LIBREADLINE #endif
extern char *_line;
#if USE_SOCKET
extern int _YAP_sockets_io;
#endif #endif

2
H/yerror.h
View File

@ -30,5 +30,3 @@
#define EXIT_AFTER_ERROR 2 #define EXIT_AFTER_ERROR 2
extern int STD_PROTO(ErrorHandler,(char *,int));

24
OPTYap/opt.memory.c
View File

@ -127,7 +127,7 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
TrailAuxArea = ADJUST_SIZE(TrailAuxArea * KBYTES); TrailAuxArea = ADJUST_SIZE(TrailAuxArea * KBYTES);
/* we'll need this later */ /* we'll need this later */
GlobalBase = mmap_addr + HeapArea; _YAP_GlobalBase = mmap_addr + HeapArea;
/* model dependent */ /* model dependent */
/* shared memory allocation */ /* shared memory allocation */
@ -168,14 +168,14 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
/* just allocate local space for stacks */ /* just allocate local space for stacks */
if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0) if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0)
abort_optyap("open error in function map_memory: %s", strerror(errno)); abort_optyap("open error in function map_memory: %s", strerror(errno));
if (mmap(GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE, if (mmap(_YAP_GlobalBase, GlobalLocalArea + TrailAuxArea, PROT_READ|PROT_WRITE,
MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1) MAP_PRIVATE|MAP_FIXED, private_fd_mapfile, 0) == (void *) -1)
abort_optyap("mmap error in function map_memory: %s", strerror(errno)); abort_optyap("mmap error in function map_memory: %s", strerror(errno));
close(private_fd_mapfile); close(private_fd_mapfile);
#else /* ENV_COPY or SBA */ #else /* ENV_COPY or SBA */
for (i = 0; i < n_workers; i++) { for (i = 0; i < n_workers; i++) {
/* initialize worker vars */ /* initialize worker vars */
worker_area(i) = GlobalBase + i * WorkerArea; worker_area(i) = _YAP_GlobalBase + i * WorkerArea;
worker_offset(i) = worker_area(i) - worker_area(0); worker_offset(i) = worker_area(i) - worker_area(0);
#ifdef SHM_MEMORY_MAPPING_SCHEME #ifdef SHM_MEMORY_MAPPING_SCHEME
/* mapping worker area */ /* mapping worker area */
@ -199,11 +199,11 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
if ((CELL)binding_array & MBIT) { if ((CELL)binding_array & MBIT) {
abort_optyap("OOPS: binding_array start address %p conflicts with tag %x used in IDB", binding_array, MBIT); abort_optyap("OOPS: binding_array start address %p conflicts with tag %x used in IDB", binding_array, MBIT);
} }
sba_offset = binding_array - GlobalBase; sba_offset = binding_array - _YAP_GlobalBase;
sba_end = (int)binding_array + sba_size; sba_end = (int)binding_array + sba_size;
#endif /* SBA */ #endif /* SBA */
TrailBase = GlobalBase + GlobalLocalArea; _YAP_TrailBase = _YAP_GlobalBase + GlobalLocalArea;
LocalBase = TrailBase - CellSize; _YAP_LocalBase = _YAP_TrailBase - CellSize;
if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */ if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */
@ -212,9 +212,9 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
TrailTop = TrailBase + TrailAuxArea / 2; TrailTop = TrailBase + TrailAuxArea / 2;
AuxTop = TrailBase + TrailAuxArea - CellSize; AuxTop = _YAP_TrailBase + TrailAuxArea - CellSize;
AuxSp = (CELL *) AuxTop; AuxSp = (CELL *) AuxTop;
YAP_InitHeap(mmap_addr); _YAP_InitHeap(mmap_addr);
BaseWorkArea = mmap_addr; BaseWorkArea = mmap_addr;
} }
@ -292,10 +292,10 @@ void remap_memory(void) {
/* setup workers so that they have different areas */ /* setup workers so that they have different areas */
long WorkerArea = worker_offset(1); long WorkerArea = worker_offset(1);
GlobalBase += worker_id * WorkerArea; _YAP_GlobalBase += worker_id * WorkerArea;
TrailBase += worker_id * WorkerArea; _YAP_TrailBase += worker_id * WorkerArea;
LocalBase += worker_id * WorkerArea; _YAP_LocalBase += worker_id * WorkerArea;
TrailTop += worker_id * WorkerArea; _YAP_TrailTop += worker_id * WorkerArea;
AuxTop += worker_id * WorkerArea; AuxTop += worker_id * WorkerArea;
AuxSp = (CELL *) AuxTop; AuxSp = (CELL *) AuxTop;
#endif /* SBA */ #endif /* SBA */

2
OPTYap/opt.misc.c
View File

@ -82,7 +82,7 @@ void information_message(const char *mesg,...) {
** ------------------------- */ ** ------------------------- */
int tabling_putchar(int sno, int ch) { int tabling_putchar(int sno, int ch) {
return(YP_putc(ch, stderr)); return(putc(ch, stderr));
} }
#endif /* TABLING_DEBUG */ #endif /* TABLING_DEBUG */

48
OPTYap/opt.preds.c
View File

@ -68,28 +68,28 @@ static int p_debug_prolog(void);
** Global functions ** ** Global functions **
** -------------------------- */ ** -------------------------- */
void init_optyap_preds(void) { void _YAP_init_optyap_preds(void) {
InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag); _YAP_InitCPred("$default_sequential", 1, p_default_sequential, SafePredFlag);
#ifdef YAPOR #ifdef YAPOR
InitCPred("$yapor_on", 0, yapor_on, SafePredFlag); _YAP_InitCPred("$yapor_on", 0, yapor_on, SafePredFlag);
InitCPred("$start_yapor", 0, start_yapor, SafePredFlag); _YAP_InitCPred("$start_yapor", 0, start_yapor, SafePredFlag);
InitCPred("$sequential", 1, p_sequential, SafePredFlag); _YAP_InitCPred("$sequential", 1, p_sequential, SafePredFlag);
InitCPred("execution_mode", 1, p_execution_mode, SafePredFlag); _YAP_InitCPred("execution_mode", 1, p_execution_mode, SafePredFlag);
InitCPred("performance", 1, p_performance, SafePredFlag); _YAP_InitCPred("performance", 1, p_performance, SafePredFlag);
InitCPred("$parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag); _YAP_InitCPred("$parallel_new_answer", 1, p_parallel_new_answer, SafePredFlag);
InitCPred("$parallel_yes_answer", 0, p_parallel_yes_answer, SafePredFlag); _YAP_InitCPred("$parallel_yes_answer", 0, p_parallel_yes_answer, SafePredFlag);
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
InitCPred("$do_table", 2, p_table, SafePredFlag); _YAP_InitCPred("$do_table", 2, p_table, SafePredFlag);
InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag); _YAP_InitCPred("$do_abolish_trie", 2, p_abolish_trie, SafePredFlag);
InitCPred("$show_trie", 3, p_show_trie, SafePredFlag); _YAP_InitCPred("$show_trie", 3, p_show_trie, SafePredFlag);
InitCPred("$resume_trie", 2, p_resume_trie, SafePredFlag); _YAP_InitCPred("$resume_trie", 2, p_resume_trie, SafePredFlag);
#endif /* TABLING */ #endif /* TABLING */
#ifdef STATISTICS #ifdef STATISTICS
InitCPred("show_frames", 0, p_show_frames, SafePredFlag); _YAP_InitCPred("show_frames", 0, p_show_frames, SafePredFlag);
#endif /* STATISTICS */ #endif /* STATISTICS */
#if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS) #if defined(YAPOR_ERRORS) || defined(TABLING_ERRORS)
InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag); _YAP_InitCPred("debug_prolog", 1, p_debug_prolog, SafePredFlag);
#endif /* YAPOR_ERRORS || TABLING_ERRORS */ #endif /* YAPOR_ERRORS || TABLING_ERRORS */
} }
@ -116,9 +116,9 @@ int p_default_sequential(void) {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Term ta; Term ta;
if (SEQUENTIAL_IS_DEFAULT) if (SEQUENTIAL_IS_DEFAULT)
ta = MkAtomTerm(LookupAtom("on")); ta = MkAtomTerm(_YAP_LookupAtom("on"));
else else
ta = MkAtomTerm(LookupAtom("off")); ta = MkAtomTerm(_YAP_LookupAtom("off"));
Bind((CELL *)t, ta); Bind((CELL *)t, ta);
return(TRUE); return(TRUE);
} }
@ -147,7 +147,7 @@ realtime current_time(void) {
/* to get time as Yap */ /* to get time as Yap */
/* /*
double now, interval; double now, interval;
cputime_interval(&now, &interval); _YAP_cputime_interval(&now, &interval);
return ((realtime)now); return ((realtime)now);
*/ */
struct timeval tempo; struct timeval tempo;
@ -222,9 +222,9 @@ int p_execution_mode(void) {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Term ta; Term ta;
if (PARALLEL_EXECUTION_MODE) if (PARALLEL_EXECUTION_MODE)
ta = MkAtomTerm(LookupAtom("parallel")); ta = MkAtomTerm(_YAP_LookupAtom("parallel"));
else else
ta = MkAtomTerm(LookupAtom("sequential")); ta = MkAtomTerm(_YAP_LookupAtom("sequential"));
Bind((CELL *)t, ta); Bind((CELL *)t, ta);
return(TRUE); return(TRUE);
} }
@ -255,9 +255,9 @@ int p_performance(void) {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Term ta; Term ta;
if (GLOBAL_performance_mode & PERFORMANCE_ON) { if (GLOBAL_performance_mode & PERFORMANCE_ON) {
ta = MkAtomTerm(LookupAtom("on")); ta = MkAtomTerm(_YAP_LookupAtom("on"));
} else { } else {
ta = MkAtomTerm(LookupAtom("off")); ta = MkAtomTerm(_YAP_LookupAtom("off"));
} }
Bind((CELL *)t, ta); Bind((CELL *)t, ta);
return(TRUE); return(TRUE);
@ -325,7 +325,7 @@ int p_parallel_new_answer(void) {
length_answer = 0; length_answer = 0;
ALLOC_QG_ANSWER_FRAME(actual_answer); ALLOC_QG_ANSWER_FRAME(actual_answer);
plwrite(ARG1, parallel_new_answer_putchar, 4); _YAP_plwrite(ARG1, parallel_new_answer_putchar, 4);
AnsFr_answer(actual_answer)[length_answer] = 0; AnsFr_answer(actual_answer)[length_answer] = 0;
AnsFr_next(actual_answer) = NULL; AnsFr_next(actual_answer) = NULL;
leftmost_or_fr = CUT_leftmost_or_frame(); leftmost_or_fr = CUT_leftmost_or_frame();
@ -557,7 +557,7 @@ int p_show_trie(void) {
t2 = Deref(ARG3); t2 = Deref(ARG3);
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Term ta = MkAtomTerm(LookupAtom("stdout")); Term ta = MkAtomTerm(_YAP_LookupAtom("stdout"));
Bind((CELL *)t2, ta); Bind((CELL *)t2, ta);
traverse_trie(stderr, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE); traverse_trie(stderr, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
} else if (IsAtomTerm(t2)) { } else if (IsAtomTerm(t2)) {

2
OPTYap/or.engine.c
View File

@ -303,7 +303,7 @@ sync_with_p:
#ifdef YAPOR_ERRORS #ifdef YAPOR_ERRORS
if ((CELL *)aux_cell < H0) if ((CELL *)aux_cell < H0)
YAPOR_ERROR_MESSAGE("aux_cell < H0 (q_share_work)"); YAPOR_ERROR_MESSAGE("aux_cell < H0 (q_share_work)");
if ((ADDR)aux_cell > LocalBase) if ((ADDR)aux_cell > _YAP_LocalBase)
YAPOR_ERROR_MESSAGE("aux_cell > LocalBase (q_share_work)"); YAPOR_ERROR_MESSAGE("aux_cell > LocalBase (q_share_work)");
#endif /* YAPOR_ERRORS */ #endif /* YAPOR_ERRORS */
#ifdef TABLING #ifdef TABLING

4
OPTYap/sbaunify.h
View File

@ -30,7 +30,7 @@ static inline
Int bind_variable(Term t0, Term t1) Int bind_variable(Term t0, Term t1)
{ {
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) { if (_YAP_IUnify(t0,t1)) {
return(TRUE); return(TRUE);
} else { } else {
while(TR != TR0) { while(TR != TR0) {
@ -48,7 +48,7 @@ Int unify(Term t0, Term t1)
Int unify(Term t0, Term t1) Int unify(Term t0, Term t1)
{ {
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) { if (_YAP_IUnify(t0,t1)) {
return(TRUE); return(TRUE);
} else { } else {
while(TR != TR0) { while(TR != TR0) {

2
OPTYap/tab.macros.h
View File

@ -93,7 +93,7 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
CELL *NEW_STACK; \ CELL *NEW_STACK; \
UInt diff; \ UInt diff; \
char *OldTrailTop = (char *)TrailTop; \ char *OldTrailTop = (char *)TrailTop; \
growtrail(64 * 1024L); \ _YAP_growtrail(64 * 1024Lf); \
diff = (char *)TrailTop - OldTrailTop; \ diff = (char *)TrailTop - OldTrailTop; \
NEW_STACK = (CELL *)((char *)(STACK)+diff); \ NEW_STACK = (CELL *)((char *)(STACK)+diff); \
memmove((void *)NEW_STACK, (void *)(STACK), (char *)OldTrailTop-(char *)STACK); \ memmove((void *)NEW_STACK, (void *)(STACK), (char *)OldTrailTop-(char *)STACK); \

6
OPTYap/tab.tries.c
View File

@ -1494,7 +1494,7 @@ update_next_trie_branch:
} }
TrNode_or_arg(node) = ltt; TrNode_or_arg(node) = ltt;
TrNode_instr(node) = opcode(TrNode_instr(node)); TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return ltt; return ltt;
} }
#else #else
@ -1512,7 +1512,7 @@ int update_answer_trie_branch(ans_node_ptr node) {
ltt = 1; ltt = 1;
} }
TrNode_or_arg(node) = ltt; TrNode_or_arg(node) = ltt;
TrNode_instr(node) = opcode(TrNode_instr(node)); TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return ltt; return ltt;
} }
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */
@ -1528,7 +1528,7 @@ void update_answer_trie_branch(ans_node_ptr node) {
} else { } else {
TrNode_instr(node) -= 2; /* retry --> trust : try --> do */ TrNode_instr(node) -= 2; /* retry --> trust : try --> do */
} }
TrNode_instr(node) = opcode(TrNode_instr(node)); TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return; return;
} }
#endif /* YAPOR */ #endif /* YAPOR */

18
library/mpi/mpe.c
View File

@ -9,14 +9,14 @@
************************************************************************** **************************************************************************
* * * *
* File: mpe.c * * File: mpe.c *
* Last rev: $Date: 2002-02-27 13:41:24 $ * * Last rev: $Date: 2002-11-11 17:38:03 $ *
* mods: * * mods: *
* comments: Interface to an MPE library * * comments: Interface to an MPE library *
* * * *
*************************************************************************/ *************************************************************************/
#ifndef lint #ifndef lint
static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpe.c,v 1.3 2002-02-27 13:41:24 stasinos Exp $"; static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpe.c,v 1.4 2002-11-11 17:38:03 vsc Exp $";
#endif #endif
#include "Yap.h" #include "Yap.h"
@ -204,14 +204,14 @@ p_log() /* mpe_log(+EventType, +EventNum, +EventStr) */
void void
InitMPE(void) _YAP_InitMPE(void)
{ {
InitCPred( "mpe_open", 0, p_init, SafePredFlag ); _YAP_InitCPred( "mpe_open", 0, p_init, SafePredFlag );
InitCPred( "mpe_start", 0, p_start, SafePredFlag ); _YAP_InitCPred( "mpe_start", 0, p_start, SafePredFlag );
InitCPred( "mpe_close", 1, p_close, SafePredFlag ); _YAP_InitCPred( "mpe_close", 1, p_close, SafePredFlag );
InitCPred( "mpe_create_event", 1, p_create_event, SafePredFlag ); _YAP_InitCPred( "mpe_create_event", 1, p_create_event, SafePredFlag );
InitCPred( "mpe_create_state", 4, p_create_state, SafePredFlag ); _YAP_InitCPred( "mpe_create_state", 4, p_create_state, SafePredFlag );
InitCPred( "mpe_log", 3, p_log, SafePredFlag ); _YAP_InitCPred( "mpe_log", 3, p_log, SafePredFlag );
} }
#endif /* HAVE_MPE */ #endif /* HAVE_MPE */

22
library/mpi/mpi.c
View File

@ -9,14 +9,14 @@
************************************************************************** **************************************************************************
* * * *
* File: mpi.c * * File: mpi.c *
* Last rev: $Date: 2002-11-05 11:14:08 $ * * Last rev: $Date: 2002-11-11 17:38:06 $ *
* mods: * * mods: *
* comments: Interface to an MPI library * * comments: Interface to an MPI library *
* * * *
*************************************************************************/ *************************************************************************/
#ifndef lint #ifndef lint
static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpi.c,v 1.13 2002-11-05 11:14:08 stasinos Exp $"; static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpi.c,v 1.14 2002-11-11 17:38:06 vsc Exp $";
#endif #endif
#include "Yap.h" #include "Yap.h"
@ -654,7 +654,7 @@ p_mpi_barrier() /* mpi_barrier/0 */
void void
InitMPI(void) _YAP_InitMPI(void)
{ {
int i,j; int i,j;
@ -690,7 +690,7 @@ InitMPI(void)
} }
#endif #endif
/* With MPICH MPI_Init() must be called during initialisation, /* With MPICH MPI__YAP_Init() must be called during initialisation,
but with LAM it can be called from Prolog (mpi_open/3). but with LAM it can be called from Prolog (mpi_open/3).
See also the comment at "if ! HAVE_LIBMPICH" above! See also the comment at "if ! HAVE_LIBMPICH" above!
*/ */
@ -715,13 +715,13 @@ InitMPI(void)
} }
#endif #endif
InitCPred( "mpi_open", 3, p_mpi_open, SafePredFlag|SyncPredFlag ); _YAP_InitCPred( "mpi_open", 3, p_mpi_open, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_close", 0, p_mpi_close, SyncPredFlag ); _YAP_InitCPred( "mpi_close", 0, p_mpi_close, SyncPredFlag );
InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag ); _YAP_InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_receive", 3, p_mpi_receive, SafePredFlag|SyncPredFlag ); _YAP_InitCPred( "mpi_receive", 3, p_mpi_receive, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SafePredFlag|SyncPredFlag ); _YAP_InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SafePredFlag|SyncPredFlag ); _YAP_InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_barrier", 0, p_mpi_barrier, SyncPredFlag ); _YAP_InitCPred( "mpi_barrier", 0, p_mpi_barrier, SyncPredFlag );
} }
#endif /* HAVE_MPI */ #endif /* HAVE_MPI */

6
library/system/Makefile.in
View File

@ -43,9 +43,7 @@ all: @NEWSHOBJ@
sobjs: $(SOBJS) sobjs: $(SOBJS)
dll: sys@SHLIB_SUFFIX@ sys.o $(srcdir)/sys.c
sys.o: $(srcdir)/sys.c
$(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/sys.c -o sys.o $(CC) -c $(CFLAGS) $(SHLIB_CFLAGS) $(srcdir)/sys.c -o sys.o
@DO_SECOND_LD@@DO_SECOND_LD@%@SHLIB_SUFFIX@: %.o @DO_SECOND_LD@@DO_SECOND_LD@%@SHLIB_SUFFIX@: %.o
@ -55,7 +53,7 @@ sys.o: $(srcdir)/sys.c
@DO_SECOND_LD@ @SHLIB_LD@ -o sys@SHLIB_SUFFIX@ sys.o @DO_SECOND_LD@ @SHLIB_LD@ -o sys@SHLIB_SUFFIX@ sys.o
# #
# create a new DLL library on cygwin environments # create a new DLL library on mingw32 environments
# #
# DLLNAME: name of the new dll # DLLNAME: name of the new dll
# OBJS: list of object files I want to put in # OBJS: list of object files I want to put in

14
m4/TermExt.h.m4
View File

@ -10,7 +10,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.m4,v 1.6 2002-06-03 16:14:30 vsc Exp $ * * version: $Id: TermExt.h.m4,v 1.7 2002-11-11 17:38:07 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#if USE_OFFSETS #if USE_OFFSETS
@ -162,11 +162,11 @@ Inline(IsLongIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == Functor
#include <gmp.h> #include <gmp.h>
MP_INT *STD_PROTO(PreAllocBigNum,(void)); MP_INT *STD_PROTO(_YAP_PreAllocBigNum,(void));
MP_INT *STD_PROTO(InitBigNum,(Int)); MP_INT *STD_PROTO(_YAP_InitBigNum,(Int));
Term STD_PROTO(MkBigIntTerm, (MP_INT *)); Term STD_PROTO(_YAP_MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO(BigIntOfTerm, (Term)); MP_INT *STD_PROTO(_YAP_BigIntOfTerm, (Term));
void STD_PROTO(CleanBigNum,(void)); void STD_PROTO(_YAP_CleanBigNum,(void));
Inline(IsBigIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt) Inline(IsBigIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt)
@ -222,7 +222,7 @@ unify_extension(Functor f, CELL d0, CELL *pt0, CELL d1)
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(_YAP_BigIntOfTerm(d0),_YAP_BigIntOfTerm(d1)) == 0);
#endif /* USE_GMP */ #endif /* USE_GMP */
case double_e: case double_e:
{ {

136
m4/Yap.h.m4
View File

@ -10,7 +10,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.m4,v 1.35 2002-10-23 20:55:37 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.36 2002-11-11 17:38:08 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -234,7 +234,7 @@ typedef unsigned long int YAP_LONG_LONG;
#endif #endif
#if DEBUG #if DEBUG
extern char Option[20]; extern char _YAP_Option[20];
#endif #endif
/* #define FORCE_SECOND_QUADRANT 1 */ /* #define FORCE_SECOND_QUADRANT 1 */
@ -260,7 +260,7 @@ extern char Option[20];
#elif defined(_WIN32) #elif defined(_WIN32)
#define MMAP_ADDR 0x18000000L #define MMAP_ADDR 0x18000000L
#elif defined(__CYGWIN__) #elif defined(__CYGWIN__)
#define MMAP_ADDR 0x20040000L #define MMAP_ADDR 0x30000000L
#endif #endif
#endif /* !IN_SECOND_QUADRANT */ #endif /* !IN_SECOND_QUADRANT */
@ -268,8 +268,8 @@ extern char Option[20];
#define HEAP_INIT_BASE (MMAP_ADDR) #define HEAP_INIT_BASE (MMAP_ADDR)
#define AtomBase ((char *)MMAP_ADDR) #define AtomBase ((char *)MMAP_ADDR)
#else #else
#define HEAP_INIT_BASE ((CELL)HeapBase) #define HEAP_INIT_BASE ((CELL)_YAP_HeapBase)
#define AtomBase (HeapBase) #define AtomBase (_YAP_HeapBase)
#endif #endif
@ -393,7 +393,7 @@ typedef volatile int lockvar;
#define siglongjmp(Env, Arg) longjmp(Env, Arg) #define siglongjmp(Env, Arg) longjmp(Env, Arg)
#endif #endif
extern sigjmp_buf RestartEnv; /* used to restart after an abort */ extern sigjmp_buf _YAP_RestartEnv; /* used to restart after an abort */
/* Support for arrays */ /* Support for arrays */
#include "arrays.h" #include "arrays.h"
@ -485,9 +485,9 @@ typedef enum {
UNKNOWN_ERROR UNKNOWN_ERROR
} yap_error_number; } yap_error_number;
extern char *ErrorMessage; /* used to pass error messages */ extern char *_YAP_ErrorMessage; /* used to pass error messages */
extern Term Error_Term; /* used to pass error terms */ extern Term _YAP_Error_Term; /* used to pass error terms */
extern yap_error_number Error_TYPE; /* used to pass the error */ extern yap_error_number _YAP_Error_TYPE; /* used to pass the error */
typedef enum { typedef enum {
YAP_INT_BOUNDED_FLAG = 0, YAP_INT_BOUNDED_FLAG = 0,
@ -641,11 +641,11 @@ and RefOfTerm(t) : Term -> DBRef = ...
/************* variables related to memory allocation *******************/ /************* variables related to memory allocation *******************/
/* must be before TermExt.h */ /* must be before TermExt.h */
extern ADDR HeapBase, extern ADDR _YAP_HeapBase,
LocalBase, _YAP_LocalBase,
GlobalBase, _YAP_GlobalBase,
TrailBase, TrailTop, _YAP_TrailBase,
ForeignCodeBase, ForeignCodeTop, ForeignCodeMax; _YAP_TrailTop;
/* applies to unbound variables */ /* applies to unbound variables */
@ -672,6 +672,20 @@ Inline(MkIntTerm, Term, Int, n, TAGGED(NumberTag, (n)))
Inline(MkIntConstant, Term, Int, n, NONTAGGED(NumberTag, (n))) Inline(MkIntConstant, Term, Int, n, NONTAGGED(NumberTag, (n)))
Inline(IsIntTerm, int, Term, t, CHKTAG((t), NumberTag)) Inline(IsIntTerm, int, Term, t, CHKTAG((t), NumberTag))
EXTERN inline Term STD_PROTO(MkPairTerm,(Term,Term));
EXTERN inline Term
MkPairTerm(Term head, Term tail)
{
register CELL *p = H;
H[0] = head;
H[1] = tail;
H+=2;
return (AbsPair(p));
}
/* Needed to handle numbers: /* Needed to handle numbers:
these two macros are fundamental in the integer/float conversions */ these two macros are fundamental in the integer/float conversions */
@ -732,9 +746,6 @@ Inline(TailOfTermCell, Term, Term, t, (CELL)(RepPair(t) + 1))
/*************** variables concerned with atoms table *******************/ /*************** variables concerned with atoms table *******************/
#define MaxHash 1001 #define MaxHash 1001
/************ variables concerned with save and restore *************/
extern int splfild;
#define FAIL_RESTORE 0 #define FAIL_RESTORE 0
#define DO_EVERYTHING 1 #define DO_EVERYTHING 1
#define DO_ONLY_CODE 2 #define DO_ONLY_CODE 2
@ -749,9 +760,6 @@ extern int emacs_mode;
#endif #endif
/************ variable concerned with version number *****************/
extern char version_number[];
/********* common instructions codes*************************/ /********* common instructions codes*************************/
#define MAX_PROMPT 256 #define MAX_PROMPT 256
@ -766,12 +774,9 @@ typedef struct opcode_tab_entry {
#endif #endif
/******************* controlling the compiler ****************************/
extern int optimizer_on;
/******************* storing error messages ****************************/ /******************* storing error messages ****************************/
#define MAX_ERROR_MSG_SIZE 256 #define MAX_ERROR_MSG_SIZE 256
extern char ErrorSay[MAX_ERROR_MSG_SIZE]; extern char _YAP_ErrorSay[MAX_ERROR_MSG_SIZE];
/********************* how to write a Prolog term ***********************/ /********************* how to write a Prolog term ***********************/
@ -788,66 +793,63 @@ typedef enum {
ExtendStackMode = 128 /* trying to extend stack */ ExtendStackMode = 128 /* trying to extend stack */
} prolog_exec_mode; } prolog_exec_mode;
extern prolog_exec_mode PrologMode; extern prolog_exec_mode _YAP_PrologMode;
extern int CritLocks; extern int _YAP_CritLocks;
/************** Access to yap initial arguments ***************************/ /************** Access to yap initial arguments ***************************/
extern char **yap_args; extern char **_YAP_argv;
extern int yap_argc; extern int _YAP_argc;
/******************* controlling debugging ****************************/
extern int creep_on;
/******************* number of modules ****************************/ /******************* number of modules ****************************/
#define MaxModules 256 #define MaxModules 256
#ifdef YAPOR #ifdef YAPOR
#define YAPEnterCriticalSection() \ #define YAPEnterCriticalSection() \
{ \ { \
if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \ if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \
LOCK(GLOBAL_LOCKS_heap_access); \ LOCK(GLOBAL_LOCKS_heap_access); \
GLOBAL_LOCKS_who_locked_heap = worker_id; \ GLOBAL_LOCKS_who_locked_heap = worker_id; \
} \ } \
PrologMode |= CritMode; \ _YAP_PrologMode |= CritMode; \
CritLocks++; \ _YAP_CritLocks++; \
} }
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
{ \ { \
CritLocks--; \ _YAP_CritLocks--; \
if (!CritLocks) { \ if (!_YAP_CritLocks) { \
PrologMode &= ~CritMode; \ _YAP_PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \ if (_YAP_PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \ _YAP_PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \ _YAP_ProcessSIGINT(); \
} \ } \
if (PrologMode & AbortMode) { \ if (_YAP_PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \ _YAP_PrologMode &= ~AbortMode; \
Error(PURE_ABORT, 0, ""); \ _YAP_Error(PURE_ABORT, 0, ""); \
} \ } \
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() \ #define YAPEnterCriticalSection() \
{ \ { \
PrologMode |= CritMode; \ _YAP_PrologMode |= CritMode; \
CritLocks++; \ _YAP_CritLocks++; \
} }
#define YAPLeaveCriticalSection() \ #define YAPLeaveCriticalSection() \
{ \ { \
CritLocks--; \ _YAP_CritLocks--; \
if (!CritLocks) { \ if (!_YAP_CritLocks) { \
PrologMode &= ~CritMode; \ _YAP_PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \ if (_YAP_PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \ _YAP_PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \ _YAP_ProcessSIGINT(); \
} \ } \
if (PrologMode & AbortMode) { \ if (_YAP_PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \ _YAP_PrologMode &= ~AbortMode; \
Error(PURE_ABORT, 0, ""); \ _YAP_Error(PURE_ABORT, 0, ""); \
} \ } \
} \ } \
} }
@ -857,10 +859,6 @@ extern int creep_on;
#define AT_BOOT 0 #define AT_BOOT 0
#define AT_RESTORE 1 #define AT_RESTORE 1
/********* whether we should try to compile array references ******************/
extern int compile_arrays;
/********* mutable variables ******************/ /********* mutable variables ******************/
/* 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
@ -872,18 +870,10 @@ typedef struct TIMED_MAVAR{
/********* while debugging you may need some info ***********************/ /********* while debugging you may need some info ***********************/
#if DEBUG
extern int output_msg;
#endif
#if EMACS #if EMACS
extern char emacs_tmp[], emacs_tmp2[]; extern char emacs_tmp[], emacs_tmp2[];
#endif #endif
#if HAVE_SIGNAL
extern int snoozing;
#endif
#if defined(YAPOR) || defined(TABLING) #if defined(YAPOR) || defined(TABLING)
#include "opt.structs.h" #include "opt.structs.h"
#include "opt.macros.h" #include "opt.macros.h"

31
m4/Yatom.h.m4
View File

@ -248,8 +248,8 @@ typedef struct {
CmpPredicate f; CmpPredicate f;
} cmp_entry; } cmp_entry;
extern CPredicate c_predicates[MAX_C_PREDS]; extern CPredicate _YAP_c_predicates[MAX_C_PREDS];
extern cmp_entry cmp_funcs[MAX_CMP_FUNCS]; extern cmp_entry _YAP_cmp_funcs[MAX_CMP_FUNCS];
/* Flags for code or dbase entry */ /* Flags for code or dbase entry */
@ -487,23 +487,23 @@ Inline(IsArrayProperty, PropFlags, int, flags, (flags == ArrayProperty) )
/* Proto types */ /* Proto types */
/* cdmgr.c */ /* cdmgr.c */
int STD_PROTO(RemoveIndexation,(PredEntry *)); int STD_PROTO(_YAP_RemoveIndexation,(PredEntry *));
/* dbase.c */ /* dbase.c */
void STD_PROTO(ErDBE,(DBRef)); void STD_PROTO(_YAP_ErDBE,(DBRef));
DBRef STD_PROTO(StoreTermInDB,(int,int)); DBRef STD_PROTO(_YAP_StoreTermInDB,(int,int));
Term STD_PROTO(FetchTermFromDB,(DBRef,int)); Term STD_PROTO(_YAP_FetchTermFromDB,(DBRef,int));
void STD_PROTO(ReleaseTermFromDB,(DBRef)); void STD_PROTO(_YAP_ReleaseTermFromDB,(DBRef));
/* .c */ /* .c */
CODEADDR STD_PROTO(PredIsIndexable,(PredEntry *)); CODEADDR STD_PROTO(_YAP_PredIsIndexable,(PredEntry *));
/* init.c */ /* init.c */
Atom STD_PROTO(GetOp,(OpEntry *,int *,int)); Atom STD_PROTO(_YAP_GetOp,(OpEntry *,int *,int));
/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */ /* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
Prop STD_PROTO(GetAProp,(Atom,PropFlags)); Prop STD_PROTO(_YAP_GetAProp,(Atom,PropFlags));
Prop STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags)); Prop STD_PROTO(_YAP_GetAPropHavingLock,(AtomEntry *,PropFlags));
EXTERN inline Prop EXTERN inline Prop
PredPropByFunc(Functor f, SMALLUNSGN cur_mod) PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
@ -523,7 +523,7 @@ PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
} }
p0 = p->NextOfPE; p0 = p->NextOfPE;
} }
return(NewPredPropByFunctor(fe,cur_mod)); return(_YAP_NewPredPropByFunctor(fe,cur_mod));
} }
EXTERN inline Prop EXTERN inline Prop
@ -544,11 +544,12 @@ PredPropByAtom(Atom at, SMALLUNSGN cur_mod)
} }
p0 = pe->NextOfPE; p0 = pe->NextOfPE;
} }
return(NewPredPropByAtom(ae,cur_mod)); return(_YAP_NewPredPropByAtom(ae,cur_mod));
} }
ADDR STD_PROTO(_YAP_PreAllocCodeSpace, (void));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR)); void STD_PROTO(_YAP_ReleasePreAllocCodeSpace, (ADDR));
#else #else
#define ReleasePreAllocCodeSpace(x) #define _YAP_ReleasePreAllocCodeSpace(x)
#endif #endif

14
m4/sshift.h.m4
View File

@ -33,7 +33,7 @@ extern ADDR OldHeapBase, OldHeapTop;
#define CharP(ptr) ((char *) (ptr)) #define CharP(ptr) ((char *) (ptr))
Inline(IsHeapP, int, CELL *, ptr, (ptr >= (CELL *)HeapBase && ptr <= (CELL *)HeapTop) ) Inline(IsHeapP, int, CELL *, ptr, (ptr >= (CELL *)_YAP_HeapBase && ptr <= (CELL *)HeapTop) )
/* Adjusting cells and pointers to cells */ /* Adjusting cells and pointers to cells */
Inline(PtoGloAdjust, CELL *, CELL *, ptr, ((CELL *)(CharP(ptr) + GDiff)) ) Inline(PtoGloAdjust, CELL *, CELL *, ptr, ((CELL *)(CharP(ptr) + GDiff)) )
@ -85,11 +85,11 @@ Inline(PtoHeapCellAdjust, CELL *, CELL *, ptr, ((CELL *)(CharP(ptr) + HDiff)) )
Inline(PtoPredAdjust, PredEntry *, PredEntry *, ptr, ((PredEntry *)(CharP(ptr) + HDiff)) ) Inline(PtoPredAdjust, PredEntry *, PredEntry *, ptr, ((PredEntry *)(CharP(ptr) + HDiff)) )
Inline(PtoArrayEAdjust, ArrayEntry *, ArrayEntry *, ptr, ((ArrayEntry *)(CharP(ptr) + HDiff)) ) Inline(PtoArrayEAdjust, ArrayEntry *, ArrayEntry *, ptr, ((ArrayEntry *)(CharP(ptr) + HDiff)) )
#if PRECOMPUTE_REGADDRESS #if PRECOMPUTE_REGADDRESS
Inline(XAdjust, AREG, AREG, reg, (AREG)((reg)+XDiff) ) Inline(XAdjust, wamreg, wamreg, reg, (wamreg)((reg)+XDiff) )
#else #else
Inline(XAdjust, AREG, AREG, reg, (reg) ) Inline(XAdjust, wamreg, wamreg, reg, (reg) )
#endif #endif
Inline(YAdjust, YREG, YREG, reg, (reg) ) Inline(YAdjust, yslot, yslot, reg, (reg) )
Inline(IsOldLocal, int, CELL, reg, IN_BETWEEN(OldASP, reg, OldLCL0)) Inline(IsOldLocal, int, CELL, reg, IN_BETWEEN(OldASP, reg, OldLCL0))
@ -108,7 +108,7 @@ Inline(IsOldTrail, int, CELL, reg, IN_BETWEEN(OldTrailBase, reg, OldTR) )
Inline(IsOldTrailPtr, int, CELL *, ptr, IN_BETWEEN(OldTrailBase, ptr, OldTR) ) Inline(IsOldTrailPtr, int, CELL *, ptr, IN_BETWEEN(OldTrailBase, ptr, OldTR) )
Inline(IsOldCode, int, CELL, reg, IN_BETWEEN(OldHeapBase, reg, OldHeapTop) ) Inline(IsOldCode, int, CELL, reg, IN_BETWEEN(OldHeapBase, reg, OldHeapTop) )
Inline(IsOldCodeCellPtr, int, CELL *, ptr, IN_BETWEEN(OldHeapBase, ptr, OldHeapTop) ) Inline(IsOldCodeCellPtr, int, CELL *, ptr, IN_BETWEEN(OldHeapBase, ptr, OldHeapTop) )
Inline(IsGlobal, int, CELL, reg, IN_BETWEEN(GlobalBase, reg, H) ) Inline(IsGlobal, int, CELL, reg, IN_BETWEEN(_YAP_GlobalBase, reg, H) )
void STD_PROTO(AdjustStacksAndTrail, (void)); void STD_PROTO(_YAP_AdjustStacksAndTrail, (void));
void STD_PROTO(AdjustRegs, (int)); void STD_PROTO(_YAP_AdjustRegs, (int));

2
pl/listing.yap
View File

@ -19,6 +19,7 @@
*/ */
listing :- listing :-
current_output(Stream), current_output(Stream),
'$current_module'(Mod), '$current_module'(Mod),
@ -173,3 +174,4 @@ portray_clause(_).
'$list_transform'(L,N). '$list_transform'(L,N).
'$list_transform'('$VAR'(-1).L,M) :- !, '$list_transform'(L,M). '$list_transform'('$VAR'(-1).L,M) :- !, '$list_transform'(L,M).
'$list_transform'(_.L,M) :- '$list_transform'(L,M). '$list_transform'(_.L,M) :- '$list_transform'(L,M).

1
pl/strict_iso.yap
View File

@ -95,7 +95,6 @@
'$check_iso_system_goal'(G) :- '$check_iso_system_goal'(G) :-
'$do_error'(domain_error(builtin_procedure,G), G). '$do_error'(domain_error(builtin_procedure,G), G).
'$iso_builtin'(abolish(_)). '$iso_builtin'(abolish(_)).
'$iso_builtin'(arg(_,_,_)). '$iso_builtin'(arg(_,_,_)).
'$iso_builtin'(_=:=_). '$iso_builtin'(_=:=_).