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

50
C/agc.c
View File

@ -25,7 +25,7 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
#ifdef DEBUG
/* #define DEBUG_RESTORE2 1 */
#define errout YP_stderr
#define errout _YAP_stderr
#endif
STATIC_PROTO(void RestoreEntries, (PropEntry *));
@ -192,7 +192,7 @@ mark_atoms(void)
at = RepAtom(atm);
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif
RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE;
@ -209,7 +209,7 @@ mark_atoms(void)
}
do {
#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) {
printf("oops\n");
}
@ -227,7 +227,7 @@ mark_trail(void)
pt = (CELL *)TR;
/* moving the trail is simple */
while (pt != (CELL *)TrailBase) {
while (pt != (CELL *)_YAP_TrailBase) {
register CELL reg = pt[-1];
pt--;
if (!IsVarTerm(reg)) {
@ -266,7 +266,7 @@ mark_global(void)
* to clean the global now that functors are just variables pointing to
* the code
*/
pt = CellPtr(GlobalBase);
pt = CellPtr(_YAP_GlobalBase);
while (pt < H) {
register CELL reg;
@ -343,8 +343,8 @@ clean_atoms(void)
#endif
*patm = at->NextOfAE;
atm = at->NextOfAE;
agc_collected += SizeOfBlock((char *)at);
FreeCodeSpace((char *)at);
agc_collected += _YAP_SizeOfBlock((char *)at);
_YAP_FreeCodeSpace((char *)at);
}
}
HashPtr++;
@ -362,45 +362,51 @@ clean_atoms(void)
#endif
*patm = at->NextOfAE;
atm = at->NextOfAE;
agc_collected += SizeOfBlock((char *)at);
FreeCodeSpace((char *)at);
agc_collected += _YAP_SizeOfBlock((char *)at);
_YAP_FreeCodeSpace((char *)at);
}
}
}
void
static void
atom_gc(void)
{
int gc_verbose = is_gc_verbose();
int gc_verbose = _YAP_is_gc_verbose();
int gc_trace = 0;
Int time_start, agc_time;
if (GetValue(AtomGcTrace) != TermNil)
if (_YAP_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1;
agc_calls++;
agc_collected = 0;
if (gc_trace) {
YP_fprintf(YP_stderr, "[agc]\n");
fprintf(_YAP_stderr, "[agc]\n");
} 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 */
YAPEnterCriticalSection();
mark_stacks();
mark_atoms();
clean_atoms();
YAPLeaveCriticalSection();
agc_time = cputime()-time_start;
agc_time = _YAP_cputime()-time_start;
tot_agc_time += agc_time;
tot_agc_recovered += agc_collected;
if (gc_verbose) {
YP_fprintf(YP_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] collected %d bytes.\n", agc_collected);
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
p_atom_gc(void)
{
@ -417,13 +423,13 @@ p_inform_agc(void)
Term tt = MkIntegerTerm(agc_calls);
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
init_agc(void)
_YAP_init_agc(void)
{
InitCPred("$atom_gc", 0, p_atom_gc, 0);
InitCPred("$inform_agc", 3, p_inform_agc, 0);
_YAP_InitCPred("$atom_gc", 0, p_atom_gc, 0);
_YAP_InitCPred("$inform_agc", 3, p_inform_agc, 0);
}

279
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* 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
static char SccsId[] = "%W% %G%";
@ -76,7 +76,7 @@ STATIC_PROTO(void AddToFreeList, (BlockHeader *));
/* Yap workspace management */
int
SizeOfBlock(CODEADDR p)
_YAP_SizeOfBlock(CODEADDR p)
{
BlockHeader *b = (BlockHeader *) (p - sizeof(YAP_SEG_SIZE));
YAP_SEG_SIZE s = (b->b_size) & ~InUseFlag;
@ -155,10 +155,10 @@ FreeBlock(BlockHeader *b)
sp = &(b->b_size) + (b->b_size & ~InUseFlag);
if (*sp != b->b_size) {
#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));
#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);
#endif
return;
@ -265,7 +265,7 @@ AllocHeap(unsigned int size)
HeapUsed += size * sizeof(CELL) + sizeof(YAP_SEG_SIZE);
#ifdef YAPOR
if (HeapTop > Addr(GlobalBase) - MinHeapGap) {
if (HeapTop > Addr(_YAP_GlobalBase) - MinHeapGap) {
abort_optyap("No heap left in function AllocHeap");
}
#else
@ -278,7 +278,7 @@ AllocHeap(unsigned int size)
UNLOCK(HeapTopLock);
}
/* we destroyed the stack */
Error(SYSTEM_ERROR, TermNil, "Stack Crashed against Heap...");
_YAP_Error(SYSTEM_ERROR, TermNil, "Stack Crashed against Heap...");
return(NULL);
} else {
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
* the macro you should use */
ADDR
PreAllocCodeSpace(void)
_YAP_PreAllocCodeSpace(void)
{
LOCK(HeapTopLock);
HEAPTOP_OWN(worker_id);
@ -331,7 +331,7 @@ PreAllocCodeSpace(void)
/* 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 */
void
ReleasePreAllocCodeSpace(ADDR ptr)
_YAP_ReleasePreAllocCodeSpace(ADDR ptr)
{
HEAPTOP_DISOWN(worker_id);
UNLOCK(HeapTopLock);
@ -340,25 +340,33 @@ ReleasePreAllocCodeSpace(ADDR ptr)
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
void
static void
FreeCodeSpace(char *p)
{
FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
}
char *
AllocAtomSpace(unsigned int size)
{
return (AllocHeap(size));
}
/* If you need to dinamically allocate space from the heap, this is
* the macro you should use */
void
FreeAtomSpace(char *p)
_YAP_FreeCodeSpace(char *p)
{
FreeCodeSpace(p);
}
char *
_YAP_AllocAtomSpace(unsigned int size)
{
return (AllocHeap(size));
}
void
_YAP_FreeAtomSpace(char *p)
{
FreeCodeSpace(p);
}
static char *
AllocCodeSpace(unsigned int size)
{
if (size < SmallSize + 2 * OpCodeSize + 3 * CellSize)
@ -366,6 +374,12 @@ AllocCodeSpace(unsigned int size)
return (AllocHeap(size));
}
char *
_YAP_AllocCodeSpace(unsigned int size)
{
return AllocCodeSpace(size);
}
/************************************************************************/
/* Workspace allocation */
/* */
@ -379,10 +393,10 @@ AllocCodeSpace(unsigned int size)
/* functions: */
/* void *InitWorkSpace(int s) - initial workspace allocation */
/* 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"
@ -392,58 +406,57 @@ AllocCodeSpace(unsigned int size)
static LPVOID brk;
int
static int
ExtendWorkSpace(Int s)
{
LPVOID b;
prolog_exec_mode OldPrologMode = PrologMode;
prolog_exec_mode OldPrologMode = _YAP_PrologMode;
PrologMode = ExtendStackMode;
s = ((s-1)/page_size+1)*page_size;
_YAP_PrologMode = ExtendStackMode;
s = ((s-1)/_YAP_page_size+1)*_YAP_page_size;
b = VirtualAlloc(brk, s, MEM_COMMIT, PAGE_READWRITE);
if (b) {
brk = (LPVOID) ((Int) brk + s);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return TRUE;
}
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"VirtualAlloc could not commit %ld bytes",
(long int)s);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
MALLOC_T
static MALLOC_T
InitWorkSpace(Int s)
{
SYSTEM_INFO si;
LPVOID b;
GetSystemInfo(&si);
page_size = si.dwPageSize;
_YAP_page_size = si.dwPageSize;
b = VirtualAlloc(BASE_ADDRESS, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS);
if (b==NULL) {
fprintf(stderr,"[ Warning: YAP reserving space at a variable address ]\n");
b = VirtualAlloc(0x0, MAX_WORKSPACE, MEM_RESERVE, PAGE_NOACCESS);
if (b == NULL) {
Error(FATAL_ERROR,TermNil,"VirtualAlloc failed");
_YAP_Error(FATAL_ERROR,TermNil,"VirtualAlloc failed");
return(0);
}
fprintf(stderr,"[ Warning: YAP reserving space at variable address %p ]\n", b);
}
brk = BASE_ADDRESS;
if (ExtendWorkSpace(s)) {
return BASE_ADDRESS;
} else {
Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
_YAP_Error(FATAL_ERROR,TermNil,"VirtualAlloc Failed");
return(0);
}
}
int
FreeWorkSpace(void)
_YAP_FreeWorkSpace(void)
{
return TRUE;
}
@ -469,14 +482,13 @@ FreeWorkSpace(void)
static MALLOC_T WorkSpaceTop;
MALLOC_T
static MALLOC_T
InitWorkSpace(Int s)
{
MALLOC_T a;
#if !defined(_AIX) && !defined(__APPLE__) && !__hpux
int fd;
#endif
#if defined(_AIX)
a = mmap(0, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
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,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0);
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);
}
#elif defined(__APPLE__)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
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);
}
#else
@ -502,9 +514,9 @@ InitWorkSpace(Int s)
strncpy(file,"/tmp/YAP.TMPXXXXXX", 256);
if (mkstemp(file) == -1) {
#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
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
return NULL;
}
@ -519,21 +531,21 @@ InitWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR);
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;
}
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);
return FALSE;
}
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);
return NULL;
}
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);
return NULL;
}
@ -542,7 +554,7 @@ InitWorkSpace(Int s)
a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_FIXED, fd, 0);
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;
}
#else
@ -550,11 +562,11 @@ InitWorkSpace(Int s)
MAP_PRIVATE, fd, 0);
if ((CELL)a & YAP_PROTECTED_MASK) {
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;
}
if (close(fd) == -1) {
Error(FATAL_ERROR, TermNil, "while closing mmaped file");
_YAP_Error(FATAL_ERROR, TermNil, "while closing mmaped file");
return NULL;
}
#endif
@ -566,14 +578,14 @@ InitWorkSpace(Int s)
(a == (MALLOC_T) - 1)
#endif
{
Error(FATAL_ERROR, TermNil, "mmap cannot allocate memory ***");
_YAP_Error(FATAL_ERROR, TermNil, "mmap cannot allocate memory ***");
return(NULL);
}
WorkSpaceTop = (char *) a + s;
return (void *) a;
}
int
static int
ExtendWorkSpace(Int s)
{
#ifdef YAPOR
@ -582,36 +594,36 @@ ExtendWorkSpace(Int s)
#else
MALLOC_T a;
prolog_exec_mode OldPrologMode = PrologMode;
prolog_exec_mode OldPrologMode = _YAP_PrologMode;
#if defined(_AIX) || defined(__hpux)
PrologMode = ExtendStackMode;
_YAP_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
#elif defined(__APPLE__)
PrologMode = ExtendStackMode;
_YAP_PrologMode = ExtendStackMode;
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
#else
int fd;
PrologMode = ExtendStackMode;
_YAP_PrologMode = ExtendStackMode;
fd = open("/dev/zero", O_RDWR);
if (fd < 0) {
#if HAVE_MKSTEMP
char file[256];
strncpy(file,"/tmp/YAP.TMPXXXXXX",256);
if (mkstemp(file) == -1) {
ErrorMessage = ErrorSay;
_YAP_ErrorMessage = _YAP_ErrorSay;
#if HAVE_STRERROR
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE,
snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s (%s)",
file, strerror(errno));
#else
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mkstemp could not create temporary file %s", file);
#endif /* HAVE_STRERROR */
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
#else
@ -625,85 +637,85 @@ ExtendWorkSpace(Int s)
#endif /* HAVE_MKSTEMP */
fd = open(file, O_CREAT|O_RDWR);
if (fd < 0) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not open %s", file);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
if (lseek(fd, s, SEEK_SET) < 0) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not lseek in mmapped file %s", file);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
if (write(fd, "", 1) < 0) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not write in mmapped file %s", file);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
if (unlink(file) < 0) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not unlink mmapped file %s", file);
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
close(fd);
return FALSE;
}
}
a = mmap(WorkSpaceTop, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
MAP_PRIVATE
#ifndef __linux
#if !defined(__linux)
/* use MAP_FIXED, otherwise God knows where you will be placed */
|MAP_FIXED
#endif
, fd, 0);
if (close(fd) == -1) {
ErrorMessage = ErrorSay;
_YAP_ErrorMessage = _YAP_ErrorSay;
#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));
#else
snprintf3(ErrorMessage, MAX_ERROR_MSG_SIZE,
snprintf3(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not close file ]\n");
#endif
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
#endif
if (a == (MALLOC_T) - 1) {
ErrorMessage = ErrorSay;
_YAP_ErrorMessage = _YAP_ErrorSay;
#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));
#else
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", (int)s);
#endif
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
if (a != WorkSpaceTop) {
ErrorMessage = ErrorSay;
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return FALSE;
}
WorkSpaceTop = (char *) a + s;
PrologMode = OldPrologMode;
_YAP_PrologMode = OldPrologMode;
return TRUE;
#endif /* YAPOR */
}
int
FreeWorkSpace(void)
_YAP_FreeWorkSpace(void)
{
return 1;
}
@ -720,7 +732,7 @@ FreeWorkSpace(void)
static MALLOC_T WorkSpaceTop;
MALLOC_T
static MALLOC_T
InitWorkSpace(Int s)
{
MALLOC_T ptr;
@ -728,22 +740,22 @@ InitWorkSpace(Int s)
/* mapping heap area */
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);
}
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);
}
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);
}
WorkSpaceTop = (char *) ptr + s;
return(ptr);
}
int
static int
ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
@ -753,22 +765,22 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode;
/* mapping heap area */
if((shm_id = shmget(IPC_PRIVATE, (size_t)s, SHM_R|SHM_W)) == -1) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmget %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if((ptr = (MALLOC_T)shmat(shm_id, WorkSpaceTop, 0)) == (MALLOC_T) -1) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not shmat at %p", MMAP_ADDR);
PrologMode = OldPrologMode;
return(FALSE);
}
if (shmctl(shm_id, IPC_RMID, 0) != 0) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not remove shm segment", shm_id);
PrologMode = OldPrologMode;
return(FALSE);
@ -779,7 +791,7 @@ ExtendWorkSpace(Int s)
}
int
FreeWorkSpace(void)
_YAP_FreeWorkSpace(void)
{
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_p = limbo_space, *limbo_pp = 0;
MALLOC_T
static MALLOC_T
InitWorkSpace(Int s)
{
MALLOC_T ptr = (MALLOC_T)sbrk(s);
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(ptr);
}
int
static int
ExtendWorkSpace(Int s)
{
MALLOC_T ptr = (MALLOC_T)sbrk(s);
@ -827,8 +839,8 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode;
if (ptr == ((MALLOC_T) - 1)) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand stacks over %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
@ -838,7 +850,7 @@ ExtendWorkSpace(Int s)
}
int
FreeWorkSpace(void)
_YAP_FreeWorkSpace(void)
{
return TRUE;
}
@ -873,7 +885,7 @@ free(MALLOC_T ptr)
}
if (!ptr)
return;
if ((char *) ptr < HeapBase || (char *) ptr > HeapTop)
if ((char *) ptr < _YAP_HeapBase || (char *) ptr > HeapTop)
return;
if (!(b->b_size & InUseFlag))
return;
@ -931,7 +943,7 @@ mallinfo(void)
static int total_space;
MALLOC_T
static MALLOC_T
InitWorkSpace(Int s)
{
MALLOC_T ptr;
@ -943,13 +955,13 @@ InitWorkSpace(Int s)
total_space = s;
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(ptr);
}
int
static int
ExtendWorkSpace(Int s)
{
MALLOC_T ptr;
@ -958,24 +970,24 @@ ExtendWorkSpace(Int s)
PrologMode = ExtendStackMode;
total_space += s;
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) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not allocate %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if (ptr != (MALLOC_T)HeapBase) {
ErrorMessage = ErrorSay;
snprintf4(ErrorMessage, MAX_ERROR_MSG_SIZE,
if (ptr != (MALLOC_T)_YAP_HeapBase) {
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf4(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"could not expand contiguous stacks %d bytes", s);
PrologMode = OldPrologMode;
return(FALSE);
}
if ((CELL)ptr & MBIT) {
ErrorMessage = ErrorSay;
snprintf5(ErrorMessage, MAX_ERROR_MSG_SIZE,
_YAP_ErrorMessage = _YAP_ErrorSay;
snprintf5(_YAP_ErrorMessage, MAX_ERROR_MSG_SIZE,
"memory at %p conflicts with MBIT %lx", ptr, (unsigned long)MBIT);
PrologMode = OldPrologMode;
return(FALSE);
@ -985,23 +997,23 @@ ExtendWorkSpace(Int s)
}
int
FreeWorkSpace(void)
_YAP_FreeWorkSpace(void)
{
return TRUE;
}
#endif
void
YAP_InitHeap(void *heap_addr)
static void
InitHeap(void *heap_addr)
{
/* allocate space */
HeapBase = heap_addr;
_YAP_HeapBase = heap_addr;
/* reserve space for specially allocated functors and atoms so that
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;
HeapTop = HeapTop + sizeof(YAP_SEG_SIZE);
@ -1027,7 +1039,13 @@ YAP_InitHeap(void *heap_addr)
}
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;
@ -1040,14 +1058,14 @@ InitMemory(int Trail, int Heap, int Stack)
sa = Stack; /* stack area size */
ta = Trail; /* trail area size */
YAP_InitHeap(InitWorkSpace(pm));
InitHeap(InitWorkSpace(pm));
TrailTop = HeapBase + pm;
LocalBase = TrailTop - ta;
TrailBase = LocalBase + sizeof(CELL);
_YAP_TrailTop = _YAP_HeapBase + pm;
_YAP_LocalBase = _YAP_TrailTop - ta;
_YAP_TrailBase = _YAP_LocalBase + sizeof(CELL);
GlobalBase = LocalBase - sa;
AuxTop = GlobalBase - CellSize; /* avoid confusions while
_YAP_GlobalBase = _YAP_LocalBase - sa;
AuxTop = _YAP_GlobalBase - CellSize; /* avoid confusions while
* * restoring */
AuxSp = (CELL *) AuxTop;
@ -1055,12 +1073,12 @@ InitMemory(int Trail, int Heap, int Stack)
#if SIZEOF_INT_P!=SIZEOF_INT
if (output_msg) {
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
if (output_msg) {
fprintf(stderr, "HeapBase = %x GlobalBase = %x\n LocalBase = %x TrailTop = %x\n",
(UInt) HeapBase, (UInt) GlobalBase,
(UInt) LocalBase, (UInt) TrailTop);
(UInt) _YAP_HeapBase, (UInt) _YAP_GlobalBase,
(UInt) _YAP_LocalBase, (UInt) _YAP_TrailTop);
#endif
#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
STATIC_PROTO(void Var_Ref, (Ventry *));
STATIC_PROTO(AREG emit_xreg, (CELL));
STATIC_PROTO(YREG emit_yreg, (CELL));
STATIC_PROTO(AREG emit_xreg2, (void));
STATIC_PROTO(AREG emit_x, (CELL));
STATIC_PROTO(YREG emit_y, (Ventry *));
STATIC_PROTO(wamreg emit_xreg, (CELL));
STATIC_PROTO(yslot emit_yreg, (CELL));
STATIC_PROTO(wamreg emit_xreg2, (void));
STATIC_PROTO(wamreg emit_x, (CELL));
STATIC_PROTO(yslot emit_y, (Ventry *));
STATIC_PROTO(CODEADDR emit_a, (CELL));
STATIC_PROTO(CELL *emit_bmlabel, (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, (op_numbers));
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_ucons, (compiler_vm_op));
STATIC_PROTO(void a_uvar, (void));
@ -116,7 +116,6 @@ static yamop *code_p;
static CODEADDR code_addr;
static int pass_no;
int *label_offset;
static OPREG var_offset;
static int is_y_var;
@ -130,7 +129,7 @@ static CELL comit_lab;
static int do_not_optimize_uatom = FALSE;
static AREG x1_arg, x2_arg;
static wamreg x1_arg, x2_arg;
static Int c_arg;
@ -141,7 +140,7 @@ static int c_type;
static int clause_has_blobs;
inline static YREG
inline static yslot
emit_y(Ventry *ve)
{
#if MSHIFTOFFS
@ -205,19 +204,19 @@ fill_a(CELL a)
code_p = (yamop *) (++ptr);
}
inline static AREG
inline static wamreg
emit_xreg(CELL w)
{
return ((AREG) w);
return ((wamreg) w);
}
inline static YREG
inline static yslot
emit_yreg(CELL w)
{
return ((YREG) w);
return ((yslot) w);
}
inline static AREG
inline static wamreg
emit_xreg2(void)
{
#if PRECOMPUTE_REGADDRESS
@ -231,7 +230,7 @@ emit_xreg2(void)
#endif /* ALIGN_LONGS */
}
inline static AREG
inline static wamreg
emit_x(CELL xarg)
{
#if PRECOMPUTE_REGADDRESS
@ -298,8 +297,8 @@ DumpOpCodes(void)
while (i < 30) {
for (j = i; j <= _std_top; j += 25)
YP_fprintf(YP_stderr, "%5d %6lx", j, absmadr(j));
YP_putchar('\n');
fprintf(_YAP_stderr, "%5d %6lx", j, absmadr(j));
fputc('\n',_YAP_stderr);
++i;
}
}
@ -311,12 +310,18 @@ emit_op(op_numbers op)
return (absmadr((Int) op));
}
OPCODE
static OPCODE
opcode(op_numbers op)
{
return (emit_op(op));
}
OPCODE
_YAP_opcode(op_numbers op)
{
return (opcode(op));
}
static void
a_cl(op_numbers opcode)
{
@ -726,15 +731,15 @@ a_p(op_numbers opcode)
break;
default:
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
}
a_e(op);
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
}
return;
}
@ -743,10 +748,10 @@ a_p(op_numbers opcode)
if (!comit_ok && (Flags & TestPredFlag)) {
if (pass_no) {
if (Flags & UserCPredFlag) {
Error(SYSTEM_ERROR, TermNil,
_YAP_Error(SYSTEM_ERROR, TermNil,
"user defined predicate cannot be a test predicate");
save_machine_regs();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
} else
code_p->opc = emit_op(_call_c_wfail);
code_p->u.sdl.s =
@ -791,9 +796,9 @@ a_p(op_numbers opcode)
GONEXT(sla);
}
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();
longjmp(CompilerBotch,1);
longjmp(_YAP_CompilerBotch,1);
}
return;
}
@ -833,9 +838,9 @@ a_p(op_numbers opcode)
GONEXT(l);
}
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();
longjmp(CompilerBotch,1);
longjmp(_YAP_CompilerBotch,1);
}
}
@ -857,7 +862,7 @@ a_empty_call(void)
code_p->opc = emit_op(_fcall);
}
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 *
cpc->rnd2);
code_p->u.sla.l = emit_a((CELL)&(pe->StateOfPred));
@ -892,7 +897,7 @@ a_pl(op_numbers opcode, PredEntry *pred)
GONEXT(l);
}
static AREG
static wamreg
compile_cmp_flags(char *s)
{
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(EQ_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);
}
@ -913,7 +918,7 @@ a_bfunc(CELL pred)
Var_Ref(ve);
if (ve->KindOfVE == PermVar) {
YREG v1 = emit_yreg(var_offset);
yslot v1 = emit_yreg(var_offset);
cpc = cpc->nextInst;
ve = (Ventry *) cpc->rnd1;
Var_Ref(ve);
@ -939,7 +944,7 @@ a_bfunc(CELL pred)
GONEXT(lxy);
}
} else {
AREG x1 = emit_xreg(var_offset);
wamreg x1 = emit_xreg(var_offset);
cpc = cpc->nextInst;
ve = (Ventry *) cpc->rnd1;
Var_Ref(ve);
@ -1184,7 +1189,7 @@ a_either(op_numbers opcode, CELL opr, CELL lab)
#endif /* YAPOR */
{
if (pass_no) {
Prop fe = GetPredPropByAtom(AtomTrue,0);
Prop fe = _YAP_GetPredPropByAtom(AtomTrue,0);
code_p->opc = emit_op(opcode);
code_p->u.sla.s = emit_count(opr);
code_p->u.sla.l = emit_a(lab);
@ -1707,40 +1712,40 @@ a_f2(int var)
if (pass_no) {
switch (opc) {
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _minus:
code_p->opc = emit_op(_p_minus_y_cv);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _div:
code_p->opc = emit_op(_p_div_y_cv);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _sll:
code_p->opc = emit_op(_p_sll_y_cv);
save_machine_regs();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _slr:
code_p->opc = emit_op(_p_slr_y_cv);
save_machine_regs();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _arg:
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);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _times:
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);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _functor:
code_p->opc = emit_op(_p_func2s_y_vc);
@ -1846,30 +1851,30 @@ a_f2(int var)
if (pass_no) {
switch (opc) {
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _minus:
code_p->opc = emit_op(_p_minus_cv);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _div:
code_p->opc = emit_op(_p_div_cv);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _sll:
code_p->opc = emit_op(_p_sll_cv);
@ -1897,9 +1902,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_plus_vc);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _times:
code_p->opc = emit_op(_p_times_vc);
@ -1920,9 +1925,9 @@ a_f2(int var)
code_p->opc = emit_op(_p_slr_vc);
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
break;
case _functor:
code_p->opc = emit_op(_p_func2s_vc);
@ -1972,15 +1977,15 @@ do_pass(void)
if (assembling != ASSEMBLING_INDEX) {
Clause *cl_p = (Clause *)code_p;
if (pass_no) {
cl_p->u.ClValue = c_store;
cl_p->ClFlags = c_mask;
cl_p->u.ClValue = clause_store;
cl_p->ClFlags = clause_mask;
if (log_update)
cl_p->ClFlags |= LogUpdMask;
if (clause_has_blobs) {
cl_p->ClFlags |= HasBlobsMask;
}
cl_p->u2.ClExt = NULL;
cl_p->Owner = YapConsultingFile();
cl_p->Owner = _YAP_ConsultingFile();
}
code_p = (yamop *)(cl_p->ClCode);
IPredArity = cpc->rnd2; /* number of args */
@ -2005,7 +2010,7 @@ do_pass(void)
cl_p->ClFlags = LogUpdatePredFlag|IndexedPredFlag|IndexMask;
} else {
cl_p->u2.ClExt = NULL;
cl_p->ClFlags = c_mask|IndexMask;
cl_p->ClFlags = clause_mask|IndexMask;
}
cl_p->Owner = CurrentPred->OwnerFile;
}
@ -2391,7 +2396,7 @@ do_pass(void)
if (!pass_no) {
if (CellPtr(label_offset+cpc->rnd1) > ASP-256) {
save_machine_regs();
longjmp(CompilerBotch,3);
longjmp(_YAP_CompilerBotch,3);
}
if ( (char *)(label_offset+cpc->rnd1) > freep)
@ -2540,9 +2545,9 @@ do_pass(void)
break;
case fetch_args_for_bccall:
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
}
a_bfunc(cpc->nextInst->rnd2);
break;
@ -2561,9 +2566,9 @@ do_pass(void)
case name_op:
break;
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();
longjmp(CompilerBotch, 1);
longjmp(_YAP_CompilerBotch, 1);
}
cpc = cpc->nextInst;
}
@ -2572,7 +2577,7 @@ do_pass(void)
}
CODEADDR
assemble(int mode)
_YAP_assemble(int mode)
{
/*
* the assembly proccess is done in two passes: 1 - a first pass
@ -2589,8 +2594,8 @@ assemble(int mode)
asm_error = FALSE;
do_pass();
if (asm_error) {
Error_TYPE = SYSTEM_ERROR;
ErrorMessage = "internal assembler error";
_YAP_Error_TYPE = SYSTEM_ERROR;
_YAP_ErrorMessage = "internal assembler error";
return (NIL);
}
pass_no = 1;
@ -2605,9 +2610,9 @@ assemble(int mode)
#else
size = (CELL)code_p;
#endif
while ((code_addr = (CODEADDR) AllocCodeSpace(size)) == NULL) {
if (!growheap(TRUE)) {
Error_TYPE = SYSTEM_ERROR;
while ((code_addr = (CODEADDR) _YAP_AllocCodeSpace(size)) == NULL) {
if (!_YAP_growheap(TRUE)) {
_YAP_Error_TYPE = SYSTEM_ERROR;
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)
{
#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;
RERROR();
#else
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;
RERROR();
} else {
@ -91,12 +91,12 @@ static E_FUNC
p_nan(E_ARGS)
{
#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;
RERROR();
#else
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;
RERROR();
} else {
@ -108,13 +108,13 @@ p_nan(E_ARGS)
static E_FUNC
p_random(E_ARGS)
{
RFLOAT(yap_random());
RFLOAT(_YAP_random());
}
static E_FUNC
p_cputime(E_ARGS)
{
RFLOAT((Float)cputime()/1000.0);
RFLOAT((Float)_YAP_cputime()/1000.0);
}
static E_FUNC
@ -204,19 +204,19 @@ static InitConstEntry InitConstTab[] = {
};
void
InitConstExps(void)
_YAP_InitConstExps(void)
{
unsigned int i;
ExpEntry *p;
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);
if (GetExpPropHavingLock(ae, 0)) {
if (_YAP_GetExpPropHavingLock(ae, 0)) {
WRITE_UNLOCK(ae->ARWLock);
break;
}
p = (ExpEntry *) AllocAtomSpace(sizeof(ExpEntry));
p = (ExpEntry *) _YAP_AllocAtomSpace(sizeof(ExpEntry));
p->KindOfPE = ExpProperty;
p->ArityOfEE = 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 */
int
ReInitConstExps(void)
_YAP_ReInitConstExps(void)
{
unsigned int i;
Prop p;
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);
if ((p = GetExpPropHavingLock(ae, 0)) == NULL) {
if ((p = _YAP_GetExpPropHavingLock(ae, 0)) == NULL) {
WRITE_UNLOCK(ae->ARWLock);
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 RERROR() return(db_ref_e)
#define ArithIEval(t,v) Eval(t,v)
#define ArithIEval(t,v) _YAP_Eval(t,v)
inline static Functor
AritFunctorOfTerm(Term t) {
@ -64,7 +64,7 @@ EvalToTerm(blob_type f, union arith_ret *res)
return(MkFloatTerm(res->dbl));
#ifdef USE_GMP
case big_int_e:
return(MkBigIntTerm(res->big));
return(_YAP_MkBigIntTerm(res->big));
#endif
default:
return(TermNil);
@ -104,7 +104,7 @@ p_mod(Term t1, Term t2 E_ARGS)
RINT(IntegerOfTerm(t1) % i2);
}
case (CELL)double_e:
Error(TYPE_ERROR_INTEGER, t2, "mod/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
@ -117,11 +117,11 @@ p_mod(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case (CELL)double_e:
Error(TYPE_ERROR_INTEGER, t1, "mod/2");
_YAP_Error(TYPE_ERROR_INTEGER, t1, "mod/2");
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
@ -133,50 +133,50 @@ p_mod(Term t1, Term t2 E_ARGS)
/* modulo between bignum and integer */
{
Int i2 = IntegerOfTerm(t2);
MP_INT *l1 = BigIntOfTerm(t1);
MP_INT *l1 = _YAP_BigIntOfTerm(t1);
if (i2 > 0) {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, l1, i2);
CleanBigNum();
_YAP_CleanBigNum();
RINT((mpz_sgn(l1) ? r : -r));
} else if (i2 == 0) {
goto zero_divisor;
} else {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, l1, -i2);
CleanBigNum();
_YAP_CleanBigNum();
RINT((mpz_sgn(l1) ? r : -r));
}
}
case (CELL)big_int_e:
/* 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);
}
case double_e:
Error(TYPE_ERROR_INTEGER, t2, "mod/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "mod/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -187,7 +187,7 @@ p_mod(Term t1, Term t2 E_ARGS)
if (v2.Int == 0) goto zero_divisor;
RINT(v1.Int % v2.Int);
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 */
P = (yamop *)FAILCODE;
RERROR();
@ -197,11 +197,11 @@ p_mod(Term t1, Term t2 E_ARGS)
RINT(v1.Int);
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
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;
RERROR();
#ifdef USE_GMP
@ -210,30 +210,30 @@ p_mod(Term t1, Term t2 E_ARGS)
case long_int_e:
/* big mod integer */
if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, v1.big, v2.Int);
CleanBigNum();
_YAP_CleanBigNum();
RINT((mpz_sgn(v1.big) ? r : -r));
} else if (v2.Int == 0) {
goto zero_divisor;
} else {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
Int r = mpz_mod_ui(new, v1.big, -v2.Int);
CleanBigNum();
_YAP_CleanBigNum();
RINT((mpz_sgn(v1.big) ? r : -r));
}
case double_e:
/* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2");
_YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
case (CELL)big_int_e:
/* big * big */
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_mod(new, v1.big, v2.big);
RBIG(new);
@ -248,7 +248,7 @@ p_mod(Term t1, Term t2 E_ARGS)
RERROR();
}
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 */
P = (yamop *)FAILCODE;
RERROR();
@ -264,14 +264,14 @@ fdiv_bigint(MP_INT *b1,MP_INT *b2)
mpf_t f1,f2;
Float res;
PreAllocBigNum();
_YAP_PreAllocBigNum();
mpf_init(f1);
mpf_init(f2);
mpf_set_z(f1, b1);
mpf_set_z(f2, b2);
mpf_div(f1, f1, f2);
res = mpf_get_d(f1);
CleanBigNum();
_YAP_CleanBigNum();
return(res);
} else {
return(f1/f2);
@ -312,7 +312,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
case (CELL)big_int_e:
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2));
Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(i1/f2);
}
#endif
@ -320,7 +320,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
@ -341,14 +341,14 @@ p_fdiv(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP
case big_int_e:
{
RFLOAT(FloatOfTerm(t1)/mpz_get_d(BigIntOfTerm(t2)));
RFLOAT(FloatOfTerm(t1)/mpz_get_d(_YAP_BigIntOfTerm(t2)));
}
#endif
default:
/* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1);
bt1 = double_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
#ifdef USE_GMP
@ -359,30 +359,30 @@ p_fdiv(Term t1, Term t2 E_ARGS)
case long_int_e:
{
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:
/* two bignums*/
RFLOAT(fdiv_bigint(BigIntOfTerm(t1),BigIntOfTerm(t2)));
// RFLOAT(mpz_get_d(BigIntOfTerm(t1))/mpz_get_d(BigIntOfTerm(t2)));
RFLOAT(fdiv_bigint(_YAP_BigIntOfTerm(t1),_YAP_BigIntOfTerm(t2)));
// RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))/mpz_get_d(_YAP_BigIntOfTerm(t2)));
case double_e:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(mpz_get_d(BigIntOfTerm(t1))/dbl);
RFLOAT(mpz_get_d(_YAP_BigIntOfTerm(t1))/dbl);
}
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -400,7 +400,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
RFLOAT(v1.Int/mpz_get_d(v2.big));
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
@ -447,7 +447,7 @@ p_fdiv(Term t1, Term t2 E_ARGS)
static void
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_com(n2, r1);
@ -455,7 +455,7 @@ mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2)
mpz_com(n3, r2);
mpz_and(n3, n3, new);
mpz_ior(new, n2, n3);
CleanBigNum();
_YAP_CleanBigNum();
}
#endif
#endif
@ -479,16 +479,16 @@ p_xor(Term t1, Term t2 E_ARGS)
/* two integers */
RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2));
case double_e:
Error(TYPE_ERROR_INTEGER, t2, "#/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "#/2");
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
case big_int_e:
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t1));
mpz_xor(new, new, BigIntOfTerm(t2));
mpz_xor(new, new, _YAP_BigIntOfTerm(t2));
RBIG(new);
}
#endif
@ -496,11 +496,11 @@ p_xor(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
Error(TYPE_ERROR_INTEGER, t1, "#/2");
_YAP_Error(TYPE_ERROR_INTEGER, t1, "#/2");
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
@ -510,38 +510,38 @@ p_xor(Term t1, Term t2 E_ARGS)
switch (BlobOfFunctor(f2)) {
case long_int_e:
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,IntOfTerm(t2));
mpz_xor(new, BigIntOfTerm(t1), new);
mpz_xor(new, _YAP_BigIntOfTerm(t1), new);
RBIG(new);
}
case big_int_e:
/* 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);
}
case double_e:
Error(TYPE_ERROR_INTEGER, t2, "#/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "#/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -550,14 +550,14 @@ p_xor(Term t1, Term t2 E_ARGS)
case long_int_e:
RINT(v1.Int ^ v2.Int);
case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "#/2");
_YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "#/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
case big_int_e:
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,v1.Int);
mpz_xor(new, new, v2.big);
@ -565,11 +565,11 @@ p_xor(Term t1, Term t2 E_ARGS)
}
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "#/2");
_YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "#/2");
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
@ -578,7 +578,7 @@ p_xor(Term t1, Term t2 E_ARGS)
case long_int_e:
/* anding a bignum with an integer is easy */
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_set_si(new,v2.Int);
mpz_xor(new, v1.big, new);
@ -586,14 +586,14 @@ p_xor(Term t1, Term t2 E_ARGS)
}
case double_e:
/* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
_YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
case big_int_e:
/* big * big */
{
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_xor(new, v1.big, v2.big);
RBIG(new);
@ -642,7 +642,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2));
Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(atan2(i1,f2));
}
#endif
@ -650,7 +650,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
@ -671,14 +671,14 @@ p_atan2(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP
case big_int_e:
{
RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(BigIntOfTerm(t2))));
RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(_YAP_BigIntOfTerm(t2))));
}
#endif
default:
/* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1);
bt1 = double_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
#ifdef USE_GMP
@ -689,29 +689,29 @@ p_atan2(Term t1, Term t2 E_ARGS)
case long_int_e:
{
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:
/* 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:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(mpz_get_d(BigIntOfTerm(t1)),dbl));
RFLOAT(atan2(mpz_get_d(_YAP_BigIntOfTerm(t1)),dbl));
}
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -729,7 +729,7 @@ p_atan2(Term t1, Term t2 E_ARGS)
RFLOAT(atan2(v1.Int,mpz_get_d(v2.big)));
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
@ -804,7 +804,7 @@ p_power(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Int i1 = IntegerOfTerm(t1);
Float f2 = mpz_get_d(BigIntOfTerm(t2));
Float f2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
RFLOAT(pow(i1,f2));
}
#endif
@ -812,7 +812,7 @@ p_power(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
@ -833,14 +833,14 @@ p_power(Term t1, Term t2 E_ARGS)
#ifdef USE_GMP
case big_int_e:
{
RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(BigIntOfTerm(t2))));
RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(_YAP_BigIntOfTerm(t2))));
}
#endif
default:
/* we've got a full term, need to evaluate it first */
v1.dbl = FloatOfTerm(t1);
bt1 = double_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
#ifdef USE_GMP
@ -851,29 +851,29 @@ p_power(Term t1, Term t2 E_ARGS)
case long_int_e:
{
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:
/* 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:
{
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(BigIntOfTerm(t1)),dbl));
RFLOAT(pow(mpz_get_d(_YAP_BigIntOfTerm(t1)),dbl));
}
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -891,7 +891,7 @@ p_power(Term t1, Term t2 E_ARGS)
RFLOAT(pow(v1.Int,mpz_get_d(v2.big)));
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
@ -947,7 +947,7 @@ gcd(Int m11,Int m21)
}
if (m11<0 || m21<0) { /* overflow? */
/* 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);
P = (yamop *)FAILCODE;
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? */
/* 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);
P = (yamop *)FAILCODE;
return(1);
@ -1007,7 +1007,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
RINT(gcd(i1,i2));
}
case double_e:
Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
@ -1018,14 +1018,14 @@ p_gcd(Term t1, Term t2 E_ARGS)
Int i = IntegerOfTerm(t1);
if (i > 0) {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t2),i));
RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t2),i));
} 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);
} else {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t2),-i));
RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t2),-i));
}
}
#endif
@ -1033,11 +1033,11 @@ p_gcd(Term t1, Term t2 E_ARGS)
/* we've got a full term, need to evaluate it first */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
Error(TYPE_ERROR_INTEGER, t1, "gcd/2");
_YAP_Error(TYPE_ERROR_INTEGER, t1, "gcd/2");
P = (yamop *)FAILCODE;
RERROR();
#ifdef USE_GMP
@ -1051,42 +1051,42 @@ p_gcd(Term t1, Term t2 E_ARGS)
Int i = IntegerOfTerm(t2);
if (i > 0) {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t1),i));
RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t1),i));
} 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);
} else {
RINT(mpz_gcd_ui(NULL,BigIntOfTerm(t1),-i));
RINT(mpz_gcd_ui(NULL,_YAP_BigIntOfTerm(t1),-i));
}
}
case big_int_e:
/* 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);
}
case double_e:
Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
_YAP_Error(TYPE_ERROR_INTEGER, t2, "gcd/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -1102,7 +1102,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
RINT(gcd(i1,i2));
}
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 */
P = (yamop *)FAILCODE;
RERROR();
@ -1112,7 +1112,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
if (v1.Int > 0) {
RINT(mpz_gcd_ui(NULL,v2.big,v1.Int));
} else if (v1.Int == 0) {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, v2.big);
RBIG(new);
@ -1122,11 +1122,11 @@ p_gcd(Term t1, Term t2 E_ARGS)
}
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
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;
RERROR();
#ifdef USE_GMP
@ -1138,7 +1138,7 @@ p_gcd(Term t1, Term t2 E_ARGS)
if (v2.Int > 0) {
RINT(mpz_gcd_ui(NULL,v1.big,v2.Int));
} else if (v2.Int == 0) {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_abs(new, v1.big);
RBIG(new);
@ -1148,13 +1148,13 @@ p_gcd(Term t1, Term t2 E_ARGS)
}
case double_e:
/* big // float */
Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2");
_YAP_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2");
/* make GCC happy */
P = (yamop *)FAILCODE;
RERROR();
case big_int_e:
if (v2.Int > 0) {
MP_INT *new = PreAllocBigNum();
MP_INT *new = _YAP_PreAllocBigNum();
mpz_gcd(new, v1.big, v2.big);
RBIG(new);
}
@ -1204,7 +1204,7 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Int i = IntegerOfTerm(t1);
MP_INT *b = BigIntOfTerm(t2);
MP_INT *b = _YAP_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) < 0) {
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 */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
@ -1246,7 +1246,7 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(BigIntOfTerm(t2));
Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
if (fl1 <= fl2) {
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 */
v1.dbl = FloatOfTerm(t1);
bt1 = double_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
#ifdef USE_GMP
@ -1268,7 +1268,7 @@ p_min(Term t1, Term t2 E_ARGS)
case long_int_e:
{
Int i = IntegerOfTerm(t2);
MP_INT *b = BigIntOfTerm(t1);
MP_INT *b = _YAP_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) < 0) {
RBIG(b);
@ -1278,8 +1278,8 @@ p_min(Term t1, Term t2 E_ARGS)
case big_int_e:
/* two bignums */
{
MP_INT *b1 = BigIntOfTerm(t1);
MP_INT *b2 = BigIntOfTerm(t2);
MP_INT *b1 = _YAP_BigIntOfTerm(t1);
MP_INT *b2 = _YAP_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) < 0) {
RBIG(b1);
@ -1289,7 +1289,7 @@ p_min(Term t1, Term t2 E_ARGS)
case double_e:
{
Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(BigIntOfTerm(t1));
Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t1));
if (fl1 <= fl2) {
RFLOAT(fl1);
}
@ -1297,17 +1297,17 @@ p_min(Term t1, Term t2 E_ARGS)
}
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -1335,7 +1335,7 @@ p_min(Term t1, Term t2 E_ARGS)
}
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
@ -1443,7 +1443,7 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Int i = IntegerOfTerm(t1);
MP_INT *b = BigIntOfTerm(t2);
MP_INT *b = _YAP_BigIntOfTerm(t2);
if (mpz_cmp_si(b,i) > 0) {
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 */
v1.Int = IntegerOfTerm(t1);
bt1 = long_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
case double_e:
@ -1485,7 +1485,7 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e:
{
Float fl1 = FloatOfTerm(t1);
Float fl2 = mpz_get_d(BigIntOfTerm(t2));
Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t2));
if (fl1 >= fl2) {
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 */
v1.dbl = FloatOfTerm(t1);
bt1 = double_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
break;
#ifdef USE_GMP
@ -1507,7 +1507,7 @@ p_max(Term t1, Term t2 E_ARGS)
case long_int_e:
{
Int i = IntegerOfTerm(t2);
MP_INT *b = BigIntOfTerm(t1);
MP_INT *b = _YAP_BigIntOfTerm(t1);
if (mpz_cmp_si(b,i) > 0) {
RBIG(b);
@ -1517,8 +1517,8 @@ p_max(Term t1, Term t2 E_ARGS)
case big_int_e:
/* two bignums */
{
MP_INT *b1 = BigIntOfTerm(t1);
MP_INT *b2 = BigIntOfTerm(t2);
MP_INT *b1 = _YAP_BigIntOfTerm(t1);
MP_INT *b2 = _YAP_BigIntOfTerm(t2);
if (mpz_cmp(b1,b2) > 0) {
RBIG(b1);
@ -1528,7 +1528,7 @@ p_max(Term t1, Term t2 E_ARGS)
case double_e:
{
Float fl1 = FloatOfTerm(t2);
Float fl2 = mpz_get_d(BigIntOfTerm(t1));
Float fl2 = mpz_get_d(_YAP_BigIntOfTerm(t1));
if (fl1 >= fl2) {
RFLOAT(fl1);
}
@ -1536,17 +1536,17 @@ p_max(Term t1, Term t2 E_ARGS)
}
default:
/* we've got a full term, need to evaluate it first */
v1.big = BigIntOfTerm(t1);
v1.big = _YAP_BigIntOfTerm(t1);
bt1 = big_int_e;
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
break;
}
#endif
default:
/* 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 */
bt2 = Eval(t2, &v2);
bt2 = _YAP_Eval(t2, &v2);
}
/* second case, no need no evaluation */
switch (bt1) {
@ -1574,7 +1574,7 @@ p_max(Term t1, Term t2 E_ARGS)
}
#endif
default:
/* Error */
/* _YAP_Error */
RERROR();
}
case double_e:
@ -1681,50 +1681,50 @@ p_binary_is(void)
blob_type f;
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t, "X is Y");
_YAP_Error(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
if (IsIntTerm(t)) {
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)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, 2)))) {
if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, 2)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntTerm(2);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
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,2);
P = (yamop *)FAILCODE;
return(FALSE);
}
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);
}
void
InitBinaryExps(void)
_YAP_InitBinaryExps(void)
{
unsigned int i;
ExpEntry *p;
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);
if (GetExpPropHavingLock(ae, 2)) {
if (_YAP_GetExpPropHavingLock(ae, 2)) {
WRITE_UNLOCK(ae->ARWLock);
break;
}
p = (ExpEntry *) AllocAtomSpace(sizeof(ExpEntry));
p = (ExpEntry *) _YAP_AllocAtomSpace(sizeof(ExpEntry));
p->KindOfPE = ExpProperty;
p->ArityOfEE = 2;
p->ENoOfEE = 2;
@ -1733,21 +1733,21 @@ InitBinaryExps(void)
ae->PropsOfAE = AbsExpProp(p);
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 */
int
ReInitBinaryExps(void)
_YAP_ReInitBinaryExps(void)
{
unsigned int i;
Prop p;
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);
if ((p = GetExpPropHavingLock(ae, 2)) == NULL) {
if ((p = _YAP_GetExpPropHavingLock(ae, 2)) == NULL) {
WRITE_UNLOCK(ae->ARWLock);
return(FALSE);
}

289
C/arrays.c
View File

@ -173,7 +173,7 @@ AccessNamedArray(Atom a, Int indx)
READ_LOCK(ptr->ArRWLock);
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);
P = (yamop *)FAILCODE;
return(MkAtomTerm(AtomFoundVar));
@ -259,7 +259,7 @@ AccessNamedArray(Atom a, Int indx)
READ_UNLOCK(ptr->ArRWLock);
if (ref != NULL) {
TRef = FetchTermFromDB(ref,3);
TRef = _YAP_FetchTermFromDB(ref,3);
} else {
P = (yamop *)FAILCODE;
TRef = TermNil;
@ -273,7 +273,7 @@ AccessNamedArray(Atom a, Int indx)
}
}
else {
Error(EXISTENCE_ERROR_ARRAY,MkAtomTerm(a),"named array");
_YAP_Error(EXISTENCE_ERROR_ARRAY,MkAtomTerm(a),"named array");
return (TermNil);
}
@ -291,22 +291,22 @@ p_access_array(void)
union arith_ret v;
if (IsIntTerm(ti))
indx = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e)
else if (_YAP_Eval(ti, &v) == long_int_e)
indx = v.Int;
else {
Error(TYPE_ERROR_INTEGER,ti,"access_array");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"access_array");
return (FALSE);
}
}
else {
Error(INSTANTIATION_ERROR,ti,"access_array");
_YAP_Error(INSTANTIATION_ERROR,ti,"access_array");
return (TermNil);
}
if (IsNonVarTerm(t)) {
if (IsApplTerm(t)) {
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;
return(FALSE);
}
@ -317,14 +317,14 @@ p_access_array(void)
return(FALSE);
}
} else {
Error(TYPE_ERROR_ARRAY,t,"access_array");
_YAP_Error(TYPE_ERROR_ARRAY,t,"access_array");
return(FALSE);
}
} else {
Error(INSTANTIATION_ERROR,t,"access_array");
_YAP_Error(INSTANTIATION_ERROR,t,"access_array");
return(FALSE);
}
return (unify(tf, ARG3));
return (_YAP_unify(tf, ARG3));
}
static Int
@ -337,35 +337,35 @@ p_array_arg(void)
union arith_ret v;
if (IsIntTerm(ti))
indx = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e)
else if (_YAP_Eval(ti, &v) == long_int_e)
indx = v.Int;
else {
Error(TYPE_ERROR_INTEGER,ti,"array_arg");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"array_arg");
return (FALSE);
}
}
else {
Error(INSTANTIATION_ERROR,ti,"array_arg");
_YAP_Error(INSTANTIATION_ERROR,ti,"array_arg");
return (FALSE);
}
t = Deref(ARG2);
if (IsNonVarTerm(t)) {
if (IsApplTerm(t)) {
return (unify(((RepAppl(t))[indx + 1]), ARG1));
return (_YAP_unify(((RepAppl(t))[indx + 1]), ARG1));
}
else if (IsAtomTerm(t)) {
Term tf = AccessNamedArray(AtomOfTerm(t), indx);
if (tf == MkAtomTerm(AtomFoundVar)) {
return(FALSE);
}
return (unify(tf, ARG1));
return (_YAP_unify(tf, ARG1));
}
else
Error(TYPE_ERROR_ARRAY,t,"array_arg");
_YAP_Error(TYPE_ERROR_ARRAY,t,"array_arg");
}
else
Error(INSTANTIATION_ERROR,t,"array_arg");
_YAP_Error(INSTANTIATION_ERROR,t,"array_arg");
return (FALSE);
@ -382,7 +382,7 @@ InitNamedArray(ArrayEntry * p, Int dim)
/* place terms in reverse order */
Bind_Global(&(p->ValueOfVE),AbsAppl(H));
tp = H;
tp[0] = (CELL)MkFunctor(AtomArray, dim);
tp[0] = (CELL)_YAP_MkFunctor(AtomArray, dim);
tp++;
p->ArrayEArity = dim;
/* Initialise the array as a set of variables */
@ -399,7 +399,7 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
{
ArrayEntry *p;
p = (ArrayEntry *) AllocAtomSpace(sizeof(*p));
p = (ArrayEntry *) _YAP_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty;
p->NextOfPE = ae->PropsOfAE;
INIT_RWLOCK(p->ArRWLock);
@ -439,10 +439,10 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
asize = array_size*sizeof(DBRef);
break;
}
while ((p->ValueOfVE.floats = (Float *) AllocAtomSpace(asize) ) == NULL) {
while ((p->ValueOfVE.floats = (Float *) _YAP_AllocAtomSpace(asize) ) == NULL) {
YAPLeaveCriticalSection();
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return;
}
YAPEnterCriticalSection();
@ -454,7 +454,7 @@ static void
CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR start_addr, StaticArrayEntry *p)
{
if (EndOfPAEntr(p)) {
p = (StaticArrayEntry *) AllocAtomSpace(sizeof(*p));
p = (StaticArrayEntry *) _YAP_AllocAtomSpace(sizeof(*p));
p->KindOfPE = ArrayProperty;
p->NextOfPE = ae->PropsOfAE;
INIT_RWLOCK(p->ArRWLock);
@ -520,7 +520,7 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
return;
pp->ArrayEArity = -dim;
#if HAVE_MMAP
if (pp->ValueOfVE.chars < (char *)HeapBase ||
if (pp->ValueOfVE.chars < (char *)_YAP_HeapBase ||
pp->ValueOfVE.chars > (char *)HeapTop) {
ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars));
return;
@ -580,32 +580,6 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
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) */
static Int
p_create_array(void)
@ -621,10 +595,10 @@ p_create_array(void)
union arith_ret v;
if (IsIntTerm(ti))
size = IntOfTerm(ti);
else if (Eval(ti, &v) == long_int_e)
else if (_YAP_Eval(ti, &v) == long_int_e)
size = v.Int;
else {
Error(TYPE_ERROR_INTEGER,ti,"create_array");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"create_array");
return (FALSE);
}
}
@ -633,15 +607,15 @@ p_create_array(void)
/* Create an anonymous array */
Functor farray;
farray = MkFunctor(AtomArray, size);
farray = _YAP_MkFunctor(AtomArray, size);
if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE);
} else {
if (H+1+size > ASP-1024) {
if (!growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growstack( sizeof(CELL) * (size+1-(H-ASP-1024)))) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return FALSE;
}
}
@ -654,7 +628,7 @@ p_create_array(void)
RESET_VARIABLE(H);
H++;
}
return (unify(t, ARG1));
return (_YAP_unify(t, ARG1));
}
else if (IsAtomTerm(t)) {
/* Create a named array */
@ -668,8 +642,8 @@ p_create_array(void)
if (EndOfPAEntr(pp)) {
if (H+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock);
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE);
} else
goto restart;
@ -682,12 +656,12 @@ p_create_array(void)
WRITE_UNLOCK(ae->ARWLock);
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);
else {
if (H+1+size > ASP-1024) {
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR,TermNil,ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR,TermNil,_YAP_ErrorMessage);
return(FALSE);
} else
goto restart;
@ -711,23 +685,23 @@ p_create_static_array(void)
static_array_types props;
if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"create static array");
_YAP_Error(INSTANTIATION_ERROR,ti,"create static array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Eval(ti, &v) == long_int_e) {
if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
else {
Error(TYPE_ERROR_INTEGER,ti,"create static array");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"create static array");
return (FALSE);
}
}
if (IsVarTerm(tprops)) {
Error(INSTANTIATION_ERROR,tprops,"create static array");
_YAP_Error(INSTANTIATION_ERROR,tprops,"create static array");
return (FALSE);
} else if (IsAtomTerm(tprops)) {
char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
@ -748,16 +722,16 @@ p_create_static_array(void)
else if (!strcmp(atname, "term"))
props = array_of_terms;
else {
Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
_YAP_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
return(FALSE);
}
} else {
Error(TYPE_ERROR_ATOM,tprops,"create static array");
_YAP_Error(TYPE_ERROR_ATOM,tprops,"create static array");
return (FALSE);
}
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"create static array");
_YAP_Error(INSTANTIATION_ERROR,t,"create static array");
return (FALSE);
}
else if (IsAtomTerm(t)) {
@ -780,15 +754,15 @@ p_create_static_array(void)
CreateStaticArray(ae, size, props, NULL, pp);
return (TRUE);
} 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);
}
} 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);
}
}
Error(TYPE_ERROR_ATOM,t,"create static array");
_YAP_Error(TYPE_ERROR_ATOM,t,"create static array");
return (FALSE);
}
@ -832,23 +806,23 @@ p_resize_static_array(void)
Int size;
if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"resize a static array");
_YAP_Error(INSTANTIATION_ERROR,ti,"resize a static array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Eval(ti, &v) == long_int_e) {
if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
else {
Error(TYPE_ERROR_INTEGER,ti,"resize a static array");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"resize a static array");
return (FALSE);
}
}
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"resize a static array");
_YAP_Error(INSTANTIATION_ERROR,t,"resize a static array");
return (FALSE);
}
else if (IsAtomTerm(t)) {
@ -859,15 +833,15 @@ p_resize_static_array(void)
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE);
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);
} else {
Int osize = - pp->ArrayEArity;
ResizeStaticArray(pp, size);
return(unify(ARG2,MkIntegerTerm(osize)));
return(_YAP_unify(ARG2,MkIntegerTerm(osize)));
}
} else {
Error(TYPE_ERROR_ATOM,t,"resize a static array");
_YAP_Error(TYPE_ERROR_ATOM,t,"resize a static array");
return (FALSE);
}
}
@ -880,7 +854,7 @@ p_close_static_array(void)
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"close static array");
_YAP_Error(INSTANTIATION_ERROR,t,"close static array");
return (FALSE);
}
else if (IsAtomTerm(t)) {
@ -899,12 +873,12 @@ p_close_static_array(void)
StaticArrayEntry *ptr = (StaticArrayEntry *)pp;
if (ptr->ValueOfVE.ints != NULL) {
#if HAVE_MMAP
if (ptr->ValueOfVE.chars < (char *)HeapBase ||
if (ptr->ValueOfVE.chars < (char *)_YAP_HeapBase ||
ptr->ValueOfVE.chars > (char *)HeapTop) {
return(CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars));
}
#endif
FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
_YAP_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
ptr->ValueOfVE.ints = NULL;
ptr->ArrayEArity = 0;
return(TRUE);
@ -913,7 +887,7 @@ p_close_static_array(void)
}
}
} else {
Error(TYPE_ERROR_ATOM,t,"close static array");
_YAP_Error(TYPE_ERROR_ATOM,t,"close static array");
return (FALSE);
}
}
@ -958,21 +932,21 @@ CloseMmappedArray(StaticArrayEntry *pp, void *area)
optr = ptr;
}
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);
}
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);
}
optr->next = ptr->next;
pp->ValueOfVE.ints = NULL;
pp->ArrayEArity = 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);
}
FreeAtomSpace((char *)ptr);
_YAP_FreeAtomSpace((char *)ptr);
return(TRUE);
}
@ -992,24 +966,24 @@ ResizeMmappedArray(StaticArrayEntry *pp, Int dim, void *area)
and last we initialise again
*/
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;
}
total_size = (ptr->size / ptr->items)*dim;
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;
}
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;
}
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;
}
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;
}
ptr->size = total_size;
@ -1035,23 +1009,23 @@ p_create_mmapped_array(void)
int fd;
if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"create_mmapped_array");
_YAP_Error(INSTANTIATION_ERROR,ti,"create_mmapped_array");
return (FALSE);
} else if (IsIntTerm(ti))
size = IntOfTerm(ti);
else {
union arith_ret v;
if (Eval(ti, &v) == long_int_e) {
if (_YAP_Eval(ti, &v) == long_int_e) {
size = v.Int;
}
else {
Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array");
return (FALSE);
}
}
if (IsVarTerm(tprops)) {
Error(INSTANTIATION_ERROR,tprops,"create_mmapped_array");
_YAP_Error(INSTANTIATION_ERROR,tprops,"create_mmapped_array");
return (FALSE);
} else if (IsAtomTerm(tprops)) {
char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
@ -1077,16 +1051,16 @@ p_create_mmapped_array(void)
props = array_of_uchars;
total_size = size*sizeof(unsigned char);
} else {
Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create_mmapped_array");
_YAP_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create_mmapped_array");
return(FALSE);
}
} else {
Error(TYPE_ERROR_ATOM,tprops,"create_mmapped_array");
_YAP_Error(TYPE_ERROR_ATOM,tprops,"create_mmapped_array");
return (FALSE);
}
if (IsVarTerm(tfile)) {
Error(INSTANTIATION_ERROR,tfile,"create_mmapped_array");
_YAP_Error(INSTANTIATION_ERROR,tfile,"create_mmapped_array");
return (FALSE);
} else if (IsAtomTerm(tfile)) {
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);
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);
}
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)
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)
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)
Error(SYSTEM_ERROR,tfile,"create_mmapped_array (mmap: %s)", strerror(errno));
_YAP_Error(SYSTEM_ERROR,tfile,"create_mmapped_array (mmap: %s)", strerror(errno));
} else {
Error(TYPE_ERROR_ATOM,tfile,"create_mmapped_array");
_YAP_Error(TYPE_ERROR_ATOM,tfile,"create_mmapped_array");
return (FALSE);
}
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"create_mmapped_array");
_YAP_Error(INSTANTIATION_ERROR,t,"create_mmapped_array");
return (FALSE);
}
else if (IsAtomTerm(t)) {
@ -1132,7 +1106,7 @@ p_create_mmapped_array(void)
mmap_array_block *ptr;
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->size = total_size;
ptr->items = size;
@ -1144,15 +1118,15 @@ p_create_mmapped_array(void)
} else {
WRITE_UNLOCK(pp->ArRWLock);
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);
}
} else {
Error(TYPE_ERROR_ATOM,t,"create_mmapped_array");
_YAP_Error(TYPE_ERROR_ATOM,t,"create_mmapped_array");
return (FALSE);
}
#else
Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (mmap)");
_YAP_Error(SYSTEM_ERROR,ARG1,"create_mmapped_array (mmap)");
return (FALSE);
#endif
}
@ -1165,7 +1139,7 @@ replace_array_references_complex(register CELL *pt0,
Term Var)
{
register CELL **to_visit = (CELL **) PreAllocCodeSpace();
register CELL **to_visit = (CELL **) _YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit;
loop:
@ -1261,7 +1235,7 @@ loop:
}
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 t2 = TailOfTerm(t);
return (unify(t1, ARG2) && unify(t2, ARG3));
return (_YAP_unify(t1, ARG2) && _YAP_unify(t2, ARG3));
}
static Int
@ -1327,22 +1301,22 @@ p_assign_static(void)
indx = IntOfTerm(t2);
else {
union arith_ret v;
if (Eval(t2, &v) == long_int_e) {
if (_YAP_Eval(t2, &v) == long_int_e) {
indx = v.Int;
} else {
Error(TYPE_ERROR_INTEGER,t2,"update_array");
_YAP_Error(TYPE_ERROR_INTEGER,t2,"update_array");
return (FALSE);
}
}
} else {
Error(INSTANTIATION_ERROR,t2,"update_array");
_YAP_Error(INSTANTIATION_ERROR,t2,"update_array");
return (FALSE);
}
t3 = Deref(ARG3);
t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR,t1,"update_array");
_YAP_Error(INSTANTIATION_ERROR,t1,"update_array");
return(FALSE);
}
if (!IsAtomTerm(t1)) {
@ -1351,11 +1325,11 @@ p_assign_static(void)
Functor f = FunctorOfTerm(t1);
/* store the terms to visit */
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_ARRAY,t1,"update_array");
_YAP_Error(TYPE_ERROR_ARRAY,t1,"update_array");
return(FALSE);
}
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);
}
ptr = RepAppl(t1)+indx+1;
@ -1363,11 +1337,11 @@ p_assign_static(void)
MaBind(ptr, t3);
return(TRUE);
#else
Error(SYSTEM_ERROR,t2,"update_array");
_YAP_Error(SYSTEM_ERROR,t2,"update_array");
return(FALSE);
#endif
} else {
Error(TYPE_ERROR_ATOM,t1,"update_array");
_YAP_Error(TYPE_ERROR_ATOM,t1,"update_array");
return(FALSE);
}
}
@ -1382,7 +1356,7 @@ p_assign_static(void)
}
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);
}
@ -1391,7 +1365,7 @@ p_assign_static(void)
ArrayEntry *pp = (ArrayEntry *)ptr;
CELL *pt;
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);
return(FALSE);
}
@ -1402,7 +1376,7 @@ p_assign_static(void)
MaBind(pt, t3);
return(TRUE);
#else
Error(SYSTEM_ERROR,t2,"update_array");
_YAP_Error(SYSTEM_ERROR,t2,"update_array");
return(FALSE);
#endif
}
@ -1410,12 +1384,12 @@ p_assign_static(void)
/* a static array */
if (IsVarTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(INSTANTIATION_ERROR,t3,"assign_static");
_YAP_Error(INSTANTIATION_ERROR,t3,"assign_static");
return (FALSE);
}
if (indx < 0 || indx >= - ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
_YAP_Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
return(FALSE);
}
switch (ptr->ArrayType) {
@ -1426,11 +1400,11 @@ p_assign_static(void)
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e)
else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int;
else {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_INTEGER,t3,"assign_static");
_YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.ints[indx]= i;
@ -1444,15 +1418,15 @@ p_assign_static(void)
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e)
else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int;
else {
Error(TYPE_ERROR_INTEGER,t3,"assign_static");
_YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE);
}
if (i > 127 || i < -128) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_BYTE,t3,"assign_static");
_YAP_Error(TYPE_ERROR_BYTE,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.chars[indx]= i;
@ -1466,16 +1440,16 @@ p_assign_static(void)
if (IsIntTerm(t3))
i = IntOfTerm(t3);
else if (Eval(t3, &v) == long_int_e)
else if (_YAP_Eval(t3, &v) == long_int_e)
i = v.Int;
else {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_INTEGER,t3,"assign_static");
_YAP_Error(TYPE_ERROR_INTEGER,t3,"assign_static");
return (FALSE);
}
if (i > 255 || i < 0) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_UBYTE,t3,"assign_static");
_YAP_Error(TYPE_ERROR_UBYTE,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.chars[indx]= i;
@ -1489,11 +1463,11 @@ p_assign_static(void)
if (IsFloatTerm(t3))
f = FloatOfTerm(t3);
else if (Eval(t3, &v) == double_e)
else if (_YAP_Eval(t3, &v) == double_e)
f = v.dbl;
else {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_FLOAT,t3,"assign_static");
_YAP_Error(TYPE_ERROR_FLOAT,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.floats[indx]= f;
@ -1508,7 +1482,7 @@ p_assign_static(void)
r = IntegerOfTerm(t3);
else {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_PTR,t3,"assign_static");
_YAP_Error(TYPE_ERROR_PTR,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.ptrs[indx]= (AtomEntry *)r;
@ -1519,7 +1493,7 @@ p_assign_static(void)
{
if (!IsAtomTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_ATOM,t3,"assign_static");
_YAP_Error(TYPE_ERROR_ATOM,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.atoms[indx]= t3;
@ -1533,7 +1507,7 @@ p_assign_static(void)
if (!IsDBRefTerm(t3)) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(TYPE_ERROR_DBREF,t3,"assign_static");
_YAP_Error(TYPE_ERROR_DBREF,t3,"assign_static");
return (FALSE);
}
ptr->ValueOfVE.dbrefs[indx]= t3;
@ -1549,9 +1523,9 @@ p_assign_static(void)
DBRef ref = ptr->ValueOfVE.terms[indx];
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){
WRITE_UNLOCK(ptr->ArRWLock);
return(FALSE);
@ -1563,9 +1537,6 @@ p_assign_static(void)
return(TRUE);
}
int compile_arrays = FALSE;
static Int
p_compile_array_refs(void)
{
@ -1593,20 +1564,20 @@ p_sync_mmapped_arrays(void)
}
void
InitArrayPreds(void)
_YAP_InitArrayPreds(void)
{
InitCPred("$create_array", 2, p_create_array, SyncPredFlag);
InitCPred("$array_references", 3, p_array_references, SafePredFlag);
InitCPred("$array_arg", 3, p_array_arg, SafePredFlag);
InitCPred("static_array", 3, p_create_static_array, SafePredFlag|SyncPredFlag);
InitCPred("resize_static_array", 3, p_resize_static_array, SafePredFlag|SyncPredFlag);
InitCPred("mmapped_array", 4, p_create_mmapped_array, SafePredFlag|SyncPredFlag);
InitCPred("update_array", 3, p_assign_static, SafePredFlag);
InitCPred("array_element", 3, p_access_array, 0);
InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag);
InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag);
InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag);
InitCPred("$has_static_array", 1, p_has_static_array, TestPredFlag|SafePredFlag);
_YAP_InitCPred("$create_array", 2, p_create_array, SyncPredFlag);
_YAP_InitCPred("$array_references", 3, p_array_references, SafePredFlag);
_YAP_InitCPred("$array_arg", 3, p_array_arg, SafePredFlag);
_YAP_InitCPred("static_array", 3, p_create_static_array, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("resize_static_array", 3, p_resize_static_array, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("mmapped_array", 4, p_create_mmapped_array, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("update_array", 3, p_assign_static, SafePredFlag);
_YAP_InitCPred("array_element", 3, p_access_array, 0);
_YAP_InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
_YAP_InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag);
_YAP_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag);
_YAP_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, 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[1] = attv->Value;
/* follow the chain */
WGs = (sus_record *)ReadTimedVar(WokenGoals);
WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
new = (sus_record *)H;
H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR));
new->SG = MkApplTerm(FunctorAttGoal, 2, t);
new->SG = _YAP_MkApplTerm(FunctorAttGoal, 2, t);
new->NS = new;
if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)new);
_YAP_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0);
@ -71,7 +71,7 @@ AddFailToQueue(void)
sus_record *new;
/* follow the chain */
WGs = (sus_record *)ReadTimedVar(WokenGoals);
WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
new = (sus_record *)H;
H = (CELL *)(new+1);
new->NR = (sus_record *)(&(new->NR));
@ -79,7 +79,7 @@ AddFailToQueue(void)
new->NS = new;
if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)new);
_YAP_UpdateTimedVar(WokenGoals, (CELL)new);
/* from now on, we have to start waking up goals */
if (CreepFlag != Unsigned(LCL0) - Unsigned(H0))
CreepFlag = Unsigned(LCL0);
@ -101,13 +101,13 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
Int j;
/* 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))
return(FALSE);
RESET_VARIABLE(&(newv->Done));
newv->sus_id = attvars_ext;
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++) {
Term t = Deref(attv->Atts[2*j+1]);
newv->Atts[2*j] = time;
@ -135,7 +135,7 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
}
*to_visit_ptr = to_visit;
*res = (CELL)&(newv->Done);
UpdateTimedVar(DelayedVars, (CELL)(newv->Atts+2*j));
_YAP_UpdateTimedVar(DelayedVars, (CELL)(newv->Atts+2*j));
return(TRUE);
}
@ -177,14 +177,14 @@ WakeAttVar(CELL* pt1, CELL reg2)
/* binding two suspended variables, be careful */
if (susp2->sus_id != attvars_ext) {
/* 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;
}
if (susp2 >= attv) {
if (susp2 == attv) return;
if (!IsVarTerm(susp2->Value) || !IsUnboundVar(susp2->Value)) {
/* oops, our goal is on the queue to be woken */
if (!unify(susp2->Value, (CELL)pt1)) {
if (!_YAP_unify(susp2->Value, (CELL)pt1)) {
AddFailToQueue();
}
}
@ -199,7 +199,7 @@ WakeAttVar(CELL* pt1, CELL reg2)
}
if (!IsVarTerm(attv->Value) || !IsUnboundVar(attv->Value)) {
/* oops, our goal is on the queue to be woken */
if (!unify(attv->Value, reg2)) {
if (!_YAP_unify(attv->Value, reg2)) {
AddFailToQueue();
}
return;
@ -221,17 +221,17 @@ mark_attvar(CELL *orig)
register attvar_record *attv = (attvar_record *)orig;
Int i;
mark_external_reference(&(attv->Value));
mark_external_reference(&(attv->Done));
_YAP_mark_external_reference(&(attv->Value));
_YAP_mark_external_reference(&(attv->Done));
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
static Term
CurrentTime(void) {
return(MkIntegerTerm(TR-(tr_fr_ptr)TrailBase));
return(MkIntegerTerm(TR-(tr_fr_ptr)_YAP_TrailBase));
}
#endif
@ -244,7 +244,7 @@ InitVarTime(void) {
/* so we just init a TR cell that will not harm anyone */
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
Term t = (CELL)H;
*H++ = TermFoundVar;
@ -256,7 +256,7 @@ static Int
PutAtt(attvar_record *attv, Int i, Term tatt) {
Int pos = i*2;
#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
&& timestmp <= TR) {
#if defined(SBA)
@ -297,7 +297,7 @@ RmAtt(attvar_record *attv, Int i) {
Int pos = i *2;
if (!IsVarTerm(attv->Atts[pos+1])) {
#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
&& timestmp <= TR) {
RESET_VARIABLE(attv->Atts+(pos+1));
@ -344,13 +344,13 @@ BuildNewAttVar(Term t, Int i, Term tatt)
Term time;
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)) {
H[0] = t;
H[1] = tatt;
H += 2;
if (!growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage);
if (!_YAP_growglobal(NULL)) {
_YAP_Error(SYSTEM_ERROR, t, _YAP_ErrorMessage);
return FALSE;
}
H -= 2;
@ -365,9 +365,9 @@ BuildNewAttVar(Term t, Int i, Term tatt)
attv->Atts[2*j] = time;
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);
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) {
Int j = 0;
@ -408,7 +408,7 @@ BindAttVar(attvar_record *attv) {
Bind_Global(&(attv->Done), attv->Value);
return(TRUE);
} 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);
}
}
@ -437,8 +437,8 @@ AllAttVars(Term t) {
}
Term
CurrentAttVars(void) {
return(AllAttVars(ReadTimedVar(AttsMutableList)));
_YAP_CurrentAttVars(void) {
return(AllAttVars(_YAP_ReadTimedVar(AttsMutableList)));
}
@ -453,14 +453,14 @@ p_put_att(void) {
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
return(PutAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
}
return(BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
} else {
Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
}
@ -476,14 +476,14 @@ p_rm_att(void) {
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
return(FALSE);
}
return(RmAtt(attv, IntegerOfTerm(Deref(ARG2))));
}
return(TRUE);
} else {
Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2");
return(FALSE);
}
}
@ -500,16 +500,16 @@ p_get_att(void) {
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
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);
} else {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
}
@ -525,14 +525,14 @@ p_free_att(void) {
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
return(FreeAtt(attv,IntegerOfTerm(Deref(ARG2))));
}
return(TRUE);
} else {
Error(TYPE_ERROR_VARIABLE,inp,"free_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"free_att/2");
return(FALSE);
}
}
@ -548,14 +548,14 @@ p_bind_attvar(void) {
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
return(BindAttVar(attv));
}
return(TRUE);
} else {
Error(TYPE_ERROR_VARIABLE,inp,"bind_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"bind_att/2");
return(FALSE);
}
}
@ -571,14 +571,14 @@ p_get_all_atts(void) {
exts id = (exts)(attv->sus_id);
if (id != attvars_ext) {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
return(unify(ARG2,GetAllAtts(attv)));
return(_YAP_unify(ARG2,GetAllAtts(attv)));
}
return(TRUE);
} else {
Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
_YAP_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
}
@ -588,21 +588,21 @@ p_inc_atts(void)
{
Term t = MkIntegerTerm(NUM_OF_ATTS);
NUM_OF_ATTS++;
return(unify(ARG1,t));
return(_YAP_unify(ARG1,t));
}
static Int
p_n_atts(void)
{
Term t = MkIntegerTerm(NUM_OF_ATTS);
return(unify(ARG1,t));
return(_YAP_unify(ARG1,t));
}
static Int
p_all_attvars(void)
{
Term t = ReadTimedVar(AttsMutableList);
return(unify(ARG1,AllAttVars(t)));
Term t = _YAP_ReadTimedVar(AttsMutableList);
return(_YAP_unify(ARG1,AllAttVars(t)));
}
static Int
@ -625,24 +625,24 @@ p_attvar_bound(void)
!IsUnboundVar(((attvar_record *)VarOfTerm(t))->Done));
}
void InitAttVarPreds(void)
void _YAP_InitAttVarPreds(void)
{
attas[attvars_ext].bind_op = WakeAttVar;
attas[attvars_ext].copy_term_op = CopyAttVar;
attas[attvars_ext].to_term_op = AttVarToTerm;
attas[attvars_ext].term_to_op = TermToAttVar;
attas[attvars_ext].mark_op = mark_attvar;
InitCPred("get_att", 3, p_get_att, SafePredFlag);
InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
InitCPred("free_att", 2, p_free_att, SafePredFlag);
InitCPred("put_att", 3, p_put_att, 0);
InitCPred("rm_att", 2, p_rm_att, SafePredFlag);
InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag);
InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
_YAP_InitCPred("get_att", 3, p_get_att, SafePredFlag);
_YAP_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
_YAP_InitCPred("free_att", 2, p_free_att, SafePredFlag);
_YAP_InitCPred("put_att", 3, p_put_att, 0);
_YAP_InitCPred("rm_att", 2, p_rm_att, SafePredFlag);
_YAP_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag);
_YAP_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
_YAP_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
_YAP_InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
_YAP_InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
_YAP_InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
}
#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);
}
if (p0 == NIL) {
p = (BBProp)AllocAtomSpace(sizeof(*p));
p = (BBProp)_YAP_AllocAtomSpace(sizeof(*p));
if (p == NULL) {
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);
}
p->NextOfPE = ae->PropsOfAE;
@ -64,7 +64,7 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
UInt hash_key;
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) {
UInt i = 0;
Prop *pp = INT_BB_KEYS;
@ -73,7 +73,7 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
pp++;
}
} 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);
}
}
@ -87,10 +87,10 @@ PutIntBBProp(Int key, SMALLUNSGN mod) /* get BBentry for at; */
}
if (p0 == NIL) {
YAPEnterCriticalSection();
p = (BBProp)AllocAtomSpace(sizeof(*p));
p = (BBProp)_YAP_AllocAtomSpace(sizeof(*p));
if (p == NULL) {
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);
}
p->ModuleOfBB = mod;
@ -157,10 +157,10 @@ resize_bb_int_keys(UInt new_size) {
YAPLeaveCriticalSection();
return(TRUE);
}
new = (Prop *)AllocCodeSpace(sizeof(Prop)*new_size);
new = (Prop *)_YAP_AllocCodeSpace(sizeof(Prop)*new_size);
if (new == NULL) {
YAPLeaveCriticalSection();
Error(SYSTEM_ERROR,ARG1,"could not allocate space");
_YAP_Error(SYSTEM_ERROR,ARG1,"could not allocate space");
return(FALSE);
}
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_SIZE = new_size;
YAPLeaveCriticalSection();
@ -193,7 +193,7 @@ AddBBProp(Term t1, char *msg, SMALLUNSGN mod)
restart:
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, msg);
_YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL);
} if (IsAtomTerm(t1)) {
p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod);
@ -203,14 +203,14 @@ AddBBProp(Term t1, char *msg, SMALLUNSGN mod)
Term tmod = ArgOfTerm(1, t1);
if (!IsVarTerm(tmod) ) {
t1 = ArgOfTerm(2, t1);
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
goto restart;
} else {
Error(INSTANTIATION_ERROR, t1, msg);
_YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL);
}
} else {
Error(TYPE_ERROR_ATOM, t1, msg);
_YAP_Error(TYPE_ERROR_ATOM, t1, msg);
return(NULL);
}
return(p);
@ -223,7 +223,7 @@ FetchBBProp(Term t1, char *msg, SMALLUNSGN mod)
restart:
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, msg);
_YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL);
} if (IsAtomTerm(t1)) {
p = GetBBProp(RepAtom(AtomOfTerm(t1)), mod);
@ -232,15 +232,15 @@ FetchBBProp(Term t1, char *msg, SMALLUNSGN mod)
} else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
Term tmod = ArgOfTerm(1, t1);
if (!IsVarTerm(tmod) ) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t1 = ArgOfTerm(2, t1);
goto restart;
} else {
Error(INSTANTIATION_ERROR, t1, msg);
_YAP_Error(INSTANTIATION_ERROR, t1, msg);
return(NULL);
}
} else {
Error(TYPE_ERROR_ATOM, t1, msg);
_YAP_Error(TYPE_ERROR_ATOM, t1, msg);
return(NULL);
}
return(p);
@ -255,9 +255,9 @@ p_bb_put(void)
return(FALSE);
WRITE_LOCK(p->BBRWLock);
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);
return(p->Element != NULL);
}
@ -271,9 +271,9 @@ p_bb_get(void)
if (p == NULL || p->Element == NULL)
return(FALSE);
READ_LOCK(p->BBRWLock);
out = FetchTermFromDB(p->Element,3);
out = _YAP_FetchTermFromDB(p->Element,3);
READ_UNLOCK(p->BBRWLock);
return(unify(ARG2,out));
return(_YAP_unify(ARG2,out));
}
static Int
@ -286,12 +286,12 @@ p_bb_delete(void)
p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
if (p == NULL || p->Element == NULL)
return(FALSE);
out = FetchTermFromDB(p->Element,3);
out = _YAP_FetchTermFromDB(p->Element,3);
WRITE_LOCK(p->BBRWLock);
ReleaseTermFromDB(p->Element);
_YAP_ReleaseTermFromDB(p->Element);
p->Element = NULL;
WRITE_UNLOCK(p->BBRWLock);
return(unify(ARG2,out));
return(_YAP_unify(ARG2,out));
}
static Int
@ -305,14 +305,14 @@ p_bb_update(void)
if (p == NULL || p->Element == NULL)
return(FALSE);
WRITE_LOCK(p->BBRWLock);
out = FetchTermFromDB(p->Element,3);
if (!unify(ARG2,out)) {
out = _YAP_FetchTermFromDB(p->Element,3);
if (!_YAP_unify(ARG2,out)) {
WRITE_UNLOCK(p->BBRWLock);
return(FALSE);
}
ReleaseTermFromDB(p->Element);
p->Element = StoreTermInDB(3,3);
_YAP_ReleaseTermFromDB(p->Element);
p->Element = _YAP_StoreTermInDB(3,3);
WRITE_UNLOCK(p->BBRWLock);
return(p->Element != NULL);
}
@ -322,22 +322,22 @@ p_resize_bb_int_keys(void)
{
Term t1 = Deref(ARG1);
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)) {
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(resize_bb_int_keys(IntegerOfTerm(t1)));
}
void
InitBBPreds(void)
_YAP_InitBBPreds(void)
{
InitCPred("bb_put", 2, p_bb_put, 0);
InitCPred("bb_get", 2, p_bb_get, 0);
InitCPred("bb_delete", 2, p_bb_delete, 0);
InitCPred("bb_update", 3, p_bb_update, 0);
InitCPred("$resize_bb_int_keys", 1, p_resize_bb_int_keys, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("bb_put", 2, p_bb_put, 0);
_YAP_InitCPred("bb_get", 2, p_bb_get, 0);
_YAP_InitCPred("bb_delete", 2, p_bb_delete, 0);
_YAP_InitCPred("bb_update", 3, p_bb_update, 0);
_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;
MP_INT *
PreAllocBigNum(void)
_YAP_PreAllocBigNum(void)
{
MP_INT *ret;
@ -54,14 +54,14 @@ PreAllocBigNum(void)
}
void
CleanBigNum(void)
_YAP_CleanBigNum(void)
{
H = pre_alloc_base;
pre_alloc_base = NULL;
}
MP_INT *
InitBigNum(Int in)
_YAP_InitBigNum(Int in)
{
MP_INT *ret;
@ -99,7 +99,7 @@ AllocBigNumSpace(size_t size)
alloc_ptr[0] = size;
alloc_ptr += size+1;
if (alloc_ptr > ASP-1024)
Error(SYSTEM_ERROR,TermNil,"no space for bignum");
_YAP_Error(SYSTEM_ERROR,TermNil,"no space for bignum");
return(ret);
}
@ -117,7 +117,7 @@ ReAllocBigNumSpace(void *optr, size_t osize, size_t size)
alloc_ptr += (size-osize);
((CELL *)optr)[-1] = size;
if (alloc_ptr > ASP-1024)
Error(SYSTEM_ERROR,TermNil,"no space for bignum");
_YAP_Error(SYSTEM_ERROR,TermNil,"no space for bignum");
return(optr);
}
out = AllocBigNumSpace(size);
@ -154,7 +154,7 @@ FreeBigNumSpace(void *optr, size_t size)
pre_alloc_base;
*/
Term
MkBigIntTerm(MP_INT *big)
_YAP_MkBigIntTerm(MP_INT *big)
{
CELL *new = (CELL *)(big+1);
Int nlimbs = (big->_mp_alloc)*(sizeof(mp_limb_t)/CellSize);
@ -198,7 +198,7 @@ MkBigIntTerm(MP_INT *big)
}
MP_INT *
BigIntOfTerm(Term t)
_YAP_BigIntOfTerm(Term t)
{
MP_INT *new = (MP_INT *)(RepAppl(t)+1);
@ -220,7 +220,7 @@ p_is_bignum(void)
}
void
InitBigNums(void)
_YAP_InitBigNums(void)
{
#ifdef USE_GMP
/* YAP style memory allocation */
@ -229,5 +229,5 @@ InitBigNums(void)
ReAllocBigNumSpace,
FreeBigNumSpace);
#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
YAP_LookupAtom(char *c)
{
return(LookupAtom(c));
return(_YAP_LookupAtom(c));
}
X_API Atom
@ -270,7 +270,7 @@ YAP_FullLookupAtom(char *c)
{
Atom at;
at = FullLookupAtom(c);
at = _YAP_FullLookupAtom(c);
return(at);
}
@ -304,7 +304,7 @@ YAP_MkNewPairTerm()
Term t;
BACKUP_H();
t = MkNewPairTerm();
t = _YAP_MkNewPairTerm();
RECOVER_H();
return(t);
@ -328,7 +328,7 @@ YAP_MkApplTerm(Functor f,unsigned long int arity, Term args[])
Term t;
BACKUP_H();
t = MkApplTerm(f, arity, args);
t = _YAP_MkApplTerm(f, arity, args);
RECOVER_H();
return(t);
@ -340,7 +340,7 @@ YAP_MkNewApplTerm(Functor f,unsigned long int arity)
Term t;
BACKUP_H();
t = MkNewApplTerm(f, arity);
t = _YAP_MkNewApplTerm(f, arity);
RECOVER_H();
return(t);
@ -364,7 +364,7 @@ YAP_ArgOfTerm(Int n, Term t)
X_API Functor
YAP_MkFunctor(Atom a, Int n)
{
return (MkFunctor(a, n));
return (_YAP_MkFunctor(a, n));
}
X_API Atom
@ -422,7 +422,7 @@ YAP_Unify(Term t1, Term t2)
Int out;
BACKUP_MACHINE_REGS();
out = unify(t1, t2);
out = _YAP_unify(t1, t2);
RECOVER_MACHINE_REGS();
return(out);
@ -573,10 +573,10 @@ YAP_CallProlog(Term t)
Term tmod = ArgOfTerm(1,t);
if (IsVarTerm(tmod)) return(FALSE);
if (!IsAtomTerm(tmod)) return(FALSE);
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
}
out = execute_goal(t, 0, mod);
out = _YAP_execute_goal(t, 0, mod);
RECOVER_MACHINE_REGS();
return(out);
}
@ -587,9 +587,9 @@ YAP_AllocSpaceFromYap(unsigned int size)
void *ptr;
BACKUP_MACHINE_REGS();
if ((ptr = AllocCodeSpace(size)) == NULL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if ((ptr = _YAP_AllocCodeSpace(size)) == NULL) {
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(NULL);
}
}
@ -601,7 +601,7 @@ YAP_AllocSpaceFromYap(unsigned int size)
X_API void
YAP_FreeSpaceFromYap(void *ptr)
{
FreeCodeSpace(ptr);
_YAP_FreeCodeSpace(ptr);
}
/* copy a string to a buffer */
@ -616,15 +616,15 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
Head = HeadOfTerm(t);
if (IsVarTerm(Head)) {
Error(INSTANTIATION_ERROR,Head,"user defined procedure");
_YAP_Error(INSTANTIATION_ERROR,Head,"user defined procedure");
return(FALSE);
} 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);
}
i = IntOfTerm(Head);
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);
}
buf[j++] = i;
@ -634,10 +634,10 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
}
t = TailOfTerm(t);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"user defined procedure");
_YAP_Error(INSTANTIATION_ERROR,t,"user defined procedure");
return(FALSE);
} 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);
}
}
@ -653,7 +653,7 @@ YAP_BufferToString(char *s)
Term t;
BACKUP_H();
t = StringToList(s);
t = _YAP_StringToList(s);
RECOVER_H();
return(t);
@ -666,7 +666,7 @@ YAP_BufferToAtomList(char *s)
Term t;
BACKUP_H();
t = StringToListOfAtoms(s);
t = _YAP_StringToListOfAtoms(s);
RECOVER_H();
return(t);
@ -676,7 +676,7 @@ YAP_BufferToAtomList(char *s)
X_API void
YAP_Error(char *buf)
{
Error(SYSTEM_ERROR,TermNil,buf);
_YAP_Error(SYSTEM_ERROR,TermNil,buf);
}
static void myputc (int ch)
@ -691,7 +691,7 @@ YAP_RunGoal(Term t)
yamop *old_CP = CP;
BACKUP_MACHINE_REGS();
out = RunTopGoal(t);
out = _YAP_RunTopGoal(t);
if (out) {
P = (yamop *)ENV[E_CP];
ENV = (CELL *)ENV[E_E];
@ -713,10 +713,10 @@ YAP_RestartGoal(void)
P = (yamop *)FAILCODE;
do_putcf = myputc;
out = exec_absmi(TRUE);
out = _YAP_exec_absmi(TRUE);
if (out == FALSE) {
/* cleanup */
trust_last();
_YAP_trust_last();
}
RECOVER_MACHINE_REGS();
@ -729,7 +729,7 @@ YAP_ContinueGoal(void)
int out;
BACKUP_MACHINE_REGS();
out = exec_absmi(TRUE);
out = _YAP_exec_absmi(TRUE);
RECOVER_MACHINE_REGS();
return(out);
@ -767,9 +767,9 @@ YAP_InitConsult(int mode, char *filename)
BACKUP_MACHINE_REGS();
if (mode == YAP_CONSULT_MODE)
init_consult(FALSE, filename);
_YAP_init_consult(FALSE, filename);
else
init_consult(TRUE, filename);
_YAP_init_consult(TRUE, filename);
RECOVER_MACHINE_REGS();
}
@ -779,7 +779,7 @@ YAP_EndConsult(void)
{
BACKUP_MACHINE_REGS();
end_consult();
_YAP_end_consult();
RECOVER_MACHINE_REGS();
}
@ -794,14 +794,14 @@ YAP_Read(int (*mygetc)(void))
do_getf = mygetc;
old_TR = TR;
tokptr = toktide = tokenizer(do_yap_getc, do_yap_getc);
if (ErrorMessage)
_YAP_tokptr = _YAP_toktide = _YAP_tokenizer(do_yap_getc, do_yap_getc);
if (_YAP_ErrorMessage)
{
TR = old_TR;
save_machine_regs();
return(0);
}
t = Parse();
t = _YAP_Parse();
TR = old_TR;
RECOVER_MACHINE_REGS();
@ -814,7 +814,7 @@ YAP_Write(Term t, void (*myputc)(int), int flags)
BACKUP_MACHINE_REGS();
do_putcf = myputc;
plwrite (t, do_yap_putc, flags);
_YAP_plwrite (t, do_yap_putc, flags);
RECOVER_MACHINE_REGS();
}
@ -822,22 +822,22 @@ YAP_Write(Term t, void (*myputc)(int), int flags)
X_API char *
YAP_CompileClause(Term t)
{
char *ErrorMessage;
char *_YAP_ErrorMessage;
CODEADDR codeaddr;
int mod = CurrentModule;
BACKUP_MACHINE_REGS();
ErrorMessage = NULL;
_YAP_ErrorMessage = NULL;
ARG1 = t;
codeaddr = cclause (t,0, mod);
codeaddr = _YAP_cclause (t,0, mod);
if (codeaddr != NULL) {
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();
return(ErrorMessage);
return(_YAP_ErrorMessage);
}
/* 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;
BACKUP_MACHINE_REGS();
yap_args = yap_init->Argv;
yap_argc = yap_init->Argc;
_YAP_argv = yap_init->Argv;
_YAP_argc = yap_init->Argc;
if (yap_init->SavedState != 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);
}
}
@ -876,18 +876,19 @@ YAP_Init(YAP_init_args *yap_init)
} else {
Heap = yap_init->HeapSize;
}
InitStacks (Heap, Stack, Trail,
_YAP_InitStacks (Heap, Stack, Trail,
yap_init->NumberWorkers,
yap_init->SchedulerLoop,
yap_init->DelayedReleaseLoad
);
InitYaamRegs();
_YAP_InitYaamRegs();
#if HAVE_MPI
InitMPI ();
_YAP_InitMPI ();
#endif
#if HAVE_MPE
InitMPE ();
_YAP_InitMPE ();
#endif
if (yap_init->YapPrologRCFile != NULL) {
@ -899,7 +900,7 @@ YAP_Init(YAP_init_args *yap_init)
}
if (yap_init->SavedState != 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 {
restore_result = FAIL_RESTORE;
}
@ -917,12 +918,12 @@ YAP_Init(YAP_init_args *yap_init)
In the SBA we cannot just happily inherit registers
from the other workers
*/
InitYaamRegs();
_YAP_InitYaamRegs();
#endif
/* slaves, waiting for work */
CurrentModule = 1;
P = GETWORK_FIRST_TIME;
exec_absmi(FALSE);
_YAP_exec_absmi(FALSE);
abort_optyap("abstract machine unexpected exit");
}
#endif /* YAPOR */
@ -930,7 +931,7 @@ YAP_Init(YAP_init_args *yap_init)
RECOVER_MACHINE_REGS();
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
has been overwritten ....
@ -976,13 +977,13 @@ YAP_FastInit(char saved_state[])
X_API void
YAP_PutValue(Atom at, Term t)
{
PutValue(at, t);
_YAP_PutValue(at, t);
}
X_API Term
YAP_GetValue(Atom at)
{
return(GetValue(at));
return(_YAP_GetValue(at));
}
X_API int
@ -995,11 +996,11 @@ YAP_Reset(void)
while (B->cp_b != NULL)
B = B->cp_b;
P = (yamop *)FAILCODE;
if (exec_absmi(0) != 0)
if (_YAP_exec_absmi(0) != 0)
return(FALSE);
}
/* reinitialise the engine */
InitYaamRegs();
_YAP_InitYaamRegs();
RECOVER_MACHINE_REGS();
return(TRUE);
@ -1008,14 +1009,14 @@ YAP_Reset(void)
X_API void
YAP_Exit(int retval)
{
exit_yap(retval);
_YAP_exit(retval);
}
X_API void
YAP_InitSocks(char *host, long port)
{
#if USE_SOCKET
init_socks(host, port);
_YAP_init_socks(host, port);
#endif
}
@ -1030,7 +1031,7 @@ YAP_SetOutputMessage(void)
X_API int
YAP_StreamToFileNo(Term t)
{
return(StreamToFileNo(t));
return(_YAP_StreamToFileNo(t));
}
X_API void
@ -1038,7 +1039,7 @@ YAP_CloseAllOpenStreams(void)
{
BACKUP_H();
CloseStreams(FALSE);
_YAP_CloseStreams(FALSE);
RECOVER_H();
}
@ -1050,7 +1051,7 @@ YAP_OpenStream(void *fh, char *name, Term nm, int flags)
BACKUP_H();
retv = OpenStream((FILE *)fh, name, nm, flags);
retv = _YAP_OpenStream((FILE *)fh, name, nm, flags);
RECOVER_H();
return retv;
@ -1060,14 +1061,14 @@ X_API void
YAP_Throw(Term t)
{
BACKUP_MACHINE_REGS();
JumpToEnv(t);
_YAP_JumpToEnv(t);
RECOVER_MACHINE_REGS();
}
X_API int
YAP_LookupModule(Term t)
{
return(LookupModule(t));
return(_YAP_LookupModule(t));
}
X_API Term
@ -1079,7 +1080,7 @@ YAP_ModuleName(int i)
X_API void
YAP_Halt(int i)
{
exit_yap(i);
_YAP_exit(i);
}
X_API CELL *
@ -1094,7 +1095,7 @@ YAP_Predicate(Atom a, unsigned long int arity, int m)
if (arity == 0) {
return((void *)RepPredProp(PredPropByAtom(a,m)));
} else {
Functor f = MkFunctor(a, arity);
Functor f = _YAP_MkFunctor(a, arity);
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
YAP_UserCPredicate(char *name, CPredicate def, unsigned long int arity)
{
InitCPred(name, arity, def, UserCPredFlag);
_YAP_InitCPred(name, arity, def, UserCPredFlag);
}
X_API void
YAP_UserBackCPredicate(char *name, CPredicate init, CPredicate cont,
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
@ -1134,9 +1135,9 @@ YAP_UserCPredicateWithArgs(char *a, CPredicate f, unsigned long int arity, int m
CurrentModule = mod;
YAP_UserCPredicate(a,f,arity);
if (arity == 0) {
pe = RepPredProp(PredPropByAtom(LookupAtom(a),mod));
pe = RepPredProp(PredPropByAtom(_YAP_LookupAtom(a),mod));
} else {
Functor f = MkFunctor(LookupAtom(a), arity);
Functor f = _YAP_MkFunctor(_YAP_LookupAtom(a), arity);
pe = RepPredProp(PredPropByFunc(f,mod));
}
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);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = -mpz_cmp_si(BigIntOfTerm(d1), IntOfTerm(d0));
out = -mpz_cmp_si(_YAP_BigIntOfTerm(d1), IntOfTerm(d0));
#endif
} else if (IsRefTerm(d1))
out = 1 ;
@ -124,7 +124,7 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = -mpz_cmp_si(BigIntOfTerm(d1), LongIntOfTerm(d0));
out = -mpz_cmp_si(_YAP_BigIntOfTerm(d1), LongIntOfTerm(d0));
#endif
} else if (IsRefTerm(d1)) {
out = 1 ;
@ -137,13 +137,13 @@ static int compare_complex(register CELL *pt0, register CELL *pt0_end, register
#ifdef USE_GMP
else if (IsBigIntTerm(d0)) {
if (IsIntTerm(d1))
out = mpz_cmp_si(BigIntOfTerm(d0), IntOfTerm(d1));
out = mpz_cmp_si(_YAP_BigIntOfTerm(d0), IntOfTerm(d1));
else if (IsFloatTerm(d1)) {
out = 1;
} 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))
out = mpz_cmp(BigIntOfTerm(d0), BigIntOfTerm(d1));
out = mpz_cmp(_YAP_BigIntOfTerm(d0), _YAP_BigIntOfTerm(d1));
else if (IsRefTerm(d1))
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));
#ifdef USE_GMP
if (IsBigIntTerm(t2))
return(-mpz_cmp_si(BigIntOfTerm(t2),IntOfTerm(t1)));
return(-mpz_cmp_si(_YAP_BigIntOfTerm(t2),IntOfTerm(t1)));
#endif
if (IsRefTerm(t2))
return (1);
@ -331,7 +331,7 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
return (LongIntOfTerm(t1) - LongIntOfTerm(t2));
#ifdef USE_GMP
if (IsBigIntTerm(t2))
return(-mpz_cmp_si(BigIntOfTerm(t2), LongIntOfTerm(t1)));
return(-mpz_cmp_si(_YAP_BigIntOfTerm(t2), LongIntOfTerm(t1)));
#endif
if (IsRefTerm(t2))
return (1);
@ -340,14 +340,14 @@ compare(register Term t1,register Term t2) /* compare terms t1 and t2 */
#ifdef USE_GMP
if (IsBigIntTerm(t1)) {
if (IsIntTerm(t2))
return(mpz_cmp_si(BigIntOfTerm(t1), IntOfTerm(t2)));
return(mpz_cmp_si(_YAP_BigIntOfTerm(t1), IntOfTerm(t2)));
if (IsFloatTerm(t2)) {
return(1);
}
if (IsLongIntTerm(t2))
return(mpz_cmp_si(BigIntOfTerm(t1), LongIntOfTerm(t2)));
return(mpz_cmp_si(_YAP_BigIntOfTerm(t1), LongIntOfTerm(t2)));
if (IsBigIntTerm(t2))
return(mpz_cmp(BigIntOfTerm(t1), BigIntOfTerm(t2)));
return(mpz_cmp(_YAP_BigIntOfTerm(t1), _YAP_BigIntOfTerm(t2)));
if (IsRefTerm(t2))
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)
{
return (compare(d0,d1) == 0);
}
int compare_terms(register CELL d0, register CELL d1)
int _YAP_compare_terms(register CELL d0, register CELL d1)
{
return (compare(d0,d1));
}
@ -421,29 +416,29 @@ p_compare(void)
p = AtomGT;
else
p = AtomEQ;
return (unify_constant(ARG1, MkAtomTerm(p)));
return (_YAP_unify_constant(ARG1, MkAtomTerm(p)));
}
inline static int
int_cmp(Int dif)
{
if (dif < 0)
return(unify_constant(ARG1,MkAtomTerm(AtomLT)));
return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomLT)));
else if (dif > 0)
return(unify_constant(ARG1,MkAtomTerm(AtomGT)));
return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomGT)));
else
return(unify_constant(ARG1,MkAtomTerm(AtomEQ)));
return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomEQ)));
}
inline static int
flt_cmp(Float dif)
{
if (dif < 0.0)
return(unify_constant(ARG1,MkAtomTerm(AtomLT)));
return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomLT)));
else if (dif > 0.0)
return(unify_constant(ARG1,MkAtomTerm(AtomGT)));
return(_YAP_unify_constant(ARG1,MkAtomTerm(AtomGT)));
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;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=:=/2");
_YAP_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=:=/2");
_YAP_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
@ -468,12 +463,12 @@ p_acomp(void)
} if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)));
}
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -491,7 +486,7 @@ p_acomp(void)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -510,7 +505,7 @@ p_acomp(void)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -536,23 +531,23 @@ a_eq(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=:=/2");
_YAP_Error(INSTANTIATION_ERROR, t1, "=:=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=:=/2");
_YAP_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) == FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -570,7 +565,7 @@ a_eq(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -589,7 +584,7 @@ a_eq(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -621,23 +616,23 @@ a_dif(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=\\=/2");
_YAP_Error(INSTANTIATION_ERROR, t1, "=\\=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=\\=/2");
_YAP_Error(INSTANTIATION_ERROR, t2, "=\\=/2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) != FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -655,7 +650,7 @@ a_dif(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -674,7 +669,7 @@ a_dif(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -706,23 +701,23 @@ a_gt(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, ">/2");
_YAP_Error(INSTANTIATION_ERROR, t1, ">/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, ">/2");
_YAP_Error(INSTANTIATION_ERROR, t2, ">/2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) > FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -740,7 +735,7 @@ a_gt(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -759,7 +754,7 @@ a_gt(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -791,23 +786,23 @@ a_ge(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, ">=/2");
_YAP_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t1, ">=/2");
_YAP_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) >= FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -825,7 +820,7 @@ a_ge(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -844,7 +839,7 @@ a_ge(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -876,23 +871,23 @@ a_lt(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "</2");
_YAP_Error(INSTANTIATION_ERROR, t1, "</2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "</2");
_YAP_Error(INSTANTIATION_ERROR, t2, "</2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) < FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -910,7 +905,7 @@ a_lt(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -929,7 +924,7 @@ a_lt(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -961,23 +956,23 @@ a_le(Term t1, Term t2)
union arith_ret v1;
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "=</2");
_YAP_Error(INSTANTIATION_ERROR, t1, "=</2");
return(FALSE);
}
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR, t2, "=</2");
_YAP_Error(INSTANTIATION_ERROR, t2, "=</2");
return(FALSE);
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) <= FloatOfTerm(t2));
bt1 = Eval(t1, &v1);
bt1 = _YAP_Eval(t1, &v1);
switch (bt1) {
case long_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -995,7 +990,7 @@ a_le(Term t1, Term t2)
case double_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -1014,7 +1009,7 @@ a_le(Term t1, Term t2)
case big_int_e:
{
union arith_ret v2;
blob_type bt2 = Eval(t2, &v2);
blob_type bt2 = _YAP_Eval(t2, &v2);
switch (bt2) {
case long_int_e:
@ -1071,19 +1066,19 @@ p_gen_ge(void)
void
InitCmpPreds(void)
_YAP_InitCmpPreds(void)
{
InitCmpPred("=:=", 2, a_eq, p_eq, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("=\\=", 2, a_dif, p_dif, SafePredFlag | BinaryTestPredFlag);
InitCmpPred(">", 2, a_gt, p_gt, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("=<", 2, a_le, p_le, SafePredFlag | BinaryTestPredFlag);
InitCmpPred("<", 2, a_lt, p_lt, SafePredFlag | BinaryTestPredFlag);
InitCmpPred(">=", 2, a_ge, p_ge, SafePredFlag | BinaryTestPredFlag);
InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag);
InitCPred("\\==", 2, p_noteq, TestPredFlag | SafePredFlag);
InitCPred("@<", 2, p_gen_lt, TestPredFlag | SafePredFlag);
InitCPred("@=<", 2, p_gen_le, TestPredFlag | SafePredFlag);
InitCPred("@>", 2, p_gen_gt, TestPredFlag | SafePredFlag);
InitCPred("@>=", 2, p_gen_ge, TestPredFlag | SafePredFlag);
InitCPred("compare", 3, p_compare, TestPredFlag | SafePredFlag);
_YAP_InitCmpPred("=:=", 2, a_eq, p_eq, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCmpPred("=\\=", 2, a_dif, p_dif, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCmpPred(">", 2, a_gt, p_gt, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCmpPred("=<", 2, a_le, p_le, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCmpPred("<", 2, a_lt, p_lt, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCmpPred(">=", 2, a_ge, p_ge, SafePredFlag | BinaryTestPredFlag);
_YAP_InitCPred("$a_compare", 3, p_acomp, TestPredFlag | SafePredFlag);
_YAP_InitCPred("\\==", 2, p_noteq, TestPredFlag | SafePredFlag);
_YAP_InitCPred("@<", 2, p_gen_lt, TestPredFlag | SafePredFlag);
_YAP_InitCPred("@=<", 2, p_gen_le, TestPredFlag | SafePredFlag);
_YAP_InitCPred("@>", 2, p_gen_gt, TestPredFlag | SafePredFlag);
_YAP_InitCPred("@>=", 2, p_gen_ge, 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
*/
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)
{
char *p;
@ -62,13 +66,19 @@ AllocCMem (int size)
freep += size;
if (ASP <= CellPtr (freep) + 256) {
save_machine_regs();
longjmp(CompilerBotch,3);
longjmp(_YAP_CompilerBotch,3);
}
return (p);
}
char *
_YAP_AllocCMem (int size)
{
return(AllocCMem(size));
}
int
is_a_test_pred (Term arg, SMALLUNSGN mod)
_YAP_is_a_test_pred (Term arg, SMALLUNSGN mod)
{
if (IsVarTerm (arg))
return (FALSE);
@ -93,7 +103,7 @@ is_a_test_pred (Term arg, SMALLUNSGN mod)
}
void
emit (compiler_vm_op o, Int r1, CELL r2)
_YAP_emit (compiler_vm_op o, Int r1, CELL r2)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p));
@ -111,7 +121,7 @@ emit (compiler_vm_op o, Int r1, CELL r2)
}
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;
p = (PInstr *) AllocCMem (sizeof (*p)+sizeof(CELL));
@ -130,7 +140,7 @@ emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3)
}
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;
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);
}
void
static void
bip_name(Int op, char *s)
{
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
static void
@ -243,7 +258,7 @@ ShowOp (f)
{
case 'a':
case 'n':
plwrite ((Term) arg, DebugPutc, 0);
_YAP_plwrite ((Term) arg, _YAP_DebugPutc, 0);
break;
case 'b':
/* write a variable bitmap for a call */
@ -251,32 +266,32 @@ ShowOp (f)
int max = arg/(8*sizeof(CELL)), i;
CELL *ptr = cptr;
for (i = 0; i <= max; i++) {
plwrite(MkIntegerTerm((Int)(*ptr++)), DebugPutc, 0);
_YAP_plwrite(MkIntegerTerm((Int)(*ptr++)), _YAP_DebugPutc, 0);
}
}
break;
case 'l':
plwrite (MkIntTerm (arg), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (arg), _YAP_DebugPutc, 0);
break;
case 'B':
{
char s[32];
bip_name(rn,s);
plwrite (MkAtomTerm(LookupAtom(s)), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm(_YAP_LookupAtom(s)), _YAP_DebugPutc, 0);
}
break;
case 'd':
plwrite (MkIntTerm (rn), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break;
case 'z':
plwrite (MkIntTerm (cpc->rnd3), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (cpc->rnd3), _YAP_DebugPutc, 0);
break;
case 'v':
{
Ventry *v = (Ventry *) arg;
DebugPutc (c_output_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
_YAP_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), _YAP_DebugPutc, 0);
}
break;
case 'N':
@ -286,14 +301,14 @@ ShowOp (f)
cpc = cpc->nextInst;
arg = cpc->rnd1;
v = (Ventry *) arg;
DebugPutc (c_output_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X');
_YAP_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), _YAP_DebugPutc, 0);
}
break;
case 'm':
plwrite (MkAtomTerm ((Atom) arg), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (rn), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm ((Atom) arg), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break;
case 'p':
{
@ -303,14 +318,14 @@ ShowOp (f)
SMALLUNSGN mod = 0;
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
plwrite (ModuleName[mod], DebugPutc, 0);
DebugPutc (c_output_stream,':');
_YAP_plwrite (ModuleName[mod], _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,':');
if (arity == 0)
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm ((Atom)f), _YAP_DebugPutc, 0);
else
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (arity), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (NameOfFunctor (f)), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite (MkIntTerm (arity), _YAP_DebugPutc, 0);
}
break;
case 'P':
@ -321,88 +336,88 @@ ShowOp (f)
SMALLUNSGN mod = 0;
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
plwrite (ModuleName[mod], DebugPutc, 0);
DebugPutc (c_output_stream,':');
_YAP_plwrite (ModuleName[mod], _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,':');
if (arity == 0)
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm ((Atom)f), _YAP_DebugPutc, 0);
else
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (arity), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (NameOfFunctor (f)), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite (MkIntTerm (arity), _YAP_DebugPutc, 0);
}
break;
case 'f':
if (IsExtensionFunctor((Functor)arg)) {
if ((Functor)arg == FunctorDBRef) {
plwrite(MkAtomTerm(LookupAtom("DBRef")), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("DBRef")), _YAP_DebugPutc, 0);
} 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) {
plwrite(MkAtomTerm(LookupAtom("Double")), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("Double")), _YAP_DebugPutc, 0);
}
} else {
plwrite(MkAtomTerm(NameOfFunctor ((Functor) arg)), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite(MkIntTerm(ArityOfFunctor ((Functor) arg)), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(NameOfFunctor ((Functor) arg)), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite(MkIntTerm(ArityOfFunctor ((Functor) arg)), _YAP_DebugPutc, 0);
}
break;
case 'r':
DebugPutc (c_output_stream,'A');
plwrite (MkIntTerm (rn), DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'A');
_YAP_plwrite (MkIntTerm (rn), _YAP_DebugPutc, 0);
break;
case 'h':
{
CELL my_arg = *cptr++;
if (my_arg & 1)
plwrite (MkIntTerm (my_arg),
DebugPutc, 0);
_YAP_plwrite (MkIntTerm (my_arg),
_YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else
plwrite (MkIntegerTerm ((Int) my_arg),
DebugPutc, 0);
_YAP_plwrite (MkIntegerTerm ((Int) my_arg),
_YAP_DebugPutc, 0);
}
break;
case 'g':
if (arg & 1)
plwrite (MkIntTerm (arg),
DebugPutc, 0);
_YAP_plwrite (MkIntTerm (arg),
_YAP_DebugPutc, 0);
else if (arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else
plwrite (MkIntegerTerm ((Int) arg), DebugPutc, 0);
_YAP_plwrite (MkIntegerTerm ((Int) arg), _YAP_DebugPutc, 0);
break;
case 'i':
plwrite (MkIntTerm (arg), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (arg), _YAP_DebugPutc, 0);
break;
case 'j':
{
Functor fun = (Functor)*cptr++;
if (IsExtensionFunctor(fun)) {
if (fun == FunctorDBRef) {
plwrite(MkAtomTerm(LookupAtom("DBRef")), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("DBRef")), _YAP_DebugPutc, 0);
} else if (fun == FunctorLongInt) {
plwrite(MkAtomTerm(LookupAtom("LongInt")), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("LongInt")), _YAP_DebugPutc, 0);
} else if (fun == FunctorDouble) {
plwrite(MkAtomTerm(LookupAtom("Double")), DebugPutc, 0);
_YAP_plwrite(MkAtomTerm(_YAP_LookupAtom("Double")), _YAP_DebugPutc, 0);
}
} else {
plwrite (MkAtomTerm(NameOfFunctor(fun)), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm(ArityOfFunctor(fun)), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm(NameOfFunctor(fun)), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite (MkIntTerm(ArityOfFunctor(fun)), _YAP_DebugPutc, 0);
}
}
break;
case 'O':
plwrite(AbsAppl(cptr), DebugPutc, 0);
_YAP_plwrite(AbsAppl(cptr), _YAP_DebugPutc, 0);
break;
case 'x':
plwrite (MkIntTerm (rn >> 1), DebugPutc, 0);
DebugPutc (c_output_stream,'\t');
plwrite (MkIntTerm (rn & 1), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (rn >> 1), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'\t');
_YAP_plwrite (MkIntTerm (rn & 1), _YAP_DebugPutc, 0);
break;
case 'o':
plwrite ((Term) * cptr++, DebugPutc, 0);
_YAP_plwrite ((Term) * cptr++, _YAP_DebugPutc, 0);
case 'c':
{
int i;
@ -411,23 +426,23 @@ ShowOp (f)
CELL my_arg;
if (*cptr)
{
plwrite ((Term) * cptr++, DebugPutc, 0);
_YAP_plwrite ((Term) * cptr++, _YAP_DebugPutc, 0);
}
else
{
plwrite (MkIntTerm (0), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (0), _YAP_DebugPutc, 0);
cptr++;
}
DebugPutc (c_output_stream,'\t');
_YAP_DebugPutc (_YAP_c_error_stream,'\t');
my_arg = *cptr++;
if (my_arg & 1)
plwrite (MkIntTerm (my_arg),
DebugPutc, 0);
_YAP_plwrite (MkIntTerm (my_arg),
_YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else
plwrite (MkIntegerTerm ((Int) my_arg), DebugPutc, 0);
DebugPutc (c_output_stream,'\n');
_YAP_plwrite (MkIntegerTerm ((Int) my_arg), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'\n');
}
}
break;
@ -439,36 +454,36 @@ ShowOp (f)
CELL my_arg;
if (*cptr)
{
plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), DebugPutc, 0);
DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (NameOfFunctor ((Functor) * cptr)), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'/');
_YAP_plwrite (MkIntTerm (ArityOfFunctor ((Functor) * cptr++)), _YAP_DebugPutc, 0);
}
else
{
plwrite (MkIntTerm (0), DebugPutc, 0);
_YAP_plwrite (MkIntTerm (0), _YAP_DebugPutc, 0);
cptr++;
}
DebugPutc (c_output_stream,'\t');
_YAP_DebugPutc (_YAP_c_error_stream,'\t');
my_arg = *cptr++;
if (my_arg & 1)
plwrite (MkIntTerm (my_arg),
DebugPutc, 0);
_YAP_plwrite (MkIntTerm (my_arg),
_YAP_DebugPutc, 0);
else if (my_arg == (CELL) FAILCODE)
plwrite (MkAtomTerm (AtomFail), DebugPutc, 0);
_YAP_plwrite (MkAtomTerm (AtomFail), _YAP_DebugPutc, 0);
else
plwrite (MkIntegerTerm ((Int) my_arg), DebugPutc, 0);
DebugPutc (c_output_stream,'\n');
_YAP_plwrite (MkIntegerTerm ((Int) my_arg), _YAP_DebugPutc, 0);
_YAP_DebugPutc (_YAP_c_error_stream,'\n');
}
}
break;
default:
DebugPutc (c_output_stream,'%');
DebugPutc (c_output_stream,ch);
_YAP_DebugPutc (_YAP_c_error_stream,'%');
_YAP_DebugPutc (_YAP_c_error_stream,ch);
}
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[] =
@ -639,7 +654,7 @@ static char *opformat[] =
void
ShowCode ()
_YAP_ShowCode ()
{
CELL *OldH = H;
@ -656,7 +671,7 @@ ShowCode ()
ShowOp (opformat[ic]);
cpc = cpc->nextInst;
}
DebugPutc (c_output_stream,'\n');
_YAP_DebugPutc (_YAP_c_error_stream,'\n');
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
to use the old one. Note that the list is only bound once,
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 *
GetSVarList(void)
{
Term t = ReadTimedVar(MutableList);
Term t = _YAP_ReadTimedVar(MutableList);
/* just return the start of the list */
if (t == TermNil)
return(NULL);
@ -188,9 +188,9 @@ GetSVarList(void)
*/
Term
static Term
ListOfWokenGoals(void) {
sus_record *pt = (sus_record *)ReadTimedVar(WokenGoals);
sus_record *pt = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
Term t;
t = TermNil;
@ -202,13 +202,19 @@ ListOfWokenGoals(void) {
return(t);
}
Term
_YAP_ListOfWokenGoals(void) {
return ListOfWokenGoals();
}
static void ReleaseGoals(sus_record *from)
{
/* follow the chain */
sus_record *WGs = (sus_record *)ReadTimedVar(WokenGoals);
sus_record *WGs = (sus_record *)_YAP_ReadTimedVar(WokenGoals);
if ((Term)WGs == TermNil) {
UpdateTimedVar(WokenGoals, (CELL)from);
_YAP_UpdateTimedVar(WokenGoals, (CELL)from);
} else {
/* add to the end of the current list of suspended goals */
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;
/* add a new suspension */
vs = (sus_tag *)ReadTimedVar(DelayedVars);
vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024)
return(FALSE);
RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext;
vs->SG = copy_suspended_goals(sreg->SG, to_visit_ptr);
*res = (CELL)&(vs->ActiveSus);
UpdateTimedVar(DelayedVars, (CELL)(vs+1));
_YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE);
}
@ -380,14 +386,14 @@ TermToSuspendedVar(Term gs, Term var)
{
register sus_tag *vs;
/* add a new suspension */
vs = (sus_tag *)ReadTimedVar(DelayedVars);
vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024)
return(FALSE);
RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext;
vs->SG = terms_to_suspended_goals(gs);
unify(var,(CELL)&(vs->ActiveSus));
UpdateTimedVar(DelayedVars, (CELL)(vs+1));
_YAP_unify(var,(CELL)&(vs->ActiveSus));
_YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE);
}
@ -398,10 +404,10 @@ mark_sus_record(sus_record *sg)
if (MARKED(((CELL)(sg->NR))))
return;
MARK(((CELL *)&(sg->NR)));
total_marked++;
mark_variable((CELL *)&(sg->SG));
_YAP_inc_mark_variable();
_YAP_mark_variable((CELL *)&(sg->SG));
#ifdef MULTI_ASSIGNMENT_VARIABLES
total_marked++;
_YAP_inc_mark_variable();
if (!IsAtomTerm((CELL)(sg->NS)))
mark_sus_record(sg->NS);
MARK(((CELL *)&(sg->NS)));
@ -413,12 +419,12 @@ static void mark_suspended_goal(CELL *orig)
register sus_tag *sreg = (sus_tag *)orig;
mark_sus_record(sreg->SG);
mark_external_reference(((CELL *)&(sreg->SG)));
_YAP_mark_external_reference(((CELL *)&(sreg->SG)));
}
void
mark_all_suspended_goals(void)
_YAP_mark_all_suspended_goals(void)
{
sus_record *sg = GetSVarList();
if (sg == NULL)
@ -468,7 +474,7 @@ Wake(CELL *pt1, CELL reg2)
/* binding two suspended variables, be careful */
if (susp2->sus_id != susp_ext) {
/* joining two suspensions */
Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented");
_YAP_Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented");
return;
}
/* join the two suspended lists */
@ -567,19 +573,19 @@ freeze_goal(Term t, Term g)
id = (exts)(susp->sus_id);
if (id != susp_ext) {
/* obtain the term */
Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported");
_YAP_Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported");
return(FALSE);
}
AddSuspendedGoal(g, susp->SG);
return(TRUE);
}
vs = (sus_tag *)ReadTimedVar(DelayedVars);
vs = (sus_tag *)_YAP_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024) {
ARG1 = t;
ARG2 = g;
if (!growglobal(NULL)) {
Error(SYSTEM_ERROR, t, ErrorMessage);
if (!_YAP_growglobal(NULL)) {
_YAP_Error(SYSTEM_ERROR, t, _YAP_ErrorMessage);
return FALSE;
}
t = ARG1;
@ -597,13 +603,13 @@ freeze_goal(Term t, Term g)
vs->sus_id = susp_ext;
vs->SG = gf;
RESET_VARIABLE(&(vs->ActiveSus));
UpdateTimedVar(DelayedVars, (CELL)(vs+1));
_YAP_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
Bind_Global((CELL *)t,(CELL)&(vs->ActiveSus));
return(TRUE);
}
else {
/* Oops, first argument was bound :-( */
Error(TYPE_ERROR_VARIABLE, t, "freeze/2");
_YAP_Error(TYPE_ERROR_VARIABLE, t, "freeze/2");
return(FALSE);
}
}
@ -615,7 +621,7 @@ p_read_svar_list(void)
{
#ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES
return(unify(ARG1, MutableList) && unify(ARG2, AttsMutableList));
return(_YAP_unify(ARG1, MutableList) && _YAP_unify(ARG2, AttsMutableList));
#else
return(TRUE);
#endif
@ -719,7 +725,7 @@ static Int p_frozen_goals(void)
}
HB = B->cp_h;
#endif
return(unify(ARG2,t));
return(_YAP_unify(ARG2,t));
}
/* return a queue with all goals frozen in the system */
@ -727,11 +733,11 @@ static Int p_all_frozen_goals(void)
{
#ifdef COROUTINING
/* initially, we do not know of any goals frozen */
Term t = CurrentAttVars();
Term t = _YAP_CurrentAttVars();
#ifdef MULTI_ASSIGNMENT_VARIABLES
sus_record *x = GetSVarList();
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!
*/
while ((CELL)x != TermNil) {
@ -739,9 +745,9 @@ static Int p_all_frozen_goals(void)
x = x->NS;
}
#endif
return(unify(ARG1,t));
return(_YAP_unify(ARG1,t));
#else
return(unify(ARG1,TermNil));
return(_YAP_unify(ARG1,TermNil));
#endif
}
@ -771,7 +777,7 @@ static int can_unify_complex(register CELL *pt0,
CELL *saved_HB;
choiceptr saved_B;
register CELL **to_visit = (CELL **)PreAllocCodeSpace();
register CELL **to_visit = (CELL **)_YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit;
/* make sure to trail all bindings */
@ -872,7 +878,7 @@ static int can_unify_complex(register CELL *pt0,
goto comparison_failed;
#ifdef USE_GMP
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;
#endif /* USE_GMP */
default:
@ -923,7 +929,7 @@ static int can_unify_complex(register CELL *pt0,
goto loop;
}
/* success */
ReleasePreAllocCodeSpace((ADDR)to_visit);
_YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
/* restore B, and later HB */
B = saved_B;
HB = saved_HB;
@ -936,7 +942,7 @@ static int can_unify_complex(register CELL *pt0,
comparison_failed:
/* failure */
ReleasePreAllocCodeSpace((ADDR)to_visit);
_YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)to_visit_base) {
to_visit -= 4;
@ -1009,7 +1015,7 @@ can_unify(Term t1, Term t2, Term *Vars)
return(FALSE);
#ifdef USE_GMP
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);
#endif /* USE_GMP */
default:
@ -1029,7 +1035,7 @@ static int non_ground_complex(register CELL *pt0,
Term *Var)
{
register CELL **to_visit = (CELL **)PreAllocCodeSpace();
register CELL **to_visit = (CELL **)_YAP_PreAllocCodeSpace();
CELL **to_visit_base = to_visit;
loop:
@ -1107,12 +1113,12 @@ static int non_ground_complex(register CELL *pt0,
}
/* the term is ground */
ReleasePreAllocCodeSpace((ADDR)to_visit);
_YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
return(FALSE);
var_found:
/* the term is non-ground */
ReleasePreAllocCodeSpace((ADDR)to_visit);
_YAP_ReleasePreAllocCodeSpace((ADDR)to_visit);
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)to_visit_base) {
to_visit -= 3;
@ -1159,7 +1165,7 @@ static Int p_can_unify(void)
Term r = TermNil;
if (!can_unify(ARG1, ARG2, &r))
return(FALSE);
return (unify(ARG3, r));
return (_YAP_unify(ARG3, r));
#else
return(FALSE);
#endif
@ -1172,7 +1178,7 @@ static Int p_non_ground(void)
Term r;
if (!non_ground(ARG1, &r))
return(FALSE);
return (unify(ARG2, r));
return (_YAP_unify(ARG2, r));
#else
return(FALSE);
#endif
@ -1192,13 +1198,13 @@ static Int p_coroutining(void)
static Int p_awoken_goals(void)
{
#ifdef COROUTINING
Term WGs = ReadTimedVar(WokenGoals);
Term WGs = _YAP_ReadTimedVar(WokenGoals);
if (WGs == TermNil) {
return(FALSE);
}
WGs = ListOfWokenGoals();
UpdateTimedVar(WokenGoals, TermNil);
return(unify(ARG1,WGs));
_YAP_UpdateTimedVar(WokenGoals, TermNil);
return(_YAP_unify(ARG1,WGs));
#else
return(FALSE);
#endif
@ -1206,7 +1212,7 @@ static Int p_awoken_goals(void)
#ifdef COROUTINING
void
WakeUp(CELL *pt0) {
_YAP_WakeUp(CELL *pt0) {
CELL d0 = *pt0;
RESET_VARIABLE(pt0);
TR--;
@ -1215,7 +1221,7 @@ WakeUp(CELL *pt0) {
#endif
void InitCoroutPreds(void)
void _YAP_InitCoroutPreds(void)
{
#ifdef COROUTINING
Atom at;
@ -1226,21 +1232,21 @@ void InitCoroutPreds(void)
attas[susp_ext].to_term_op = SuspendedVarToTerm;
attas[susp_ext].term_to_op = TermToSuspendedVar;
attas[susp_ext].mark_op = mark_suspended_goal;
at = LookupAtom("$wake_up_goal");
pred = RepPredProp(PredPropByFunc(MkFunctor(at, 2),0));
at = _YAP_LookupAtom("$wake_up_goal");
pred = RepPredProp(PredPropByFunc(_YAP_MkFunctor(at, 2),0));
WakeUpCode = pred;
InitAttVarPreds();
_YAP_InitAttVarPreds();
#endif /* COROUTINING */
InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);
InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag);
InitCPred("$freeze", 2, p_freeze, 0);
InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag);
InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag);
InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag);
InitCPred("$can_unify", 3, p_can_unify, SafePredFlag);
InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
InitCPred("$coroutining", 0, p_coroutining, SafePredFlag);
InitCPred("$awoken_goals", 1, p_awoken_goals, SafePredFlag);
_YAP_InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);
_YAP_InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag);
_YAP_InitCPred("$freeze", 2, p_freeze, 0);
_YAP_InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag);
_YAP_InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag);
_YAP_InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag);
_YAP_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag);
_YAP_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag);
_YAP_InitCPred("$coroutining", 0, p_coroutining, 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)
{
return(unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
return(_YAP_unify_constant(ARG1, MkIntTerm(IntOfTerm(DEPTH/2))));
}
static Int p_set_depth_limit(void)
@ -37,10 +37,10 @@ static Int p_set_depth_limit(void)
Term d = Deref(ARG1);
if (IsVarTerm(d)) {
Error(INSTANTIATION_ERROR, d, "set-depth_limit");
_YAP_Error(INSTANTIATION_ERROR, d, "set-depth_limit");
return(FALSE);
} else if (!IsIntegerTerm(d)) {
Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
_YAP_Error(TYPE_ERROR_INTEGER, d, "set-depth_limit");
return(FALSE);
}
d = MkIntTerm(IntegerOfTerm(d)*2);
@ -51,10 +51,10 @@ static Int p_set_depth_limit(void)
return(TRUE);
}
void InitItDeepenPreds(void)
void _YAP_InitItDeepenPreds(void)
{
InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag);
InitCPred("$set_depth_limit", 1, p_set_depth_limit, 0);
_YAP_InitCPred("get_depth_limit", 1, p_get_depth_limit, SafePredFlag);
_YAP_InitCPred("$set_depth_limit", 1, p_set_depth_limit, 0);
}
#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 "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_ARGS arith_retptr o
@ -48,18 +48,18 @@ EvalToTerm(blob_type bt, union arith_ret *res)
return(MkFloatTerm(res->dbl));
#ifdef USE_GMP
case big_int_e:
return(MkBigIntTerm(res->big));
return(_YAP_MkBigIntTerm(res->big));
#endif
default:
return(TermNil);
}
}
E_FUNC
static E_FUNC
Eval(Term t, E_ARGS)
{
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
_YAP_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
P = (yamop *)FAILCODE;
RERROR();
}
@ -72,7 +72,7 @@ Eval(Term t, E_ARGS)
RFLOAT(FloatOfTerm(t));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
RBIG(BigIntOfTerm(t));
RBIG(_YAP_BigIntOfTerm(t));
#endif
default:
{
@ -80,14 +80,14 @@ Eval(Term t, E_ARGS)
Atom name = NameOfFunctor(fun);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, n)))) {
if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, n)))) {
Term ti[2];
/* error */
ti[0] = t;
ti[1] = MkIntegerTerm(n);
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
Error(TYPE_ERROR_EVALUABLE, t,
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;
@ -106,9 +106,72 @@ Eval(Term t, E_ARGS)
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(GetExpProp(name, 0)))) {
if (EndOfPAEntr(p = RepExpProp(_YAP_GetExpProp(name, 0)))) {
/* 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",
RepAtom(name)->StrOfAE);
P = (yamop *)FAILCODE;
@ -125,16 +188,16 @@ p_is(void)
blob_type bt;
bt = Eval(Deref(ARG2), &res);
return (unify_constant(ARG1,EvalToTerm(bt,&res)));
return (_YAP_unify_constant(ARG1,EvalToTerm(bt,&res)));
}
void
InitEval(void)
_YAP_InitEval(void)
{
/* here are the arithmetical predicates */
InitConstExps();
InitUnaryExps();
InitBinaryExps();
InitCPred("is", 2, p_is, TestPredFlag | SafePredFlag);
_YAP_InitConstExps();
_YAP_InitUnaryExps();
_YAP_InitBinaryExps();
_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_at_execute, (void));
/************ table of C-Predicates *************/
CPredicate _YAP_c_predicates[MAX_C_PREDS];
cmp_entry _YAP_cmp_funcs[MAX_CMP_FUNCS];
static Term
current_cp_as_integer(void)
{
@ -48,7 +52,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
if (_YAP_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
CP = P;
@ -75,13 +79,13 @@ CallMetaCall(SMALLUNSGN mod) {
}
Term
ExecuteCallMetaCall(SMALLUNSGN mod) {
_YAP_ExecuteCallMetaCall(SMALLUNSGN mod) {
Term ts[4];
ts[0] = ARG1;
ts[1] = current_cp_as_integer(); /* p_save_cp */
ts[2] = ARG1;
ts[3] = ModuleName[mod];
return(MkApplTerm(PredMetaCall->FunctorOfPred,4,ts));
return(_YAP_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts));
}
static Int
@ -90,7 +94,7 @@ CallError(yap_error_number err, SMALLUNSGN mod)
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
return(CallMetaCall(mod));
} else {
Error(err, ARG1, "call/1");
_YAP_Error(err, ARG1, "call/1");
return(FALSE);
}
}
@ -117,7 +121,7 @@ CallClause(PredEntry *pen, unsigned int arity, Int position)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
if (_YAP_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
ENV = YENV;
@ -172,7 +176,7 @@ CallClause(PredEntry *pen, unsigned int arity, Int position)
return (Unsigned(pen));
}
} 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);
}
}
@ -190,7 +194,7 @@ p_save_cp(void)
BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), td);
if (CellPtr(t) < H0) WakeUp((CELL *)t);
if (CellPtr(t) < H0) _YAP_WakeUp((CELL *)t);
bind_save_cp:
#endif
return(TRUE);
@ -199,7 +203,7 @@ p_save_cp(void)
static Int
EnterCreepMode(SMALLUNSGN mod) {
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);
CreepFlag = CalculateStackGap();
P_before_spy = P;
@ -215,17 +219,17 @@ PushModule(Term t,SMALLUNSGN mod) {
Term ti[2], tf[2];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = MkApplTerm(FunctorModule,2,ti);
tf[0] = _YAP_MkApplTerm(FunctorModule,2,ti);
ti[0] = tmod;
ti[1] = ArgOfTerm(2,t);
tf[1] = MkApplTerm(FunctorModule,2,ti);
return(MkApplTerm(f,2,tf));
tf[1] = _YAP_MkApplTerm(FunctorModule,2,ti);
return(_YAP_MkApplTerm(f,2,tf));
} else {
Term ti[2], tf[1];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = MkApplTerm(FunctorModule,2,ti);
return(MkApplTerm(f,1,tf));
tf[0] = _YAP_MkApplTerm(FunctorModule,2,ti);
return(_YAP_MkApplTerm(f,1,tf));
}
}
@ -259,7 +263,7 @@ do_execute(Term t, SMALLUNSGN mod)
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
@ -334,7 +338,7 @@ p_execute_within(void)
unsigned int arity;
Prop pe;
Atom a;
SMALLUNSGN mod = LookupModule(tmod);
SMALLUNSGN mod = _YAP_LookupModule(tmod);
#ifdef SBA
choiceptr cut_pt = (choiceptr)IntegerOfTerm(Deref(ARG2));
#else
@ -371,7 +375,7 @@ p_execute_within(void)
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
@ -460,7 +464,7 @@ p_execute_within2(void)
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
@ -553,11 +557,11 @@ p_execute0(void)
Term tmod = Deref(ARG2);
unsigned int arity;
Prop pe;
SMALLUNSGN mod = LookupModule(tmod);
SMALLUNSGN mod = _YAP_LookupModule(tmod);
restart_exec:
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,ARG3,"call/1");
_YAP_Error(INSTANTIATION_ERROR,ARG3,"call/1");
return(FALSE);
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@ -572,7 +576,7 @@ p_execute0(void)
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
@ -598,7 +602,7 @@ p_execute0(void)
#endif
}
} else {
Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
_YAP_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
return(FALSE);
}
/* N = arity; */
@ -610,7 +614,7 @@ static Int
p_execute_0(void)
{ /* '$execute_0'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG2));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG2));
Prop pe;
if (IsAtomTerm(t)) {
@ -623,7 +627,7 @@ p_execute_0(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/1");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/1");
return(FALSE);
}
pe = PredPropByFunc(f, mod);
@ -635,7 +639,7 @@ p_execute_0(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,2), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,2), mod);
ptr = RepPair(t);
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
@ -647,18 +651,18 @@ static Int
p_execute_1(void)
{ /* '$execute_0'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG3));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG3));
Prop pe;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/2");
_YAP_Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/2");
return(FALSE);
}
if (IsAtomTerm(t)) {
Atom a;
a = AtomOfTerm(t);
ARG1 = ARG2;
pe = PredPropByFunc(MkFunctor(a,1),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,1),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -666,12 +670,12 @@ p_execute_1(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE);
}
Arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(MkFunctor(a,Arity+1), mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,Arity+1), mod);
XREGS[Arity+1] = ARG2;
ptr = RepAppl(t)+1;
for (i=1;i<=Arity;i++) {
@ -680,7 +684,7 @@ p_execute_1(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,3), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,3), mod);
ptr = RepPair(t);
XREGS[3] = ARG2;
XREGS[1] = ptr[0];
@ -693,7 +697,7 @@ static Int
p_execute_2(void)
{ /* '$execute_2'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG4));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG4));
Prop pe;
if (IsAtomTerm(t)) {
@ -701,7 +705,7 @@ p_execute_2(void)
a = AtomOfTerm(t);
ARG1 = ARG2;
ARG2 = ARG3;
pe = PredPropByFunc(MkFunctor(a,2),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,2),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -709,12 +713,12 @@ p_execute_2(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/3");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/3");
return(FALSE);
}
Arity = ArityOfFunctor(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+1] = ARG2;
ptr = RepAppl(t)+1;
@ -724,7 +728,7 @@ p_execute_2(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,4), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,4), mod);
ptr = RepPair(t);
XREGS[4] = ARG3;
XREGS[3] = ARG2;
@ -738,11 +742,11 @@ static Int
p_execute_3(void)
{ /* '$execute_3'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG5));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG5));
Prop pe;
if (!IsAtomTerm(t)) {
Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/4");
_YAP_Error(TYPE_ERROR_ATOM,ARG1,"call_with_args/4");
return(FALSE);
}
if (IsAtomTerm(t)) {
@ -751,7 +755,7 @@ p_execute_3(void)
ARG1 = ARG2;
ARG2 = ARG3;
ARG3 = ARG4;
pe = PredPropByFunc(MkFunctor(a,3),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,3),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -759,12 +763,12 @@ p_execute_3(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/2");
return(FALSE);
}
Arity = ArityOfFunctor(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+2] = ARG3;
XREGS[Arity+1] = ARG2;
@ -775,7 +779,7 @@ p_execute_3(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,5), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,5), mod);
ptr = RepPair(t);
XREGS[5] = ARG4;
XREGS[4] = ARG3;
@ -790,7 +794,7 @@ static Int
p_execute_4(void)
{ /* '$execute_4'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG6));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG6));
Prop pe;
if (IsAtomTerm(t)) {
@ -800,7 +804,7 @@ p_execute_4(void)
ARG2 = ARG3;
ARG3 = ARG4;
ARG4 = ARG5;
pe = PredPropByFunc(MkFunctor(a,4),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,4),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -808,12 +812,12 @@ p_execute_4(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/5");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/5");
return(FALSE);
}
Arity = ArityOfFunctor(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+3] = ARG4;
XREGS[Arity+2] = ARG3;
@ -825,7 +829,7 @@ p_execute_4(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,6), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,6), mod);
ptr = RepPair(t);
XREGS[6] = ARG5;
XREGS[5] = ARG4;
@ -841,7 +845,7 @@ static Int
p_execute_5(void)
{ /* '$execute_5'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG7));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG7));
Prop pe;
if (IsAtomTerm(t)) {
@ -852,7 +856,7 @@ p_execute_5(void)
ARG3 = ARG4;
ARG4 = ARG5;
ARG5 = ARG6;
pe = PredPropByFunc(MkFunctor(a,5),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,5),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -860,12 +864,12 @@ p_execute_5(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/6");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/6");
return(FALSE);
}
Arity = ArityOfFunctor(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+4] = ARG5;
XREGS[Arity+3] = ARG4;
@ -878,7 +882,7 @@ p_execute_5(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,7), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,7), mod);
ptr = RepPair(t);
XREGS[7] = ARG6;
XREGS[6] = ARG5;
@ -895,7 +899,7 @@ static Int
p_execute_6(void)
{ /* '$execute_6'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG8));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG8));
Prop pe;
if (IsAtomTerm(t)) {
@ -907,7 +911,7 @@ p_execute_6(void)
ARG4 = ARG5;
ARG5 = ARG6;
ARG6 = ARG7;
pe = PredPropByFunc(MkFunctor(a,6),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,6),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -915,12 +919,12 @@ p_execute_6(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/7");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/7");
return(FALSE);
}
Arity = ArityOfFunctor(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+5] = ARG6;
XREGS[Arity+4] = ARG5;
@ -934,7 +938,7 @@ p_execute_6(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,8), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,8), mod);
ptr = RepPair(t);
XREGS[8] = ARG7;
XREGS[7] = ARG6;
@ -952,7 +956,7 @@ static Int
p_execute_7(void)
{ /* '$execute_7'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG9));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG9));
Prop pe;
if (IsAtomTerm(t)) {
@ -965,7 +969,7 @@ p_execute_7(void)
ARG5 = ARG6;
ARG6 = ARG7;
ARG7 = ARG8;
pe = PredPropByFunc(MkFunctor(a,7),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,7),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -973,12 +977,12 @@ p_execute_7(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/8");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/8");
return(FALSE);
}
Arity = ArityOfFunctor(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+6] = ARG7;
XREGS[Arity+5] = ARG6;
@ -993,7 +997,7 @@ p_execute_7(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,9), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,9), mod);
ptr = RepPair(t);
XREGS[9] = ARG8;
XREGS[8] = ARG7;
@ -1012,7 +1016,7 @@ static Int
p_execute_8(void)
{ /* '$execute_8'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG10));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG10));
Prop pe;
if (IsAtomTerm(t)) {
@ -1026,7 +1030,7 @@ p_execute_8(void)
ARG6 = ARG7;
ARG7 = ARG8;
ARG8 = ARG9;
pe = PredPropByFunc(MkFunctor(a,8),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,8),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -1034,12 +1038,12 @@ p_execute_8(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/9");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/9");
return(FALSE);
}
Arity = ArityOfFunctor(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+7] = ARG8;
XREGS[Arity+6] = ARG7;
@ -1055,7 +1059,7 @@ p_execute_8(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,10), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,10), mod);
ptr = RepPair(t);
XREGS[10] = ARG9;
XREGS[9] = ARG8;
@ -1075,7 +1079,7 @@ static Int
p_execute_9(void)
{ /* '$execute_9'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG11));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG11));
Prop pe;
if (IsAtomTerm(t)) {
@ -1090,7 +1094,7 @@ p_execute_9(void)
ARG7 = ARG8;
ARG8 = ARG9;
ARG9 = ARG10;
pe = PredPropByFunc(MkFunctor(a,9),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,9),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -1098,12 +1102,12 @@ p_execute_9(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/10");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/10");
return(FALSE);
}
Arity = ArityOfFunctor(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+8] = ARG9;
XREGS[Arity+7] = ARG8;
@ -1120,7 +1124,7 @@ p_execute_9(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,11), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,11), mod);
ptr = RepPair(t);
XREGS[11] = ARG10;
XREGS[10] = ARG9;
@ -1141,7 +1145,7 @@ static Int
p_execute_10(void)
{ /* '$execute_10'(Goal) */
Term t = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG12));
SMALLUNSGN mod = _YAP_LookupModule(Deref(ARG12));
Prop pe;
if (IsAtomTerm(t)) {
@ -1157,7 +1161,7 @@ p_execute_10(void)
ARG8 = ARG9;
ARG9 = ARG10;
ARG10 = ARG11;
pe = PredPropByFunc(MkFunctor(a,10),mod);
pe = PredPropByFunc(_YAP_MkFunctor(a,10),mod);
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
Int Arity, i;
@ -1165,12 +1169,12 @@ p_execute_10(void)
CELL *ptr;
if (IsExtensionFunctor(f)) {
Error(TYPE_ERROR_CALLABLE, t, "call_with_args/11");
_YAP_Error(TYPE_ERROR_CALLABLE, t, "call_with_args/11");
return(FALSE);
}
Arity = ArityOfFunctor(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+9] = ARG10;
XREGS[Arity+8] = ARG9;
@ -1188,7 +1192,7 @@ p_execute_10(void)
} else {
CELL *ptr;
pe = PredPropByFunc(MkFunctor(AtomDot,12), mod);
pe = PredPropByFunc(_YAP_MkFunctor(AtomDot,12), mod);
ptr = RepPair(t);
XREGS[12] = ARG11;
XREGS[11] = ARG10;
@ -1211,9 +1215,9 @@ static Int
p_execute_depth_limit(void) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Error(INSTANTIATION_ERROR,d,"depth_bound_call/2");
_YAP_Error(INSTANTIATION_ERROR,d,"depth_bound_call/2");
} 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);
}
DEPTH = MkIntTerm(IntOfTerm(d)*2);
@ -1235,7 +1239,7 @@ p_at_execute(void)
unsigned int arity;
Prop pe;
Atom a;
SMALLUNSGN mod = LookupModule(tmod);
SMALLUNSGN mod = _YAP_LookupModule(tmod);
restart_exec:
if (IsAtomTerm(t)) {
@ -1252,14 +1256,14 @@ p_at_execute(void)
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
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);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
@ -1292,16 +1296,16 @@ p_at_execute(void)
return (CallClause(RepPredProp(pe), arity, IntOfTerm(t2)));
}
int
static int
exec_absmi(int top)
{
int lval;
if (top && (lval = sigsetjmp (RestartEnv, 1)) != 0) {
if (top && (lval = sigsetjmp (_YAP_RestartEnv, 1)) != 0) {
switch(lval) {
case 1:
{ /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */
PrologMode = UserMode;
_YAP_PrologMode = UserMode;
/* find out where to cut to */
#if defined(__GNUC__)
#if defined(hppa) || defined(__alpha)
@ -1316,18 +1320,18 @@ exec_absmi(int top)
yap_flags[SPY_CREEP_FLAG] = 0;
CreepFlag = CalculateStackGap();
P = (yamop *)FAILCODE;
PrologMode = UserMode;
_YAP_PrologMode = UserMode;
}
break;
case 2:
{
/* arithmetic exception */
/* 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 */
set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1);
_YAP_set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1);
P = (yamop *)FAILCODE;
PrologMode = UserMode;
_YAP_PrologMode = UserMode;
}
break;
case 3:
@ -1336,12 +1340,12 @@ exec_absmi(int top)
}
default:
/* do nothing */
PrologMode = UserMode;
_YAP_PrologMode = UserMode;
}
} else {
PrologMode = UserMode;
_YAP_PrologMode = UserMode;
}
return(absmi(0));
return(_YAP_absmi(0));
}
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);
P = (yamop *) CodeAdr;
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));
}
int
_YAP_exec_absmi(int top)
{
return exec_absmi(top);
}
Int
execute_goal(Term t, int nargs, SMALLUNSGN mod)
_YAP_execute_goal(Term t, int nargs, SMALLUNSGN mod)
{
Int out;
CODEADDR CodeAdr;
@ -1423,7 +1433,7 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Error(TYPE_ERROR_CALLABLE,t,"call/1");
_YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
/* I cannot use the standard macro here because
@ -1432,7 +1442,7 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
pt = RepAppl(t)+1;
pe = PredPropByFunc(f, mod);
} else {
Error(TYPE_ERROR_CALLABLE,t,"call/1");
_YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
ppe = RepPredProp(pe);
@ -1498,13 +1508,13 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
HB = PROTECT_FROZEN_H(B);
return(FALSE);
} else {
Error(SYSTEM_ERROR,TermNil,"emulator crashed");
_YAP_Error(SYSTEM_ERROR,TermNil,"emulator crashed");
return(FALSE);
}
}
void
trust_last(void)
_YAP_trust_last(void)
{
ASP = B->cp_env;
P = (yamop *)(B->cp_env[E_CP]);
@ -1523,7 +1533,7 @@ trust_last(void)
}
int
RunTopGoal(Term t)
_YAP_RunTopGoal(Term t)
{
CODEADDR CodeAdr;
Prop pe;
@ -1543,13 +1553,13 @@ RunTopGoal(Term t)
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Error(TYPE_ERROR_CALLABLE,t,"call/1");
_YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = LookupModule(tmod);
mod = _YAP_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_runtopgoal;
}
@ -1557,11 +1567,11 @@ RunTopGoal(Term t)
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pe = GetPredPropByFunc(f, CurrentModule);
pe = _YAP_GetPredPropByFunc(f, CurrentModule);
pt = RepAppl(t)+1;
arity = ArityOfFunctor(f);
} else {
Error(TYPE_ERROR_CALLABLE,t,"call/1");
_YAP_Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE);
}
ppe = RepPredProp(pe);
@ -1576,9 +1586,9 @@ RunTopGoal(Term t)
return(FALSE);
}
CodeAdr = ppe->CodeOfPred;
if (TrailTop - HeapTop < 2048) {
PrologMode = BootMode;
Error(SYSTEM_ERROR,TermNil,
if (_YAP_TrailTop - HeapTop < 2048) {
_YAP_PrologMode = BootMode;
_YAP_Error(SYSTEM_ERROR,TermNil,
"unable to boot because of too little heap space");
}
goal_out = do_goal(CodeAdr, arity, pt, 0, TRUE);
@ -1607,7 +1617,7 @@ p_restore_regs(void)
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"support for coroutining");
_YAP_Error(INSTANTIATION_ERROR,t,"support for coroutining");
return(FALSE);
}
if (IsAtomTerm(t)) return(TRUE);
@ -1623,7 +1633,7 @@ p_restore_regs2(void)
Term t = Deref(ARG1), d0;
choiceptr pt0;
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR,t,"support for coroutining");
_YAP_Error(INSTANTIATION_ERROR,t,"support for coroutining");
return(FALSE);
}
d0 = Deref(ARG2);
@ -1631,7 +1641,7 @@ p_restore_regs2(void)
restore_regs(t);
}
if (IsVarTerm(d0)) {
Error(INSTANTIATION_ERROR,d0,"support for coroutining");
_YAP_Error(INSTANTIATION_ERROR,d0,"support for coroutining");
return(FALSE);
}
if (!IsIntegerTerm(d0)) {
@ -1675,7 +1685,7 @@ p_clean_ifcp(void) {
return(TRUE);
}
Int
static Int
JumpToEnv(Term t) {
yamop *pos = (yamop *)(PredDollarCatch->LastClause);
CELL *env;
@ -1704,9 +1714,9 @@ JumpToEnv(Term t) {
if (B == NULL) {
B = B0;
#if PUSH_REGS
restore_absmi_regs(&standard_regs);
restore_absmi_regs(&_YAP_standard_regs);
#endif
siglongjmp(RestartEnv,1);
siglongjmp(_YAP_RestartEnv,1);
}
/* is it a continuation? */
env = B->cp_env;
@ -1736,6 +1746,10 @@ JumpToEnv(Term t) {
return(FALSE);
}
Int
_YAP_JumpToEnv(Term t) {
return JumpToEnv(t);
}
/* This does very nasty stuff!!!!! */
@ -1744,36 +1758,83 @@ p_jump_env(void) {
return(JumpToEnv(Deref(ARG1)));
}
void
InitExecFs(void)
void
_YAP_InitYaamRegs(void)
{
InitCPred("$execute", 1, p_execute, 0);
InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
InitCPred("$execute_within", 4, p_execute_within, 0);
InitCPred("$execute_within", 1, p_execute_within2, 0);
InitCPred("$last_execute_within", 1, p_execute_within2, 0);
InitCPred("$execute", 3, p_at_execute, 0);
InitCPred("$call_with_args", 2, p_execute_0, 0);
InitCPred("$call_with_args", 3, p_execute_1, 0);
InitCPred("$call_with_args", 4, p_execute_2, 0);
InitCPred("$call_with_args", 5, p_execute_3, 0);
InitCPred("$call_with_args", 6, p_execute_4, 0);
InitCPred("$call_with_args", 7, p_execute_5, 0);
InitCPred("$call_with_args", 8, p_execute_6, 0);
InitCPred("$call_with_args", 9, p_execute_7, 0);
InitCPred("$call_with_args", 10, p_execute_8, 0);
InitCPred("$call_with_args", 11, p_execute_9, 0);
InitCPred("$call_with_args", 12, p_execute_10, 0);
#ifdef DEPTH_LIMIT
InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
#if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract
machine registers */
_YAP_regp = &_YAP_standard_regs;
#endif /* PUSH_REGS */
_YAP_PutValue (AtomBreak, MkIntTerm (0));
_YAP_PutValue (AtomIndex, MkAtomTerm (AtomTrue));
AuxSp = (CELL *)AuxTop;
TR = (tr_fr_ptr)_YAP_TrailBase;
#ifdef COROUTINING
H = H0 = ((CELL *) _YAP_GlobalBase)+ 2048;
#else
H = H0 = (CELL *) _YAP_GlobalBase;
#endif
LCL0 = ASP = (CELL *) _YAP_LocalBase;
/* notice that an initial choice-point and environment
*must* be created since for the garbage collector to work */
B = NULL;
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
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);
InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);
InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag);
InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0);
}
void
_YAP_InitExecFs(void)
{
_YAP_InitCPred("$execute", 1, p_execute, 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 undf5 */
STATIC_PROTO(int growstack, (long));
STATIC_PROTO(void MoveGlobal, (void));
STATIC_PROTO(void MoveLocalAndTrail, (void));
STATIC_PROTO(void SetHeapRegs, (void));
@ -59,10 +60,12 @@ STATIC_PROTO(void AdjustTrail, (int));
STATIC_PROTO(void AdjustLocal, (void));
STATIC_PROTO(void AdjustGlobal, (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(CELL AdjustAppl, (CELL));
STATIC_PROTO(CELL AdjustPair, (CELL));
STATIC_PROTO(void AdjustStacksAndTrail, (void));
STATIC_PROTO(void AdjustRegs, (int));
static void
cpcellsd(register CELL *Dest, register CELL *Org, CELL NOf)
@ -96,24 +99,24 @@ static void
SetHeapRegs(void)
{
#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
/* The old stack pointers */
OldLCL0 = LCL0;
OldASP = ASP;
OldGlobalBase = (CELL *)GlobalBase;
OldGlobalBase = (CELL *)_YAP_GlobalBase;
OldH = H;
OldH0 = H0;
OldTrailBase = TrailBase;
OldTrailTop = TrailTop;
OldTrailBase = _YAP_TrailBase;
OldTrailTop = _YAP_TrailTop;
OldTR = TR;
OldHeapBase = HeapBase;
OldHeapBase = _YAP_HeapBase;
OldHeapTop = HeapTop;
/* Adjust stack addresses */
TrailBase = TrailAddrAdjust(TrailBase);
TrailTop = TrailAddrAdjust(TrailTop);
GlobalBase = DelayAddrAdjust(GlobalBase);
LocalBase = LocalAddrAdjust(LocalBase);
_YAP_TrailBase = TrailAddrAdjust(_YAP_TrailBase);
_YAP_TrailTop = TrailAddrAdjust(_YAP_TrailTop);
_YAP_GlobalBase = DelayAddrAdjust(_YAP_GlobalBase);
_YAP_LocalBase = LocalAddrAdjust(_YAP_LocalBase);
AuxSp = PtoDelayAdjust(AuxSp);
AuxTop = DelayAddrAdjust(AuxTop);
/* The registers pointing to one of the stacks */
@ -152,16 +155,16 @@ SetStackRegs(void)
OldASP = ASP;
OldH = H;
OldH0 = H0;
OldGlobalBase = (CELL *)GlobalBase;
OldTrailTop = TrailTop;
OldTrailBase = TrailBase;
OldGlobalBase = (CELL *)_YAP_GlobalBase;
OldTrailTop = _YAP_TrailTop;
OldTrailBase = _YAP_TrailBase;
OldTR = TR;
OldHeapBase = HeapBase;
OldHeapBase = _YAP_HeapBase;
OldHeapTop = HeapTop;
/* The local and aux stack addresses */
TrailBase = TrailAddrAdjust(TrailBase);
TrailTop = TrailAddrAdjust(TrailTop);
LocalBase = LocalAddrAdjust(LocalBase);
_YAP_TrailBase = TrailAddrAdjust(_YAP_TrailBase);
_YAP_TrailTop = TrailAddrAdjust(_YAP_TrailTop);
_YAP_LocalBase = LocalAddrAdjust(_YAP_LocalBase);
TR = PtoTRAdjust(TR);
/* The registers pointing to the local stack */
ENV = PtoLocAdjust(ENV);
@ -197,7 +200,7 @@ MoveGlobal(void)
* absmi.asm
*/
#if HAVE_MEMMOVE
cpcellsd((CELL *)GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
cpcellsd((CELL *)_YAP_GlobalBase, (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);
#else
cpcellsd(H, OldH, OldH - (CELL *)OldGlobalBase);
#endif
@ -233,7 +236,7 @@ AdjustAppl(register CELL t0)
#ifdef DEBUG
else {
/* 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
return(t0);
@ -253,7 +256,7 @@ AdjustPair(register CELL t0)
else if (IsHeapP(t))
return (AbsPair(CellPtoHeapAdjust(t)));
#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
return(t0);
}
@ -265,7 +268,7 @@ AdjustTrail(int adjusting_heap)
ptt = TR;
/* moving the trail is simple */
while (ptt != (tr_fr_ptr)TrailBase) {
while (ptt != (tr_fr_ptr)_YAP_TrailBase) {
register CELL reg = TrailTerm(ptt-1);
#ifdef FROZEN_STACKS
register CELL reg2 = TrailVal(ptt-1);
@ -292,7 +295,7 @@ AdjustTrail(int adjusting_heap)
}
#ifdef DEBUG
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
}
} else if (IsPairTerm(reg)) {
@ -364,7 +367,7 @@ AdjustGlobal(void)
* to clean the global now that functors are just variables pointing to
* the code
*/
pt = CellPtr(GlobalBase);
pt = CellPtr(_YAP_GlobalBase);
while (pt < H) {
register CELL reg;
@ -425,7 +428,7 @@ AdjustGlobal(void)
* 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
*/
void
static void
AdjustStacksAndTrail(void)
{
AdjustTrail(TRUE);
@ -433,6 +436,12 @@ AdjustStacksAndTrail(void)
AdjustGlobal();
}
void
_YAP_AdjustStacksAndTrail(void)
{
AdjustStacksAndTrail();
}
/*
* When growing the stack we need to adjust: the local cells pointing to the
* local; the trail cells pointing to the local
@ -444,7 +453,7 @@ AdjustGrowStack(void)
AdjustLocal();
}
void
static void
AdjustRegs(int n)
{
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 */
static int
local_growheap(long size, int fix_code)
static_growheap(long size, int fix_code)
{
Int start_growth_time, growth_time;
int gc_verbose;
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
_YAP_ErrorMessage = NULL;
if (!_YAP_ExtendWorkSpace(size)) {
strncat(_YAP_ErrorMessage,": heap crashed against stacks", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
gc_verbose = is_gc_verbose();
start_growth_time = _YAP_cputime();
gc_verbose = _YAP_is_gc_verbose();
heap_overflows++;
if (gc_verbose) {
YP_fprintf(YP_stderr, "[HO] Heap overflow %d\n", heap_overflows);
YP_fprintf(YP_stderr, "[HO] growing the heap %ld bytes\n", size);
fprintf(_YAP_stderr, "[HO] Heap overflow %d\n", heap_overflows);
fprintf(_YAP_stderr, "[HO] growing the heap %ld bytes\n", size);
}
ASP -= 256;
TrDiff = LDiff = GDiff = DelayDiff = size;
@ -510,35 +525,35 @@ local_growheap(long size, int fix_code)
AdjustRegs(MaxTemps);
YAPLeaveCriticalSection();
ASP += 256;
growth_time = cputime()-start_growth_time;
growth_time = _YAP_cputime()-start_growth_time;
total_heap_overflow_time += growth_time;
if (gc_verbose) {
YP_fprintf(YP_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] took %g sec\n", (double)growth_time/1000);
fprintf(_YAP_stderr, "[HO] Total of %g sec expanding heap \n", (double)total_heap_overflow_time/1000);
}
return(TRUE);
}
/* Used by do_goal() when we're short of heap space */
static int
local_growglobal(long size, CELL **ptr)
static_growglobal(long size, CELL **ptr)
{
Int start_growth_time, growth_time;
int gc_verbose;
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": global crashed against local", MAX_ERROR_MSG_SIZE);
_YAP_ErrorMessage = NULL;
if (!_YAP_ExtendWorkSpace(size)) {
strncat(_YAP_ErrorMessage,": global crashed against local", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
gc_verbose = is_gc_verbose();
start_growth_time = _YAP_cputime();
gc_verbose = _YAP_is_gc_verbose();
delay_overflows++;
if (gc_verbose) {
YP_fprintf(YP_stderr, "[DO] Delay overflow %d\n", delay_overflows);
YP_fprintf(YP_stderr, "[DO] growing the stacks %ld bytes\n", size);
fprintf(_YAP_stderr, "[DO] Delay overflow %d\n", delay_overflows);
fprintf(_YAP_stderr, "[DO] growing the stacks %ld bytes\n", size);
}
ASP -= 256;
TrDiff = LDiff = GDiff = size;
@ -553,23 +568,23 @@ local_growglobal(long size, CELL **ptr)
*ptr = PtoLocAdjust(*ptr);
YAPLeaveCriticalSection();
ASP += 256;
growth_time = cputime()-start_growth_time;
growth_time = _YAP_cputime()-start_growth_time;
total_delay_overflow_time += growth_time;
if (gc_verbose) {
YP_fprintf(YP_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] took %g sec\n", (double)growth_time/1000);
fprintf(_YAP_stderr, "[DO] Total of %g sec expanding stacks \n", (double)total_delay_overflow_time/1000);
}
return(TRUE);
}
static void
fix_compiler_instructions(PInstr *cpc)
fix_compiler_instructions(PInstr *pcpc)
{
while (cpc != NULL) {
PInstr *ncpc = cpc->nextInst;
while (pcpc != NULL) {
PInstr *ncpc = pcpc->nextInst;
switch(cpc->op) {
switch(pcpc->op) {
/* check c_var for functions that point at variables */
case get_var_op:
case get_val_op:
@ -589,17 +604,17 @@ fix_compiler_instructions(PInstr *cpc)
case save_appl_op:
case save_b_op:
case comit_b_op:
cpc->rnd1 = GlobalAdjust(cpc->rnd1);
pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
break;
default:
/* hopefully nothing to do */
break;
}
if (ncpc != NULL) {
ncpc = (PInstr *)GlobalAddrAdjust((ADDR)(cpc->nextInst));
cpc->nextInst = ncpc;
ncpc = (PInstr *)GlobalAddrAdjust((ADDR)(pcpc->nextInst));
pcpc->nextInst = ncpc;
}
cpc = ncpc;
pcpc = ncpc;
}
}
@ -629,7 +644,7 @@ fix_tabling_info(void)
#endif /* TABLING */
int
growheap(int fix_code)
_YAP_growheap(int fix_code)
{
unsigned long size = sizeof(CELL) * 16 * 1024L;
int shift_factor = (heap_overflows > 8 ? 8 : heap_overflows);
@ -637,28 +652,28 @@ growheap(int fix_code)
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
if (SizeOfOverflow > sz)
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;
sz = size << shift_factor;
}
/* we must fix an instruction chain */
if (fix_code) {
PInstr *cpc = CodeStart;
if (cpc != NULL) {
CodeStart = cpc = (PInstr *)GlobalAddrAdjust((ADDR)cpc);
PInstr *pcpc = CodeStart;
if (pcpc != NULL) {
CodeStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
}
fix_compiler_instructions(cpc);
cpc = BlobsStart;
if (cpc != NULL) {
BlobsStart = cpc = (PInstr *)GlobalAddrAdjust((ADDR)cpc);
fix_compiler_instructions(pcpc);
pcpc = BlobsStart;
if (pcpc != NULL) {
BlobsStart = pcpc = (PInstr *)GlobalAddrAdjust((ADDR)pcpc);
}
fix_compiler_instructions(cpc);
fix_compiler_instructions(pcpc);
freep = (char *)GlobalAddrAdjust((ADDR)freep);
label_offset = (int *)GlobalAddrAdjust((ADDR)label_offset);
}
@ -673,17 +688,17 @@ growheap(int fix_code)
}
int
growglobal(CELL **ptr)
_YAP_growglobal(CELL **ptr)
{
unsigned long sz = sizeof(CELL) * 16 * 1024L;
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
if (!local_growglobal(sz, ptr))
if (!static_growglobal(sz, ptr))
return(FALSE);
#ifdef TABLING
fix_tabling_info();
@ -693,7 +708,7 @@ growglobal(CELL **ptr)
/* Used by do_goal() when we're short of stack space */
int
static int
growstack(long size)
{
Int start_growth_time, growth_time;
@ -701,27 +716,27 @@ growstack(long size)
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
_YAP_ErrorMessage = NULL;
if (!_YAP_ExtendWorkSpace(size)) {
strncat(_YAP_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
gc_verbose = is_gc_verbose();
start_growth_time = _YAP_cputime();
gc_verbose = _YAP_is_gc_verbose();
stack_overflows++;
if (gc_verbose) {
YP_fprintf(YP_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);
YP_fprintf(YP_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",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR);
YP_fprintf(YP_stderr, "[SO] growing the stacks %ld bytes\n", size);
fprintf(_YAP_stderr, "[SO] Stack Overflow %d\n", stack_overflows);
fprintf(_YAP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)_YAP_GlobalBase),_YAP_GlobalBase,H);
fprintf(_YAP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(_YAP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)_YAP_TrailBase),_YAP_TrailBase,TR);
fprintf(_YAP_stderr, "[SO] growing the stacks %ld bytes\n", size);
}
TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0;
@ -737,15 +752,21 @@ growstack(long size)
YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap();
ASP += 256;
growth_time = cputime()-start_growth_time;
growth_time = _YAP_cputime()-start_growth_time;
total_stack_overflow_time += growth_time;
if (gc_verbose) {
YP_fprintf(YP_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] took %g sec\n", (double)growth_time/1000);
fprintf(_YAP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
}
return(TRUE);
}
int
_YAP_growstack(long size)
{
return growstack(size);
}
static void
AdjustVarTable(VarEntry *ves)
{
@ -798,9 +819,9 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep)
ves = *vep = (VarEntry *)TrailAddrAdjust((ADDR)ves);
AdjustVarTable(ves);
}
ves = AnonVarTable;
ves = _YAP_AnonVarTable;
if (ves != NULL) {
ves = AnonVarTable = VarEntryAdjust(ves);
ves = _YAP_AnonVarTable = VarEntryAdjust(ves);
}
while (ves != NULL) {
VarEntry *vetmp = ves->VarLeft;
@ -815,35 +836,35 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep)
/* Used by parser when we're short of stack space */
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 gc_verbose;
long size = sizeof(CELL)*(LCL0-(CELL *)GlobalBase);
long size = sizeof(CELL)*(LCL0-(CELL *)_YAP_GlobalBase);
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
/* adjust to a multiple of 256) */
size = AdjustPageSize(size);
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": parser stack overflowed", MAX_ERROR_MSG_SIZE);
_YAP_ErrorMessage = NULL;
if (!_YAP_ExtendWorkSpace(size)) {
strncat(_YAP_ErrorMessage,": parser stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
start_growth_time = cputime();
gc_verbose = is_gc_verbose();
start_growth_time = _YAP_cputime();
gc_verbose = _YAP_is_gc_verbose();
stack_overflows++;
if (gc_verbose) {
YP_fprintf(YP_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);
YP_fprintf(YP_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",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR);
YP_fprintf(YP_stderr, "[SO] growing the stacks %ld bytes\n", size);
fprintf(_YAP_stderr, "[SO] Stack overflow %d\n", stack_overflows);
fprintf(_YAP_stderr, "[SO] Heap: %8ld cells (%p-%p)\n", (unsigned long int)(H-(CELL *)_YAP_GlobalBase),(CELL *)_YAP_GlobalBase,H);
fprintf(_YAP_stderr, "[SO] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(_YAP_stderr, "[SO] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)_YAP_TrailBase),_YAP_TrailBase,TR);
fprintf(_YAP_stderr, "[SO] growing the stacks %ld bytes\n", size);
}
TrDiff = LDiff = size;
XDiff = HDiff = GDiff = DelayDiff = 0;
@ -864,11 +885,11 @@ growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
YAPLeaveCriticalSection();
CreepFlag = CalculateStackGap();
ASP += 256;
growth_time = cputime()-start_growth_time;
growth_time = _YAP_cputime()-start_growth_time;
total_stack_overflow_time += growth_time;
if (gc_verbose) {
YP_fprintf(YP_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] took %g sec\n", (double)growth_time/1000);
fprintf(_YAP_stderr, "[SO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
}
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 */
int
growtrail(long size)
_YAP_growtrail(long size)
{
Int start_growth_time = cputime(), growth_time;
int gc_verbose = is_gc_verbose();
Int start_growth_time = _YAP_cputime(), growth_time;
int gc_verbose = _YAP_is_gc_verbose();
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
@ -891,22 +912,22 @@ growtrail(long size)
size = AdjustPageSize(size);
trail_overflows++;
if (gc_verbose) {
YP_fprintf(YP_stderr, "[TO] Trail overflow %d\n", trail_overflows);
YP_fprintf(YP_stderr, "[TO] growing the trail %ld bytes\n", size);
fprintf(_YAP_stderr, "[TO] Trail overflow %d\n", trail_overflows);
fprintf(_YAP_stderr, "[TO] growing the trail %ld bytes\n", size);
}
ErrorMessage = NULL;
if (!ExtendWorkSpace(size)) {
strncat(ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
_YAP_ErrorMessage = NULL;
if (!_YAP_ExtendWorkSpace(size)) {
strncat(_YAP_ErrorMessage,": trail stack overflowed", MAX_ERROR_MSG_SIZE);
return(FALSE);
}
YAPEnterCriticalSection();
TrailTop += size;
_YAP_TrailTop += size;
YAPLeaveCriticalSection();
growth_time = cputime()-start_growth_time;
growth_time = _YAP_cputime()-start_growth_time;
total_trail_overflow_time += growth_time;
if (gc_verbose) {
YP_fprintf(YP_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] took %g sec\n", (double)growth_time/1000);
fprintf(_YAP_stderr, "[TO] Total of %g sec expanding stacks \n", (double)total_stack_overflow_time/1000);
}
return(TRUE);
}
@ -918,7 +939,7 @@ p_inform_trail_overflows(void)
Term tn = MkIntTerm(trail_overflows);
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) */
@ -929,17 +950,17 @@ p_growheap(void)
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "grow_heap/1");
_YAP_Error(INSTANTIATION_ERROR, t1, "grow_heap/1");
return(FALSE);
} else if (!IsIntTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1, "grow_heap/1");
_YAP_Error(TYPE_ERROR_INTEGER, t1, "grow_heap/1");
return(FALSE);
}
diff = IntOfTerm(t1);
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
@ -948,7 +969,7 @@ p_inform_heap_overflows(void)
Term tn = MkIntTerm(heap_overflows);
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) */
@ -959,15 +980,15 @@ p_growstack(void)
Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) {
Error(INSTANTIATION_ERROR, t1, "grow_stack/1");
_YAP_Error(INSTANTIATION_ERROR, t1, "grow_stack/1");
return(FALSE);
} else if (!IsIntTerm(t1)) {
Error(TYPE_ERROR_INTEGER, t1, "grow_stack/1");
_YAP_Error(TYPE_ERROR_INTEGER, t1, "grow_stack/1");
return(FALSE);
}
diff = IntOfTerm(t1);
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));
}
@ -978,11 +999,12 @@ p_inform_stack_overflows(void)
Term tn = MkIntTerm(stack_overflows);
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+
total_stack_overflow_time+
@ -990,13 +1012,13 @@ Int total_stack_shift_time(void)
}
void
InitGrowPreds(void)
_YAP_InitGrowPreds(void)
{
InitCPred("$grow_heap", 1, p_growheap, SafePredFlag);
InitCPred("$grow_stack", 1, p_growstack, SafePredFlag);
InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag);
InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag);
InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag);
init_gc();
init_agc();
_YAP_InitCPred("$grow_heap", 1, p_growheap, SafePredFlag);
_YAP_InitCPred("$grow_stack", 1, p_growstack, SafePredFlag);
_YAP_InitCPred("$inform_trail_overflows", 2, p_inform_trail_overflows, SafePredFlag);
_YAP_InitCPred("$inform_heap_overflows", 2, p_inform_heap_overflows, SafePredFlag);
_YAP_InitCPred("$inform_stack_overflows", 2, p_inform_stack_overflows, SafePredFlag);
_YAP_init_gc();
_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 */
/* 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;
@ -77,6 +77,7 @@ STATIC_PROTO(void sweep_choicepoints, (choiceptr));
STATIC_PROTO(choiceptr update_B_H, (choiceptr, CELL *, CELL *, CELL *));
STATIC_PROTO(void compact_heap, (void));
STATIC_PROTO(void update_relocation_chain, (CELL *, CELL *));
STATIC_PROTO(int is_gc_verbose, (void));
STATIC_PROTO(int is_gc_very_verbose, (void));
#include "heapgc.h"
@ -103,8 +104,8 @@ PUSH_CONTINUATION(CELL *v, int nof) {
if (nof == 0) return;
x = cont_top;
x++;
if ((ADDR)x > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)x > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
x->v = v;
x->nof = nof;
cont_top = x;
@ -287,8 +288,8 @@ static inline struct gc_ma_h_entry *
GC_ALLOC_NEW_MASPACE(void)
{
gc_ma_h_inner_struct *new = gc_ma_h_top;
if ((char *)gc_ma_h_top > TrailTop-1024)
growtrail(64 * 1024L);
if ((char *)gc_ma_h_top > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
gc_ma_h_top++;
cont_top = (cont *)gc_ma_h_top;
#ifdef EASY_SHUNTING
@ -385,8 +386,8 @@ push_registers(Int num_regs, yamop *nextop)
for (i = 1; i <= num_regs; i++)
TrailTerm(TR++) = (CELL) XREGS[i];
/* push any live registers we might have hanging around */
if (nextop->opc == opcode(_move_back) ||
nextop->opc == opcode(_skip)) {
if (nextop->opc == _YAP_opcode(_move_back) ||
nextop->opc == _YAP_opcode(_skip)) {
CELL *lab = (CELL *)(nextop->u.l.l);
CELL max = lab[0];
Int curr = lab[1];
@ -436,8 +437,8 @@ pop_registers(Int num_regs, yamop *nextop)
for (i = 1; i <= num_regs; i++)
XREGS[i] = TrailTerm(ptr++);
/* pop any live registers we might have hanging around */
if (nextop->opc == opcode(_move_back) ||
nextop->opc == opcode(_skip)) {
if (nextop->opc == _YAP_opcode(_move_back) ||
nextop->opc == _YAP_opcode(_skip)) {
CELL *lab = (CELL *)(nextop->u.l.l);
CELL max = lab[0];
Int curr = lab[1];
@ -495,10 +496,10 @@ store_ref_in_dbtable(DBRef entry)
dbentry parent = db_vec0;
dbentry new = db_vec;
if ((ADDR)new > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)new > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
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;
if (db_vec == db_vec0) {
db_vec++;
@ -531,10 +532,10 @@ store_cl_in_dbtable(Clause *cl)
dbentry parent = db_vec0;
dbentry new = db_vec;
if ((ADDR)new > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)new > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
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;
if (db_vec == db_vec0) {
db_vec++;
@ -592,7 +593,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
Clause *cl = DeadClauses;
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;
trail_ptr--;
@ -611,7 +612,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
#ifdef SBA
(ADDR) pt0 >= HeapTop
#else
(ADDR) pt0 >= TrailBase
(ADDR) pt0 >= _YAP_TrailBase
#endif
) {
continue;
@ -690,17 +691,17 @@ inc_vars_of_type(CELL *curr,gc_types val) {
static void
put_type_info(unsigned long total)
{
YP_fprintf(YP_stderr,"[GC] type info for %lu cells\n", total);
YP_fprintf(YP_stderr,"[GC] %lu vars\n", vars[gc_var]);
YP_fprintf(YP_stderr,"[GC] %lu refs\n", vars[gc_ref]);
YP_fprintf(YP_stderr,"[GC] %lu references from env\n", env_vars);
YP_fprintf(YP_stderr,"[GC] %lu atoms\n", vars[gc_atom]);
YP_fprintf(YP_stderr,"[GC] %lu small ints\n", vars[gc_int]);
YP_fprintf(YP_stderr,"[GC] %lu other numbers\n", vars[gc_num]);
YP_fprintf(YP_stderr,"[GC] %lu lists\n", vars[gc_list]);
YP_fprintf(YP_stderr,"[GC] %lu compound terms\n", vars[gc_appl]);
YP_fprintf(YP_stderr,"[GC] %lu functors\n", vars[gc_func]);
YP_fprintf(YP_stderr,"[GC] %lu suspensions\n", vars[gc_susp]);
fprintf(_YAP_stderr,"[GC] type info for %lu cells\n", total);
fprintf(_YAP_stderr,"[GC] %lu vars\n", vars[gc_var]);
fprintf(_YAP_stderr,"[GC] %lu refs\n", vars[gc_ref]);
fprintf(_YAP_stderr,"[GC] %lu references from env\n", env_vars);
fprintf(_YAP_stderr,"[GC] %lu atoms\n", vars[gc_atom]);
fprintf(_YAP_stderr,"[GC] %lu small ints\n", vars[gc_int]);
fprintf(_YAP_stderr,"[GC] %lu other numbers\n", vars[gc_num]);
fprintf(_YAP_stderr,"[GC] %lu lists\n", vars[gc_list]);
fprintf(_YAP_stderr,"[GC] %lu compound terms\n", vars[gc_appl]);
fprintf(_YAP_stderr,"[GC] %lu functors\n", vars[gc_func]);
fprintf(_YAP_stderr,"[GC] %lu suspensions\n", vars[gc_susp]);
}
static void
@ -821,7 +822,7 @@ check_global(void) {
/* mark a heap object and all heap objects accessible from it */
void
static void
mark_variable(CELL_PTR current)
{
CELL_PTR next;
@ -893,7 +894,7 @@ mark_variable(CELL_PTR current)
}
#ifdef DEBUG
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
#ifdef INSTRUMENT_GC
else
@ -1004,7 +1005,13 @@ mark_variable(CELL_PTR current)
POP_CONTINUATION();
}
void
void
_YAP_mark_variable(CELL_PTR current)
{
mark_variable(current);
}
static void
mark_external_reference(CELL *ptr) {
CELL reg = *ptr;
@ -1076,6 +1083,11 @@ mark_external_reference(CELL *ptr) {
* general purpose registers)
*/
void
_YAP_mark_external_reference(CELL *ptr) {
mark_external_reference(ptr);
}
static void
mark_regs(tr_fr_ptr old_TR)
{
@ -1092,7 +1104,7 @@ mark_regs(tr_fr_ptr old_TR)
static void
mark_delays(CELL *max)
{
CELL *ptr = (CELL *)GlobalBase;
CELL *ptr = (CELL *)_YAP_GlobalBase;
for (; ptr < max; ptr++) {
mark_external_reference(ptr);
}
@ -1113,7 +1125,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
#ifdef DEBUG
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
if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) {
cl->ClFlags |= GcFoundMask;
@ -1182,12 +1194,12 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
#if 0
if (size < 0) {
PredEntry *pe = EnvPreg(gc_ENV[E_CP]);
op_numbers op = 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]);
op_numbers op = _YAP_op_from_opcode(ENV_ToOp(gc_ENV[E_CP]));
fprintf(_YAP_stderr,"ENV %p-%p(%d) %s\n", gc_ENV, pvbmap, size-EnvSizeInCells, op_names[op]);
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
YP_fprintf(YP_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE);
fprintf(_YAP_stderr," %s\n", RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE);
}
#endif
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.
The point of doing so is to have dynamic arrays */
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! */
RESET_VARIABLE(&TrailTerm(trail_ptr));
#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;
CELL *cptr = (CELL *)trail_cell;
if ((ADDR)nsTR > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)nsTR > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
TrailTerm(nsTR) = (CELL)NULL;
TrailTerm(nsTR+1) = *hp;
TrailTerm(nsTR+2) = trail_cell;
@ -1444,7 +1456,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
#endif
{
op = rtp->opc;
opnum = op_from_opcode(op);
opnum = _YAP_op_from_opcode(op);
}
if (very_verbose) {
switch (opnum) {
@ -1469,13 +1481,13 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
Atom at;
Int arity;
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)
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
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
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;
#ifdef TABLING
@ -1483,12 +1495,12 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _table_answer_resolution:
{
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 */
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
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;
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_retry_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;
#endif
default:
{
PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
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
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
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:
rtp = NEXTOP(rtp,l);
op = rtp->opc;
opnum = op_from_opcode(op);
opnum = _YAP_op_from_opcode(op);
goto restart_cp;
case _trust_fail:
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;
break;
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;
#else
default:
@ -1791,7 +1803,7 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next)
*next = AbsAppl((CELL *)
((MARKED(cnext) ? MBIT : 0) | RBIT | (Int) current));
} else {
YP_fprintf(YP_stderr," OH MY GOD !!!!!!!!!!!!\n");
fprintf(_YAP_stderr," OH MY GOD !!!!!!!!!!!!\n");
}
#else
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.
*/
{
Int size = old_TR-(tr_fr_ptr)TrailBase;
Int size = old_TR-(tr_fr_ptr)_YAP_TrailBase;
size -= discard_trail_entries;
while (gc_B != NULL) {
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;
}
}
@ -1848,7 +1860,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
}
/* next, follows the real trail entries */
trail_ptr = (tr_fr_ptr)TrailBase;
trail_ptr = (tr_fr_ptr)_YAP_TrailBase;
dest = trail_ptr;
while (trail_ptr < old_TR) {
register CELL trail_cell;
@ -1910,7 +1922,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
#ifdef SBA
(ADDR) pt0 >= HeapTop
#else
(ADDR) pt0 >= TrailBase
(ADDR) pt0 >= _YAP_TrailBase
#endif
) {
trail_ptr++;
@ -1941,7 +1953,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
dbr->Flags &= ~InUseMask;
DEC_DBREF_COUNT(dbr);
if (dbr->Flags & ErasedMask) {
ErDBE(dbr);
_YAP_ErDBE(dbr);
}
} else {
Clause *cl = ClauseFlagsToClause((CELL)pt0);
@ -1956,7 +1968,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
if (erase) {
/* at this point,
no one is accessing the clause */
ErCl(cl);
_YAP_ErCl(cl);
}
}
RESET_VARIABLE(&TrailTerm(dest));
@ -2017,27 +2029,27 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
}
new_TR = dest;
if (is_gc_verbose()) {
if (old_TR != (tr_fr_ptr)TrailBase)
YP_fprintf(YP_stderr,
if (old_TR != (tr_fr_ptr)_YAP_TrailBase)
fprintf(_YAP_stderr,
"[GC] Trail: discarded %d (%ld%%) cells out of %ld\n",
discard_trail_entries,
(unsigned long int)(discard_trail_entries*100/(old_TR-(tr_fr_ptr)TrailBase)),
(unsigned long int)(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)_YAP_TrailBase));
#ifdef DEBUG
if (hp_entrs > 0)
YP_fprintf(YP_stderr,
fprintf(_YAP_stderr,
"[GC] Trail: unmarked %ld dbentries (%ld%%) out of %ld\n",
(long int)hp_not_in_use,
(long int)(hp_not_in_use*100/hp_entrs),
(long int)hp_entrs);
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",
(long int)hp_erased,
(long int)(hp_erased*100/(hp_erased+hp_in_use_erased)),
(long int)(hp_erased+hp_in_use_erased));
#endif
YP_fprintf(YP_stderr,
fprintf(_YAP_stderr,
"[GC] Heap: recovered %ld bytes (%ld%%) out of %ld\n",
(unsigned long int)(OldHeapUsed-HeapUsed),
(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;
cl = cl->u.NextCl;
*cptr = cl;
FreeCodeSpace(ocl);
_YAP_FreeCodeSpace(ocl);
} else {
cl->ClFlags &= ~GcFoundMask;
cptr = &(cl->u.NextCl);
@ -2168,12 +2180,12 @@ sweep_choicepoints(choiceptr gc_B)
#endif
{
op = rtp->opc;
opnum = op_from_opcode(op);
opnum = _YAP_op_from_opcode(op);
}
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));
*/
/* any choice point */
@ -2211,7 +2223,7 @@ sweep_choicepoints(choiceptr gc_B)
case _count_retry:
rtp = NEXTOP(rtp,l);
op = rtp->opc;
opnum = op_from_opcode(op);
opnum = _YAP_op_from_opcode(op);
goto restart_cp;
#ifdef TABLING
case _table_answer_resolution:
@ -2453,7 +2465,7 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
}
#ifdef DEBUG
else {
Error(SYSTEM_ERROR, TermNil, "ATOMIC in a GC relocation chain");
_YAP_Error(SYSTEM_ERROR, TermNil, "ATOMIC in a GC relocation chain");
}
#endif
}
@ -2589,7 +2601,7 @@ compact_heap(void)
#ifdef DEBUG
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,
(unsigned long int)total_marked,
(unsigned long int)found_marked);
@ -2647,7 +2659,7 @@ compact_heap(void)
}
#ifdef DEBUG
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,
(unsigned long int)total_marked,
(unsigned long int)found_marked);
@ -2690,7 +2702,7 @@ adjust_cp_hbs(void)
gc_B->cp_h = H0;
break;
} else {
Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector");
_YAP_Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector");
return;
}
}
@ -2781,7 +2793,7 @@ icompact_heap(void)
#ifdef DEBUG
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,
(unsigned long int)total_marked,
(unsigned long int)found_marked);
@ -2836,7 +2848,7 @@ icompact_heap(void)
}
#ifdef DEBUG
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,
(unsigned long int)total_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
values */
#ifdef COROUTINING
mark_all_suspended_goals();
_YAP_mark_all_suspended_goals();
#endif
mark_regs(old_TR); /* active registers & trail */
#ifdef COROUTINING
@ -2909,7 +2921,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
static void
sweep_delays(CELL *max)
{
CELL *ptr = (CELL *)GlobalBase;
CELL *ptr = (CELL *)_YAP_GlobalBase;
while (ptr < max) {
if (MARKED(*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 DEBUG
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
if (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0) {
#ifdef INSTRUMENT_GC
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
quicksort((CELL_PTR *)H, 0, (iptop-(CELL_PTR *)H)-1);
adjust_cp_hbs();
@ -2971,7 +2983,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
tr_fr_ptr old_TR;
Int m_time, c_time, time_start, gc_time;
#if COROUTINING
CELL *max = (CELL *)ReadTimedVar(DelayedVars);
CELL *max = (CELL *)_YAP_ReadTimedVar(DelayedVars);
#else
CELL *max = NULL;
#endif
@ -2980,8 +2992,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#if COROUTINING
if (H0 - max < 1024+(2*NUM_OF_ATTS)) {
if (!growglobal(&current_env)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growglobal(&current_env)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return FALSE;
}
}
@ -3009,40 +3021,40 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#ifdef DEBUG
check_global();
#endif
if (GetValue(AtomGcTrace) != TermNil)
if (_YAP_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1;
/* sanity check: can we still do garbage_collection ? */
if ((CELL)TrailTop & (MBIT|RBIT)) {
if ((CELL)_YAP_TrailTop & (MBIT|RBIT)) {
/* oops, we can't */
if (gc_verbose) {
YP_fprintf(YP_stderr, "[GC] TrailTop at %p clashes with gc bits: %lx\n", TrailTop, (MBIT|RBIT));
YP_fprintf(YP_stderr, "[GC] garbage collection disallowed\n");
fprintf(_YAP_stderr, "[GC] TrailTop at %p clashes with gc bits: %lx\n", _YAP_TrailTop, (unsigned long int)(MBIT|RBIT));
fprintf(_YAP_stderr, "[GC] garbage collection disallowed\n");
}
return(0);
}
gc_calls++;
if (gc_trace) {
YP_fprintf(YP_stderr, "[gc]\n");
fprintf(_YAP_stderr, "[gc]\n");
} 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
YP_fprintf(YP_stderr, "[GC] no early reset in trail\n");
fprintf(_YAP_stderr, "[GC] no early reset in trail\n");
#endif
YP_fprintf(YP_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);
YP_fprintf(YP_stderr, "[GC] Trail:%8ld cells (%p-%p)\n",
(unsigned long int)(TR-(tr_fr_ptr)TrailBase),TrailBase,TR);
fprintf(_YAP_stderr, "[GC] Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H);
fprintf(_YAP_stderr, "[GC] Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
fprintf(_YAP_stderr, "[GC] Trail:%8ld cells (%p-%p)\n",
(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;
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
current_env = (CELL *)*ASP;
ASP++;
}
time_start = cputime();
time_start = _YAP_cputime();
total_marked = 0;
discard_trail_entries = 0;
#ifdef HYBRID_SCHEME
@ -3053,26 +3065,26 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
old_TR = TR;
push_registers(predarity, nextop);
marking_phase(old_TR, current_env, nextop, max);
m_time = cputime();
m_time = _YAP_cputime();
gc_time = m_time-time_start;
if (heap_cells)
effectiveness = ((heap_cells-total_marked)*100)/heap_cells;
else
effectiveness = 0;
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);
#ifdef INSTRUMENT_GC
{
int i;
for (i=0; i<16; 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);
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));
YP_fprintf(YP_stderr,"[GC] %ld choicepoints\n", num_bs);
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));
fprintf(_YAP_stderr,"[GC] %ld choicepoints\n", num_bs);
}
#endif
}
@ -3082,41 +3094,48 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
pop_registers(predarity, nextop);
TR = new_TR;
YAPLeaveCriticalSection();
c_time = cputime();
c_time = _YAP_cputime();
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);
tot_gc_time += gc_time;
tot_gc_recovered += heap_cells-total_marked;
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);
YP_fprintf(YP_stderr, "[GC] Left %ld cells free in stacks.\n",
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);
fprintf(_YAP_stderr, "[GC] Left %ld cells free in stacks.\n",
(unsigned long int)(ASP-H));
}
check_global();
return(effectiveness);
}
int
static int
is_gc_verbose(void)
{
#ifdef INSTRUMENT_GC
/* always give info when we are debugging gc */
return(TRUE);
#else
return(GetValue(AtomGcVerbose) != TermNil ||
GetValue(AtomGcVeryVerbose) != TermNil);
return(_YAP_GetValue(AtomGcVerbose) != TermNil ||
_YAP_GetValue(AtomGcVeryVerbose) != TermNil);
#endif
}
int
_YAP_is_gc_verbose(void)
{
return is_gc_verbose();
}
static int
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);
}
@ -3128,13 +3147,13 @@ p_inform_gc(void)
Term tt = MkIntegerTerm(gc_calls);
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
gc(Int predarity, CELL *current_env, yamop *nextop)
_YAP_gc(Int predarity, CELL *current_env, yamop *nextop)
{
Int gc_margin = 128;
Term Tgc_margin;
@ -3143,13 +3162,13 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
#if defined(YAPOR) || defined(THREADS)
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);
}
#endif
if (GetValue(AtomGc) != TermNil)
if (_YAP_GetValue(AtomGc) != TermNil)
gc_on = TRUE;
if (IsIntTerm(Tgc_margin = GetValue(AtomGcMargin)))
if (IsIntTerm(Tgc_margin = _YAP_GetValue(AtomGcMargin)))
gc_margin = IntOfTerm(Tgc_margin);
else {
if (gc_calls < 8)
@ -3176,14 +3195,14 @@ gc(Int predarity, CELL *current_env, yamop *nextop)
gc_margin = ((gc_margin >> 16) + 1) << 16;
if (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;
check_global();
return(gc_margin >= gap);
}
/*
* 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 );
}
@ -3197,8 +3216,14 @@ p_gc(void)
}
void
init_gc(void)
_YAP_init_gc(void)
{
InitCPred("$gc", 0, p_gc, 0);
InitCPred("$inform_gc", 3, p_inform_gc, 0);
_YAP_InitCPred("$gc", 0, p_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
#endif
int IPredArity;
STATIC_PROTO(int clause_has_cut, (yamop *));
STATIC_PROTO(int followed_by_cut, (yamop *));
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;
while (TRUE)
{
if (p->opc == opcode(_get_x_var))
if (p->opc == _YAP_opcode(_get_x_var))
p = NEXTOP(p,xx);
if (p->opc == opcode(_get_y_var))
if (p->opc == _YAP_opcode(_get_y_var))
p = NEXTOP(p,yx);
else if (p->opc == opcode(_allocate))
else if (p->opc == _YAP_opcode(_allocate))
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);
else if (p->opc == opcode(_unify_y_var))
else if (p->opc == _YAP_opcode(_unify_y_var))
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);
else if (p->opc == opcode(_unify_l_y_var))
else if (p->opc == _YAP_opcode(_unify_l_y_var))
p = NEXTOP(p,oy);
else if (p->opc == opcode(_unify_void))
else if (p->opc == _YAP_opcode(_unify_void))
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);
else if (p->opc == opcode(_unify_l_void))
else if (p->opc == _YAP_opcode(_unify_l_void))
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);
else if (p->opc == opcode(_cut))
else if (p->opc == _YAP_opcode(_cut))
return(TRUE);
else if (p->opc == opcode(_cut_t))
else if (p->opc == _YAP_opcode(_cut_t))
return(TRUE);
else if (p->opc == opcode(_cut_e))
else if (p->opc == _YAP_opcode(_cut_e))
return(TRUE);
else return(FALSE);
}
@ -167,7 +165,7 @@ static int followed_by_cut(yamop * code)
inline static void
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 */
@ -182,7 +180,7 @@ emit_try(compiler_vm_op op, int op_offset, yamop * Address, int NClauses, int Ha
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)
{
yamop *pc = NEXTOP(Arg,ld);
if (pc->opc == opcode(_get_struct))
if (pc->opc == _YAP_opcode(_get_struct))
return (NEXTOP(pc,xf));
else
return (NEXTOP(pc,xc));
@ -227,7 +225,7 @@ inline static yamop *
ThiB(yamop * Arg)
{
yamop *pc = NEXTOP(NEXTOP(Arg,ld),x);
if (pc->opc == opcode(_unify_struct))
if (pc->opc == _YAP_opcode(_unify_struct))
return (NEXTOP(pc,of));
else
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;
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)
emit(count_retry_op, Unsigned(CurrentPred), Zero);
_YAP_emit(count_retry_op, Unsigned(CurrentPred), Zero);
if (NGroups == 1)
Flag = Flag | LoneGroup;
else if (Flag & LastGroup) {
@ -348,8 +346,8 @@ static CELL
emit_space(compiler_vm_op op, int space, int nof)
{
labelno += 2;
emit(label_op, labelno, Zero);
StorePoint = emit_extra_size(op, Unsigned(nof), space);
_YAP_emit(label_op, labelno, Zero);
StorePoint = _YAP_emit_extra_size(op, Unsigned(nof), space);
return (labelno);
}
@ -358,11 +356,11 @@ static CELL
emit_go(int Gender, Term Name)
{
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
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
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[1] = (CELL)FailAddress;
return (labelno);
@ -373,7 +371,7 @@ emit_go(int Gender, Term Name)
static void
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(Ad1);
StorePoint[0] = Unsigned(Ad2);
@ -472,8 +470,8 @@ NGroupsIn(PredEntry *ap)
if (y != PresentGroup) {
Group++->Last = (ActualCl - 1)->Code;
NGroups++;
if ((ADDR)Group > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)Group > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
Group->First = q;
Group->Start = ActualCl;
Group->NCl = 0;
@ -504,7 +502,7 @@ NGroupsIn(PredEntry *ap)
if (ASP <= CellPtr (ActualCl) + 256) {
freep = (char *)ActualCl;
save_machine_regs();
longjmp(CompilerBotch, 3);
longjmp(_YAP_CompilerBotch, 3);
}
(Group->Type[x])++;
(Group->NCl)++;
@ -600,7 +598,7 @@ BuildHash(CELL *WhereTo, int NOfEntries, int TableSize, int Gend)
}
#ifdef DEBUG
#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 /* DEBUG */
}
@ -629,7 +627,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
/* last group, meaning we already have a choice point set */
register yamop * k = (Entrance->First)->Code;
labelno += 2;
emit(label_op, Entrance->Code = labelno, Zero);
_YAP_emit(label_op, Entrance->Code = labelno, Zero);
if (PositionFlag & HeadIndex) {
emit_tr(trust_op, ThiB(k), 1, clause_has_cut(k));
} else {
@ -643,7 +641,7 @@ TreatEntry(EntryDef *Entrance, int Gender, int PositionFlag, GroupDef *Gr)
/* a single alternative and a catchall clause */
register yamop * k = (Entrance->First)->Code;
labelno += 2;
emit(label_op, Entrance->Code = labelno, Zero);
_YAP_emit(label_op, Entrance->Code = labelno, Zero);
/* if we are in a list */
if (PositionFlag & HeadIndex) {
/* 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;
k = Entrance->First;
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);
nofalts--;
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 a jump with the place to jump to after finishing this group */
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)
Entry++, l++;
if (l == NDiffTerms) {
if ((ADDR)Entry > TrailTop-1024)
growtrail(64 * 1024L);
if ((ADDR)Entry > _YAP_TrailTop-1024)
_YAP_growtrail(64 * 1024L);
Entry->Class = HeadName;
Entry->Last = Entry->First = j;
NDiffTerms++;
@ -786,7 +784,7 @@ DealFixedWithBips(ClauseDef *j, int NClauses, int Flag, GroupDef *Gr)
labelno += 2;
my_labelno = labelno;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
#ifdef AGRESSIVE_BIPS
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;
Gr->NofClausesAfter = old_NAlts + G->NCl - i;
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;
ExtendedSingle = old_ExtendedSingle;
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 a jump with the place to jump to after finishing this group */
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);
}
@ -852,14 +850,14 @@ DealCons(int i)
if (FinalGr(i)) {
yamop * Cl = FindFirst(i, AtCl);
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
emit_tr(trust_op, Cl, 1, clause_has_cut(Cl));
return (labelno);
} else if (ExtendedSingle) {
yamop * Cl = FindFirst(i, AtCl);
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(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno);
@ -897,13 +895,13 @@ DealAppl(int i)
if (FinalGr(i)) {
yamop * Cl = FindFirst(i, ApplCl);
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
emit_tr(trust_op, Cl, 1, clause_has_cut(Cl));
return (labelno);
} else if (ExtendedSingle) {
yamop * Cl = FindFirst(i, ApplCl);
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(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno);
@ -931,12 +929,12 @@ StartList(int i)
j++;
if (FinalGr(i)) {
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));
return (labelno);
} else if (ExtendedSingle) {
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(trust_op, FailAddress, 1, clause_has_cut(FailAddress));
return (labelno);
@ -980,7 +978,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
else if (NOfClauses == 1) {
if (FinalGr(NG)) {
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
if (PositionFlag & FirstIndex)
emit_tr(trust_op, SecLB(j->Code), 1, clause_has_cut(j->Code));
else
@ -988,7 +986,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
return (labelno);
} else if (ExtendedSingle) {
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
if (PositionFlag & FirstIndex)
emit_tr(try_op, SecLB(j->Code), 2, clause_has_cut(j->Code));
else
@ -1003,7 +1001,7 @@ DealLList(ClauseDef *j, int NOfClauses, int PositionFlag, int NG)
if (FinalGr(NG))
PositionFlag |= LastGroup;
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
nofalts = Groups[NG].NofClausesAfter+NOfClauses;
emit_cp_inst(try_op, j->Code, PositionFlag, 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 a jump with the place to jump to after finishing this group */
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);
}
}
@ -1097,7 +1095,7 @@ DealList(int i)
else
VFlags = FirstIndex | LastFoundList;
labelno += 2;
emit(label_op, labelno, Zero);
_YAP_emit(label_op, labelno, Zero);
emit_cp_inst(try_op, j->Code, VFlags, nofalts);
nofalts--;
if (indexed_code_for_cut != NIL) {
@ -1112,7 +1110,7 @@ DealList(int i)
emit_cp_inst(trust_op, j->Code, VFlags, nofalts);
/* emit a jump with the place to jump to after finishing this group */
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);
}
}
@ -1241,11 +1239,11 @@ IndexVarGr(int Count)
Cla++;
nofalts--;
} 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));
return;
} 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));
Cla++;
nofalts--;
@ -1279,7 +1277,7 @@ ComplexCase(void)
if (IsExtendedSingle(0))
return (SimpleCase());
emit(jump_v_op, (CELL) FirstCl, Zero);
_YAP_emit(jump_v_op, (CELL) FirstCl, Zero);
if (Groups[0].Type[VarCl] == 0)
i = 0;
else {
@ -1319,19 +1317,19 @@ SpecialCases(void)
}
CODEADDR
PredIsIndexable(PredEntry *ap)
_YAP_PredIsIndexable(PredEntry *ap)
{
int NGr, Indexable = 0;
CODEADDR indx_out = NIL;
log_update = 0;
if (setjmp(CompilerBotch) == 3) {
if (setjmp(_YAP_CompilerBotch) == 3) {
/* just duplicate the stack */
restore_machine_regs();
gc(ap->ArityOfPE, ENV, CP);
_YAP_gc(ap->ArityOfPE, ENV, CP);
}
restart_index:
ErrorMessage = NULL;
_YAP_ErrorMessage = NULL;
labelno = 1;
RemovedCl = FALSE;
FirstCl = (yamop *)(ap->FirstClause);
@ -1353,7 +1351,7 @@ PredIsIndexable(PredEntry *ap)
Entries = (EntryDef *) (Groups + NGroups);
CodeStart = cpc = NIL;
freep = (char *) (ArOfCl + NClauses);
if (ErrorMessage != NULL) {
if (_YAP_ErrorMessage != NULL) {
return (NIL);
}
if (CurrentPred->PredFlags & LogUpdatePredFlag) {
@ -1372,7 +1370,7 @@ PredIsIndexable(PredEntry *ap)
Indexable = SpecialCases();
}
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);
}
if (log_update && NClauses > 1) {
@ -1380,8 +1378,8 @@ PredIsIndexable(PredEntry *ap)
Clause *cl;
Indexable = TRUE;
emit(label_op, log_update, Zero);
emit(try_op, Unsigned(Body(ArOfCl[0].Code)), Zero);
_YAP_emit(label_op, log_update, Zero);
_YAP_emit(try_op, Unsigned(Body(ArOfCl[0].Code)), Zero);
cl = ClauseCodeToClause(ArOfCl[0].Code);
if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++;
@ -1389,7 +1387,7 @@ PredIsIndexable(PredEntry *ap)
cl->u2.ClUse++;
}
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);
if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++;
@ -1397,7 +1395,7 @@ PredIsIndexable(PredEntry *ap)
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);
if (cl->ClFlags & LogUpdRuleMask) {
cl->u2.ClExt->u.EC.ClRefs++;
@ -1409,13 +1407,13 @@ PredIsIndexable(PredEntry *ap)
return (NIL);
} else {
#ifdef DEBUG
if (Option['i' - 'a' + 1]) {
ShowCode();
if (_YAP_Option['i' - 'a' + 1]) {
_YAP_ShowCode();
}
#endif
if ((indx_out = assemble(ASSEMBLING_INDEX)) == NIL) {
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if ((indx_out = _YAP_assemble(ASSEMBLING_INDEX)) == NIL) {
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
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
*/
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
* code files and libraries and locates an initialization routine
*/
Int
static Int
LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
@ -45,28 +45,35 @@ LoadForeign(StringList ofiles, StringList libs,
/* load wants to follow the LIBRARY_PATH */
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;
}
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) {
strcpy(LoadMsg, " Trying to open unexisting file in LoadForeign ");
if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(_YAP_ErrorSay, " Trying to open unexisting file in LoadForeign ");
return LOAD_FAILLED;
}
/* In AIX, just call load and everything will go in */
if ((*init_proc=((YapInitProc *)load(FileNameBuf,0,NULL))) == NULL) {
strcpy(LoadMsg,sys_errlist[errno]);
if ((*init_proc=((YapInitProc *)load(_YAP_FileNameBuf,0,NULL))) == NULL) {
strcpy(_YAP_ErrorSay,sys_errlist[errno]);
return LOAD_FAILLED;
}
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
void
YAP_FindExecutable(char *name)
_YAP_FindExecutable(char *name)
{
register char *cp, *cp2;
struct stat stbuf;
@ -64,10 +64,10 @@ YAP_FindExecutable(char *name)
cp = (char *)getenv("PATH");
if (cp == NULL)
cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin";
if (*yap_args[0] == '/') {
if (oktox(yap_args[0])) {
strcpy(FileNameBuf, yap_args[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE);
if (*_YAP_argv[0] == '/') {
if (oktox(_YAP_argv[0])) {
strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return;
}
}
@ -79,24 +79,24 @@ YAP_FindExecutable(char *name)
* argv[0]
*/
for (cp2 = FileNameBuf; (*cp) != 0 && (*cp) != ':';)
for (cp2 = _YAP_FileNameBuf; (*cp) != 0 && (*cp) != ':';)
*cp2++ = *cp++;
*cp2++ = '/';
strcpy(cp2, yap_args[0]);
strcpy(cp2, _YAP_argv[0]);
if (*cp)
cp++;
if (!oktox(FileNameBuf))
if (!oktox(_YAP_FileNameBuf))
continue;
TrueFileName(FileNameBuf, YapExecutable, TRUE);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return;
}
/* one last try for dual systems */
strcpy(FileNameBuf, yap_args[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE);
strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
if (oktox(YapExecutable))
return;
else
Error(SYSTEM_ERROR,MkAtomTerm(LookupAtom(YapExecutable)),
_YAP_Error(SYSTEM_ERROR,MkAtomTerm(_YAP_LookupAtom(YapExecutable)),
"cannot find file being executed");
}
@ -105,7 +105,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine
*/
int
static int
LoadForeign(StringList ofiles,
StringList libs,
char *proc_name,
@ -156,7 +156,7 @@ LoadForeign(StringList ofiles,
/* prepare the magic */
if (strlen(o_files) + strlen(l_files) + strlen(proc_name) +
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;
}
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 */
if (system(command) != 0) {
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;
}
/* now check the music has played */
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;
}
/* it did, get the mice */
@ -184,8 +184,8 @@ LoadForeign(StringList ofiles,
/* keep this copy */
firstloadImSz = loadImageSize;
/* now fetch the space we need */
if (!(FCodeBase = AllocCodeSpace((int) loadImageSize))) {
strcpy(LoadMsg," unable to allocate space for external code ");
if (!(FCodeBase = _YAP_AllocCodeSpace((int) loadImageSize))) {
strcpy(_YAP_ErrorSay," unable to allocate space for external code ");
return LOAD_FAILLED;
}
/* now, a new incantation to load the new foreign code */
@ -196,17 +196,17 @@ LoadForeign(StringList ofiles,
/* and do it */
if (system(command) != 0) {
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;
}
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;
}
read(fildes, (char *) &header, sizeof(header));
loadImageSize = header.a_text + header.a_data + header.a_bss;
if (firstloadImSz < loadImageSize) {
strcpy(LoadMsg," miscalculation in load_foreign/3 ");
strcpy(_YAP_ErrorSay," miscalculation in load_foreign/3 ");
return LOAD_FAILLED;
}
/* now search for our init function */
@ -217,11 +217,11 @@ LoadForeign(StringList ofiles,
func_info[0].n_un.n_name = entry_fun;
func_info[1].n_un.n_name = NULL;
if (nlist(tfile, func_info) == -1) {
strcpy(LoadMsg," in nlist(3) ");
strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED;
}
if (func_info[0].n_type == 0) {
strcpy(LoadMsg," in nlist(3) ");
strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED;
}
*init_proc = (YapInitProc)(func_info[0].n_value);
@ -241,13 +241,20 @@ LoadForeign(StringList ofiles,
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
void
YAP_FindExecutable(char *name)
_YAP_FindExecutable(char *name)
{
register char *cp, *cp2;
struct stat stbuf;
@ -62,10 +62,10 @@ YAP_FindExecutable(char *name)
cp = (char *)getenv("PATH");
if (cp == NULL)
cp = ".:/usr/ucb:/bin:/usr/bin:/usr/local/bin";
if (*yap_args[0] == '/') {
if (oktox(yap_args[0])) {
strcpy(FileNameBuf, yap_args[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE);
if (*_YAP_argv[0] == '/') {
if (oktox(_YAP_argv[0])) {
strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return;
}
}
@ -77,24 +77,24 @@ YAP_FindExecutable(char *name)
* argv[0]
*/
for (cp2 = FileNameBuf; (*cp) != 0 && (*cp) != ':';)
for (cp2 = _YAP_FileNameBuf; (*cp) != 0 && (*cp) != ':';)
*cp2++ = *cp++;
*cp2++ = '/';
strcpy(cp2, yap_args[0]);
strcpy(cp2, _YAP_argv[0]);
if (*cp)
cp++;
if (!oktox(FileNameBuf))
if (!oktox(_YAP_FileNameBuf))
continue;
TrueFileName(FileNameBuf, YapExecutable, TRUE);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
return;
}
/* one last try for dual systems */
strcpy(FileNameBuf, yap_args[0]);
TrueFileName(FileNameBuf, YapExecutable, TRUE);
strcpy(_YAP_FileNameBuf, _YAP_argv[0]);
_YAP_TrueFileName(_YAP_FileNameBuf, YapExecutable, TRUE);
if (oktox(YapExecutable))
return;
else
Error(SYSTEM_ERROR,MkAtomTerm(LookupAtom(YapExecutable)),
_YAP_Error(SYSTEM_ERROR,MkAtomTerm(_YAP_LookupAtom(YapExecutable)),
"cannot find file being executed");
}
@ -103,7 +103,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine
*/
int
static Int
LoadForeign(StringList ofiles,
StringList libs,
char *proc_name,
@ -157,7 +157,7 @@ LoadForeign(StringList ofiles,
/* prepare the magic */
if (strlen(o_files) + strlen(l_files) + strlen(proc_name) +
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;
}
sprintf(command, "/usr/bin/ld -N -A %s -o %s %s %s -lc",
@ -166,12 +166,12 @@ LoadForeign(StringList ofiles,
/* now, do the magic */
if (system(command) != 0) {
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;
}
/* now check the music has played */
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;
}
/* it did, get the mice */
@ -196,12 +196,12 @@ LoadForeign(StringList ofiles,
/* keep this copy */
firstloadImSz = loadImageSize;
/* now fetch the space we need */
if (!(FCodeBase = AllocCodeSpace((int) loadImageSize))
if (!(FCodeBase = _YAP_AllocCodeSpace((int) loadImageSize))
#ifdef pyr
|| activate_code(ForeignCodeBase, u1)
#endif /* pyr */
) {
strcpy(LoadMsg," unable to allocate space for external code ");
strcpy(_YAP_ErrorSay," unable to allocate space for external code ");
return LOAD_FAILLED;
}
#ifdef mips
@ -215,7 +215,7 @@ LoadForeign(StringList ofiles,
sprintf(command, "ld -x -A %s -T %lx -o %s -u %s %s %s -lc",
ostabf,
((unsigned long) (((unsigned long) (ForeignCodeBase)) &
((unsigned long) (~HeapBase))
((unsigned long) (~_YAP_HeapBase))
)
), tfile, entry_point, o_files, l_files);
#else
@ -234,11 +234,11 @@ LoadForeign(StringList ofiles,
/* and do it */
if (system(command) != 0) {
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;
}
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;
}
read(fildes, (char *) &fileHeader, sizeof(fileHeader));
@ -250,7 +250,7 @@ LoadForeign(StringList ofiles,
}
loadImageSize = sysHeader.tsize + sysHeader.dsize + sysHeader.bsize;
if (firstloadImSz < loadImageSize) {
strcpy(LoadMsg," miscalculation in load_foreign/3 ");
strcpy(_YAP_ErrorSay," miscalculation in load_foreign/3 ");
return LOAD_FAILLED;
}
/* now search for our init function */
@ -266,11 +266,11 @@ LoadForeign(StringList ofiles,
func_info[0].n_name = entry_fun;
func_info[1].n_name = NULL;
if (nlist(tfile, func_info) == -1) {
strcpy(LoadMsg," in nlist(3) ");
strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED;
}
if (func_info[0].n_type == 0) {
strcpy(LoadMsg," in nlist(3) ");
strcpy(_YAP_ErrorSay," in nlist(3) ");
return LOAD_FAILLED;
}
*init_proc = (YapInitProc)(func_info[0].n_value);
@ -290,13 +290,20 @@ LoadForeign(StringList ofiles,
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
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
* code files and libraries and locates an initialization routine
*/
Int
static Int
LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
@ -48,18 +48,18 @@ LoadForeign(StringList ofiles, StringList libs,
void *handle;
/* dlopen wants to follow the LD_CONFIG_PATH */
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) {
strcpy(LoadMsg, "[ Trying to open unexisting file in LoadForeign ]");
if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(_YAP_ErrorSay, "[ Trying to open unexisting file in LoadForeign ]");
return LOAD_FAILLED;
}
#ifdef __osf__
if((handle=dlopen(FileNameBuf,RTLD_LAZY)) == 0)
if((handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY)) == 0)
#else
if((handle=dlopen(FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0)
if((handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == 0)
#endif
{
fprintf(stderr,"calling dlopen with error %s\n", dlerror());
/* strcpy(LoadMsg,dlerror());*/
fprintf(stderr,"dlopen of %s failed with error %s\n", _YAP_FileNameBuf, dlerror());
/* strcpy(_YAP_ErrorSay,dlerror());*/
return LOAD_FAILLED;
}
@ -72,7 +72,7 @@ LoadForeign(StringList ofiles, StringList libs,
}
if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine");
strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED;
}
@ -81,20 +81,20 @@ LoadForeign(StringList ofiles, StringList libs,
while (libs) {
if (libs->s[0] == '-') {
strcpy(FileNameBuf,"lib");
strcat(FileNameBuf,libs->s+2);
strcat(FileNameBuf,".so");
strcpy(_YAP_FileNameBuf,"lib");
strcat(_YAP_FileNameBuf,libs->s+2);
strcat(_YAP_FileNameBuf,".so");
} else {
strcpy(FileNameBuf,libs->s);
strcpy(_YAP_FileNameBuf,libs->s);
}
#ifdef __osf__
if((libs->handle=dlopen(FileNameBuf,RTLD_LAZY)) == NULL)
if((libs->handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY)) == NULL)
#else
if((libs->handle=dlopen(FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL)
if((libs->handle=dlopen(_YAP_FileNameBuf,RTLD_LAZY|RTLD_GLOBAL)) == NULL)
#endif
{
strcpy(LoadMsg,dlerror());
strcpy(_YAP_ErrorSay,dlerror());
return LOAD_FAILLED;
}
libs = libs->next;
@ -102,8 +102,15 @@ LoadForeign(StringList ofiles, StringList libs,
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
ForeignObj *f_code;
@ -128,7 +135,7 @@ ShutdownLoadForeign(void)
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
void
YAP_FindExecutable(char *name)
_YAP_FindExecutable(char *name)
{
/* use dld_find_executable */
char *res;
@ -44,7 +44,7 @@ YAP_FindExecutable(char *name)
* LoadForeign(ofiles,libs,proc_name,init_proc) dynamically loads foreign
* code files and libraries and locates an initialization routine
*/
int
static int
LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
@ -54,7 +54,7 @@ LoadForeign(StringList ofiles, StringList libs,
if(firstTime) {
error = dld_init(YapExecutable);
if(error) {
strcpy(LoadMsg,dld_strerror(error));
strcpy(_YAP_ErrorSay,dld_strerror(error));
return LOAD_FAILLED;
}
firstTime=0;
@ -62,7 +62,7 @@ LoadForeign(StringList ofiles, StringList libs,
while (ofiles) {
if((error=dld_link(ofiles->s)) !=0) {
strcpy(LoadMsg,dld_strerror(error));
strcpy(_YAP_ErrorSay,dld_strerror(error));
return LOAD_FAILLED;
}
ofiles = ofiles->next;
@ -72,14 +72,14 @@ LoadForeign(StringList ofiles, StringList libs,
/* TODO: handle libs */
*init_proc = (YapInitProc) dld_get_func(proc_name);
if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine");
strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED;
}
if(!dld_function_executable_p(proc_name)) {
char **undefs = dld_list_undefined_sym();
char **p = undefs;
int k = dld_undefined_sym_count;
strcpy(LoadMsg,"Could not resolve all symbols");
strcpy(_YAP_ErrorSay,"Could not resolve all symbols");
while(k) {
YP_printf("[undefined symbol %s]\n",*p++);
--k;
@ -91,13 +91,20 @@ LoadForeign(StringList ofiles, StringList libs,
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
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
* code files and libraries and locates an initialization routine
*/
Int
static Int
LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
@ -45,8 +45,8 @@ LoadForeign(StringList ofiles, StringList libs,
while (ofiles) {
HINSTANCE handle;
if (TrueFileName(ofiles->s, FileNameBuf, TRUE) &&
(handle=LoadLibrary(FileNameBuf)) != 0)
if (_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE) &&
(handle=LoadLibrary(_YAP_FileNameBuf)) != 0)
{
if (*init_proc == NULL)
*init_proc = (YapInitProc)GetProcAddress((HMODULE)handle, proc_name);
@ -60,15 +60,15 @@ LoadForeign(StringList ofiles, StringList libs,
HINSTANCE handle;
if (libs->s[0] == '-') {
strcat(FileNameBuf,libs->s+2);
strcat(FileNameBuf,".dll");
strcat(_YAP_FileNameBuf,libs->s+2);
strcat(_YAP_FileNameBuf,".dll");
} 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;
}
@ -79,20 +79,27 @@ LoadForeign(StringList ofiles, StringList libs,
}
if(*init_proc == NULL) {
strcpy(LoadMsg,"Could not locate initialization routine");
strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED;
}
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
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
* code files and libraries and locates an initialization routine
*/
Int
static Int
LoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc)
{
@ -122,14 +122,14 @@ LoadForeign(StringList ofiles, StringList libs,
void *handle;
/* mydlopen wants to follow the LD_CONFIG_PATH */
if (!TrueFileName(ofiles->s, FileNameBuf, TRUE)) {
strcpy(LoadMsg, "[ Trying to open unexisting file in LoadForeign ]");
if (!_YAP_TrueFileName(ofiles->s, _YAP_FileNameBuf, TRUE)) {
strcpy(_YAP_ErrorSay, "[ Trying to open unexisting file in LoadForeign ]");
return LOAD_FAILLED;
}
if((handle=mydlopen(FileNameBuf)) == 0)
if((handle=mydlopen(_YAP_FileNameBuf)) == 0)
{
fprintf(stderr,"calling dlopen with error %s\n", mydlerror());
/* strcpy(LoadMsg,dlerror());*/
/* strcpy(_YAP_ErrorSay,dlerror());*/
return LOAD_FAILLED;
}
@ -142,16 +142,16 @@ LoadForeign(StringList ofiles, StringList libs,
while (libs) {
if (libs->s[0] == '-') {
strcpy(FileNameBuf,"lib");
strcat(FileNameBuf,libs->s+2);
strcat(FileNameBuf,".so");
strcpy(_YAP_FileNameBuf,"lib");
strcat(_YAP_FileNameBuf,libs->s+2);
strcat(_YAP_FileNameBuf,".so");
} 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;
}
libs = libs->next;
@ -160,15 +160,22 @@ LoadForeign(StringList ofiles, StringList libs,
*init_proc = (YapInitProc) mydlsym(proc_name);
if(! *init_proc) {
strcpy(LoadMsg,"Could not locate initialization routine");
strcpy(_YAP_ErrorSay,"Could not locate initialization routine");
return LOAD_FAILLED;
}
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
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
ForeignObj *f_code;
@ -193,7 +200,7 @@ ShutdownLoadForeign(void)
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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"
#if _WIN32
#if _WIN32 || defined(__CYGWIN__)
#ifndef SHLIB_SUFFIX
#define SHLIB_SUFFIX "dll"
#endif
#endif
char LoadMsg[512];
STD_PROTO(Int p_load_foreign, (void));
Int
@ -49,7 +47,7 @@ p_load_foreign(void)
StringList new;
Int returncode = FALSE;
strcpy(LoadMsg,"Invalid arguments");
strcpy(_YAP_ErrorSay,"Invalid arguments");
/* collect the list of object files */
t = Deref(ARG1);
@ -57,7 +55,7 @@ p_load_foreign(void)
if (t == TermNil) break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
new = (StringList) AllocCodeSpace(sizeof(StringListItem));
new = (StringList) _YAP_AllocCodeSpace(sizeof(StringListItem));
new->next = ofiles;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
ofiles = new;
@ -69,7 +67,7 @@ p_load_foreign(void)
if (t == TermNil) break;
t1 = HeadOfTerm(t);
t = TailOfTerm(t);
new = (StringList) AllocCodeSpace(sizeof(StringListItem));
new = (StringList) _YAP_AllocCodeSpace(sizeof(StringListItem));
new->next = libs;
new->s = RepAtom(AtomOfTerm(t1))->StrOfAE;
libs = new;
@ -82,14 +80,14 @@ p_load_foreign(void)
/* 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)();
returncode = TRUE;
}
/* I should recover space if load foreign fails */
if (returncode == TRUE) {
ForeignObj *f_code = (ForeignObj *)AllocCodeSpace(sizeof(ForeignObj));
ForeignObj *f_code = (ForeignObj *)_YAP_AllocCodeSpace(sizeof(ForeignObj));
f_code->objs = ofiles;
f_code->libs = libs;
f_code->f = InitProcName;
@ -102,22 +100,22 @@ p_load_foreign(void)
static Int
p_obj_suffix(void) {
return(unify(StringToList(SHLIB_SUFFIX),ARG1));
return(_YAP_unify(_YAP_StringToList(SHLIB_SUFFIX),ARG1));
}
void
InitLoadForeign(void)
_YAP_InitLoadForeign(void)
{
if (yap_args == NULL)
YAP_FindExecutable("yap");
if (_YAP_argv == NULL)
_YAP_FindExecutable("yap");
else
YAP_FindExecutable(yap_args[0]);
InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag);
_YAP_FindExecutable(_YAP_argv[0]);
_YAP_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("$obj_suffix", 1, p_obj_suffix, SafePredFlag);
}
void
ReOpenLoadForeign(void)
_YAP_ReOpenLoadForeign(void)
{
ForeignObj *f_code = ForeignCodeLoaded;
SMALLUNSGN OldModule = CurrentModule;
@ -125,7 +123,7 @@ ReOpenLoadForeign(void)
while (f_code != NULL) {
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)();
}
f_code = f_code->next;

10
C/load_none.c
View File

@ -26,7 +26,7 @@
* locate the executable of Yap
*/
void
YAP_FindExecutable(char *name)
_YAP_FindExecutable(char *name)
{
}
@ -36,20 +36,20 @@ YAP_FindExecutable(char *name)
* code file and locates an initialization routine
*/
Int
LoadForeign(StringList ofiles, StringList libs,
_YAP_LoadForeign(StringList ofiles, StringList libs,
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;
}
void
ShutdownLoadForeign(void)
_YAP_ShutdownLoadForeign(void)
{
}
Int
ReLoadForeign(StringList ofiles, StringList libs,
_YAP_ReLoadForeign(StringList ofiles, StringList libs,
char *proc_name, YapInitProc *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
*/
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
*/
Int LoadForeign( StringList ofiles, StringList libs,
static Int
LoadForeign( StringList ofiles, StringList libs,
char *proc_name, YapInitProc *init_proc )
{
@ -40,17 +41,17 @@ Int LoadForeign( StringList ofiles, StringList libs,
int valid_fname;
/* 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 ) {
strcpy( LoadMsg, "[ Trying to open non-existing file in LoadForeign ]" );
strcpy( _YAP_ErrorSay, "[ Trying to open non-existing file in LoadForeign ]" );
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 );
if( *(shl_t *)ofiles->handle == NULL ) {
strncpy( LoadMsg, strerror(errno), 512 );
strncpy( _YAP_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE );
return LOAD_FAILLED;
}
@ -63,7 +64,7 @@ Int LoadForeign( StringList ofiles, StringList libs,
}
if( init_missing ) {
strcpy( LoadMsg, "Could not locate initialization routine" );
strcpy( _YAP_ErrorSay, "Could not locate initialization routine" );
return LOAD_FAILLED;
}
@ -80,7 +81,7 @@ Int LoadForeign( StringList ofiles, StringList libs,
*(shl_t *)libs->handle = shl_load( FileNameBuf, BIND_DEFERRED, 0 );
if( *(shl_t *)libs->handle == NULL ) {
strncpy( LoadMsg, strerror(errno), 512 );
strncpy( _YAP_ErrorSay, strerror(errno), MAX_ERROR_MSG_SIZE );
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;
int err;
@ -108,7 +117,7 @@ void ShutdownLoadForeign( void )
perror( NULL );
return;
}
FreeCodeSpace( objs->handle );
_YAP_FreeCodeSpace( objs->handle );
objs = objs->next;
}
@ -120,14 +129,15 @@ void ShutdownLoadForeign( void )
perror( NULL );
return;
}
FreeCodeSpace( libs->handle );
_YAP_FreeCodeSpace( libs->handle );
libs = libs->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)
{
ShutdownLoadForeign();

83
C/mavar.c
View File

@ -35,32 +35,32 @@ p_setarg(void)
CELL ti = Deref(ARG1), ts = Deref(ARG2);
Int i;
if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"setarg/3");
_YAP_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return(FALSE);
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
union arith_ret v;
if (Eval(ti, &v) == long_int_e) {
if (_YAP_Eval(ti, &v) == long_int_e) {
i = v.Int;
} else {
Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
_YAP_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return(FALSE);
}
}
}
if (IsVarTerm(ts)) {
Error(INSTANTIATION_ERROR,ts,"setarg/3");
_YAP_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
_YAP_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return(FALSE);
}
if (i < 0 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
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);
}
pt = RepAppl(ts)+i;
@ -70,14 +70,14 @@ p_setarg(void)
CELL *pt;
if (i != 1 || i != 2) {
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);
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, Deref(ARG3));
} else {
Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
_YAP_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return(FALSE);
}
return(TRUE);
@ -112,7 +112,7 @@ static void
CreateTimedVar(Term val)
{
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) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
@ -127,7 +127,7 @@ static void
CreateEmptyTimedVar(void)
{
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) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
@ -139,7 +139,8 @@ CreateEmptyTimedVar(void)
}
#endif
Term NewTimedVar(CELL val)
static Term
NewTimedVar(CELL val)
{
Term out = AbsAppl(H);
#if FROZEN_STACKS
@ -156,7 +157,14 @@ Term NewTimedVar(CELL val)
return(out);
}
Term NewEmptyTimedVar(void)
Term
_YAP_NewTimedVar(CELL val)
{
return NewTimedVar(val);
}
Term
_YAP_NewEmptyTimedVar(void)
{
Term out = AbsAppl(H);
#if FROZEN_STACKS
@ -173,20 +181,28 @@ Term NewEmptyTimedVar(void)
return(out);
}
Term ReadTimedVar(Term inv)
static Term
ReadTimedVar(Term inv)
{
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
return(tv->value);
}
Term
_YAP_ReadTimedVar(Term inv)
{
return ReadTimedVar(inv);
}
/* 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);
CELL t = tv->value;
#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) {
/* last assignment more recent than last B */
@ -203,7 +219,7 @@ Term UpdateTimedVar(Term inv, Term new)
} else {
Term nclock;
MaBind(&(tv->value), new);
nclock = MkIntegerTerm(TR-(tr_fr_ptr)TrailBase);
nclock = MkIntegerTerm(TR-(tr_fr_ptr)_YAP_TrailBase);
MaBind(&(tv->clock), nclock);
}
#else
@ -228,11 +244,18 @@ Term UpdateTimedVar(Term inv, Term new)
return(t);
}
/* update a timed var with a new value */
Term
_YAP_UpdateTimedVar(Term inv, Term new)
{
return UpdateTimedVar(inv, new);
}
static Int
p_create_mutable(void)
{
Term t = NewTimedVar(Deref(ARG1));
return(unify(ARG2,t));
return(_YAP_unify(ARG2,t));
}
static Int
@ -240,19 +263,19 @@ p_get_mutable(void)
{
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "get_mutable/3");
_YAP_Error(INSTANTIATION_ERROR, t, "get_mutable/3");
return(FALSE);
}
if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
_YAP_Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
return(FALSE);
}
if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
_YAP_Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
return(FALSE);
}
t = ReadTimedVar(t);
return(unify(ARG1, t));
return(_YAP_unify(ARG1, t));
}
static Int
@ -260,15 +283,15 @@ p_update_mutable(void)
{
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "update_mutable/3");
_YAP_Error(INSTANTIATION_ERROR, t, "update_mutable/3");
return(FALSE);
}
if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
_YAP_Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
return(FALSE);
}
if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
_YAP_Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
return(FALSE);
}
UpdateTimedVar(t, Deref(ARG1));
@ -294,14 +317,14 @@ p_is_mutable(void)
#endif
void
InitMaVarCPreds(void)
_YAP_InitMaVarCPreds(void)
{
#ifdef MULTI_ASSIGNMENT_VARIABLES
/* The most famous contributions of SICStus to the Prolog language */
InitCPred("setarg", 3, p_setarg, SafePredFlag);
InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
_YAP_InitCPred("setarg", 3, p_setarg, SafePredFlag);
_YAP_InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
_YAP_InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
_YAP_InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
_YAP_InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
#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_module1, (void));
STD_PROTO(void InitModules, (void));
#define ByteAdr(X) ((char *) &(X))
Term
Module_Name(CODEADDR cap)
_YAP_Module_Name(CODEADDR cap)
{
PredEntry *ap = (PredEntry *)cap;
@ -46,7 +45,7 @@ Module_Name(CODEADDR cap)
}
}
SMALLUNSGN
static SMALLUNSGN
LookupModule(Term a)
{
unsigned int i;
@ -56,18 +55,23 @@ LookupModule(Term a)
return (i);
ModuleName[i = NoOfModules++] = a;
if (NoOfModules == MaxModules) {
Error(SYSTEM_ERROR,a,"number of modules overflowed");
_YAP_Error(SYSTEM_ERROR,a,"number of modules overflowed");
}
return (i);
}
SMALLUNSGN
_YAP_LookupModule(Term a)
{
return(LookupModule(a));
}
static Int
p_current_module(void)
{ /* $current_module(Old,New) */
Term t;
unsigned int i;
if (!unify_constant(ARG1, ModuleName[CurrentModule]))
if (!_YAP_unify_constant(ARG1, ModuleName[CurrentModule]))
return (0);
t = Deref(ARG2);
if (IsVarTerm(t) || !IsAtomTerm(t))
@ -85,7 +89,7 @@ p_current_module(void)
static Int
p_current_module1(void)
{ /* $current_module(Old) */
if (!unify_constant(ARG1, ModuleName[CurrentModule]))
if (!_YAP_unify_constant(ARG1, ModuleName[CurrentModule]))
return (0);
return (1);
}
@ -104,10 +108,10 @@ p_module_number(void)
Term tname = Deref(ARG1);
Term t;
if (IsVarTerm(tname)) {
return(unify(tname, ModuleName[IntOfTerm(Deref(ARG2))]));
return(_YAP_unify(tname, ModuleName[IntOfTerm(Deref(ARG2))]));
}else {
t = MkIntTerm(LookupModule(Deref(ARG1)));
unify(t,ARG2);
_YAP_unify(t,ARG2);
ARG2 = t;
}
return(TRUE);
@ -123,7 +127,7 @@ cont_current_module(void)
cut_fail();
}
EXTRA_CBACK_ARG(1,1) = MkIntTerm(mod+1);
return(unify(ARG1,t));
return(_YAP_unify(ARG1,t));
}
static Int
@ -134,18 +138,18 @@ init_current_module(void)
}
void
InitModules(void)
_YAP_InitModules(void)
{
ModuleName[PrimitivesModule = 0] =
MkAtomTerm(LookupAtom("prolog"));
MkAtomTerm(_YAP_LookupAtom("prolog"));
ModuleName[1] =
MkAtomTerm(LookupAtom("user"));
MkAtomTerm(_YAP_LookupAtom("user"));
NoOfModules = 2;
CurrentModule = 0;
InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
InitCPred("$module_number", 2, p_module_number, SafePredFlag);
InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
_YAP_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("$module_number", 2, p_module_number, SafePredFlag);
_YAP_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
SafePredFlag|SyncPredFlag);
}

27
C/other.c
View File

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

197
C/parser.c
View File

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

375
C/save.c
View File

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

247
C/scanner.c
View File

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

38
C/sort.c
View File

@ -58,8 +58,8 @@ build_new_list(CELL *pt, Term t)
}
pt += 2;
if (pt > ASP - 4096) {
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
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 (pt_left < end_pt_left && pt_right < end_pt) {
/* 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 */
pt[0] = pt_left[0];
/* and avance the two pointers */
@ -130,7 +130,7 @@ void simple_mergesort(CELL *pt, Int size, int my_p)
}
}
} 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];
pt[2+my_p] = pt[0];
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)
return(FALSE);
t1 = ArgOfTerm(1,t1);
if (compare_terms(t0, t1) <= 0) {
if (_YAP_compare_terms(t0, t1) <= 0) {
/* copy the one to the left */
pt[0] = pt_left[0];
/* 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)
return(FALSE);
t1 = ArgOfTerm(1,t1);
if (compare_terms(t0,t1) > 0) {
if (_YAP_compare_terms(t0,t1) > 0) {
CELL t = pt[2];
pt[2+my_p] = pt[0];
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 (pt_left < end_pt_left && pt_right < end_pt_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) {
/* copy the one to the left */
pt[0] = pt_left[0];
@ -302,7 +302,7 @@ Int compact_mergesort(CELL *pt, Int size, int my_p)
}
return(size);
} else if (size == 2) {
Int cmp = compare_terms(pt[0],pt[2]);
Int cmp = _YAP_compare_terms(pt[0],pt[2]);
if (cmp > 0) {
/* swap */
CELL t = pt[2];
@ -354,7 +354,7 @@ p_sort(void)
if (size < 0)
return(FALSE);
if (size < 2)
return(unify(ARG1, ARG2));
return(_YAP_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */
/* make sure no one writes on our temp data structure */
H += size*2;
@ -364,7 +364,7 @@ p_sort(void)
H = pt+size*2;
adjust_vector(pt, size);
out = AbsPair(pt);
return(unify(out, ARG2));
return(_YAP_unify(out, ARG2));
}
static Int
@ -379,14 +379,14 @@ p_msort(void)
if (size < 0)
return(FALSE);
if (size < 2)
return(unify(ARG1, ARG2));
return(_YAP_unify(ARG1, ARG2));
pt = H; /* because of possible garbage collection */
/* reserve the necessary space */
H += size*2;
simple_mergesort(pt, size, M_EVEN);
adjust_vector(pt, size);
out = AbsPair(pt);
return(unify(out, ARG2));
return(_YAP_unify(out, ARG2));
}
static Int
@ -401,21 +401,21 @@ p_ksort(void)
if (size < 0)
return(FALSE);
if (size < 2)
return(unify(ARG1, ARG2));
return(_YAP_unify(ARG1, ARG2));
/* reserve the necessary space */
pt = H; /* because of possible garbage collection */
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);
adjust_vector(pt, size);
out = AbsPair(pt);
return(unify(out, ARG2));
return(_YAP_unify(out, ARG2));
}
void
InitSortPreds(void)
_YAP_InitSortPreds(void)
{
InitCPred("$sort", 2, p_sort, 0);
InitCPred("$msort", 2, p_msort, 0);
InitCPred("$keysort", 2, p_ksort, 0);
_YAP_InitCPred("$sort", 2, p_sort, 0);
_YAP_InitCPred("$msort", 2, p_msort, 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(void send_tracer_message, (char *, char *, Int, char *, CELL *));
int do_low_level_trace = FALSE;
static int do_trace_primitives = TRUE;
static int
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
@ -41,35 +40,35 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
{
if (name == NULL) {
#ifdef YAPOR
YP_fprintf(YP_stderr, "(%d)%s", worker_id, start);
fprintf(_YAP_stderr, "(%d)%s", worker_id, start);
#else
YP_fprintf(YP_stderr, "%s", start);
fprintf(_YAP_stderr, "%s", start);
#endif
} else {
int i;
if (arity) {
YP_fprintf(YP_stderr, "%s %s:%s(", start, mname, name);
fprintf(_YAP_stderr, "%s %s:%s(", start, mname, name);
} 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++) {
if (i > 0) YP_fprintf(YP_stderr, ",");
if (i > 0) fprintf(_YAP_stderr, ",");
#if DEBUG
#if COROUTINING
Portray_delays = TRUE;
_YAP_Portray_delays = TRUE;
#endif
#endif
plwrite(args[i], TracePutchar, Handle_vars_f);
_YAP_plwrite(args[i], TracePutchar, Handle_vars_f);
#if DEBUG
#if COROUTINING
Portray_delays = FALSE;
_YAP_Portray_delays = FALSE;
#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__)
@ -82,7 +81,7 @@ unsigned long vsc_count;
static int
check_trail_consistency(void) {
tr_fr_ptr ptr = TR;
while (ptr > (CELL *)TrailBase) {
while (ptr > (CELL *)_YAP_TrailBase) {
ptr = --ptr;
if (!IsVarTerm(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 (gc_calls < 1) return; */
#if defined(__GNUC__)
YP_fprintf(YP_stderr,"%llu ", vsc_count);
fprintf(_YAP_stderr,"%llu ", vsc_count);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {
@ -131,7 +130,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
switch (port) {
case enter_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
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) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
} else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
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) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
} else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -183,7 +182,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
}
break;
case retry_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
mname = RepAtom(AtomOfTerm(_YAP_Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
@ -200,27 +199,27 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
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)
{
do_low_level_trace = TRUE;
_YAP_do_low_level_trace = TRUE;
return(TRUE);
}
static Int p_stop_low_level_trace(void)
{
do_low_level_trace = FALSE;
_YAP_do_low_level_trace = FALSE;
do_trace_primitives = TRUE;
return(TRUE);
}
void
InitLowLevelTrace(void)
_YAP_InitLowLevelTrace(void)
{
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("start_low_level_trace", 0, p_start_low_level_trace, SafePredFlag);
_YAP_InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag);
}
#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 p_subsumes, (void));
STATIC_PROTO(int p_grab_tokens, (void));
/* int PlGetchar(Int *); */
#endif
#ifdef MACYAP
STATIC_PROTO(typedef int, (*SignalProc) ());
@ -140,14 +139,14 @@ Term T1, T2;
Term t2 = Deref(T2);
if (IsVarTerm(t1)) { /* Testing for variables should be done first */
if (IsVarTerm(t2) || IsPrimitiveTerm(t2))
return (unify(T1, t2));
return (_YAP_unify(T1, t2));
if (occurs_check(t1, t2))
return (unify(T1, t2));
return (_YAP_unify(T1, t2));
return (FALSE);
}
if (IsVarTerm(t2)) {
if (occurs_check(t2, t1))
return (unify(T2, t1));
return (_YAP_unify(T2, t1));
return (FALSE);
}
if (IsPrimitiveTerm(t1)) {
@ -221,10 +220,10 @@ p_counter()
return (FALSE);
a = AtomOfTerm(T1);
if (IsVarTerm(T2)) {
TCount = GetValue(a);
TCount = _YAP_GetValue(a);
if (!IsIntTerm(TCount))
return (FALSE);
unify_constant(ARG2, TCount); /* always succeeds */
_YAP_unify_constant(ARG2, TCount); /* always succeeds */
val = IntOfTerm(TCount);
} else {
if (!IsIntTerm(T2))
@ -233,8 +232,8 @@ p_counter()
}
val++;
/* The atom will now take the incremented value */
PutValue(a, TNext = MkIntTerm(val));
return (unify_constant(ARG3, TNext));
_YAP_PutValue(a, TNext = MkIntTerm(val));
return (_YAP_unify_constant(ARG3, TNext));
}
/*
@ -273,7 +272,7 @@ p_iconcat()
while (L0 = *--Tkp)
L1 = MkPairTerm(L0, L1);
T2 = L1;
return (unify(T2, ARG3));
return (_YAP_unify(T2, ARG3));
}
#endif /* COMMENT */
@ -296,7 +295,7 @@ p_iconcat()
*Tkp++ = Deref(ARG2);
T2 = *H;
H = Tkp;
return (unify(T2, ARG3));
return (_YAP_unify(T2, ARG3));
}
#endif /* USERPREDS */
@ -334,7 +333,7 @@ p_clean() /* predicate clean for ets */
if ((*pt++ = *ntp++) == MkAtomTerm(AtomDollarUndef))
pt -= 2;
H = pt;
return (unify(tn, ARG2));
return (_YAP_unify(tn, ARG2));
}
#endif
for (i = 1; i <= arity; ++i) {
@ -342,8 +341,8 @@ p_clean() /* predicate clean for ets */
t = MkVarTerm();
Args[i - 1] = t;
}
t = MkApplTerm(FunctorOfTerm(t1), arity, Args);
return (unify(ARG2, t));
t = _YAP_MkApplTerm(FunctorOfTerm(t1), arity, Args);
return (_YAP_unify(ARG2, t));
}
static Term *subs_table;
@ -365,7 +364,7 @@ Term T1, T2;
if (subs_table[i] == T2)
return (FALSE);
if (T2 < T1) { /* T1 gets instantiated with T2 */
unify(T1, T2);
_YAP_unify(T1, T2);
for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T1) {
subs_table[i] = T2;
@ -375,7 +374,7 @@ Term T1, T2;
return (TRUE);
}
/* T2 gets instantiated with T1 */
unify(T1, T2);
_YAP_unify(T1, T2);
for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T1)
return (TRUE);
@ -386,7 +385,7 @@ Term T1, T2;
for (i = 0; i < subs_entries; ++i)
if (subs_table[i] == T2)
return (FALSE);
return (unify(T1, T2));
return (_YAP_unify(T1, T2));
}
if (IsPrimitiveTerm(T1)) {
if (IsFloatTerm(T1))
@ -507,7 +506,7 @@ p_namelength()
}
if (IsAtomTerm(t)) {
Term tf = MkIntTerm(strlen(RepAtom(AtomOfTerm(t))->StrOfAE));
return (unify_constant(ARG2, tf));
return (_YAP_unify_constant(ARG2, tf));
} else if (IsIntTerm(t)) {
register int i = 1, k = IntOfTerm(t);
if (k < 0)
@ -515,7 +514,7 @@ p_namelength()
while (k > 10)
++i, k /= 10;
tf = MkIntTerm(i);
return (unify_constant(ARG2, tf));
return (_YAP_unify_constant(ARG2, tf));
} else
return (FALSE);
}
@ -528,7 +527,7 @@ p_getpid()
#else
Term t = MkIntTerm(1);
#endif
return (unify_constant(ARG1, t));
return (_YAP_unify_constant(ARG1, t));
}
static int
@ -537,7 +536,7 @@ p_exit()
register Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsIntTerm(t))
return (FALSE);
exit_yap((int) IntOfTerm(t));
_YAP_exit((int) IntOfTerm(t));
return(FALSE);
}
@ -558,7 +557,7 @@ p_setcounter()
{
register Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsIntTerm(t)) {
return (unify_constant(ARG1, MkIntTerm(current_pos)));
return (_YAP_unify_constant(ARG1, MkIntTerm(current_pos)));
} else {
current_pos = IntOfTerm(t);
return (TRUE);
@ -597,34 +596,34 @@ p_grab_tokens()
Functor IdFunctor, VarFunctor;
char ch, IdChars[255], *chp;
IdAtom = LookupAtom("id");
IdFunctor = MkFunctor(IdAtom, 1);
VarAtom = LookupAtom("var");
VarFunctor = MkFunctor(VarAtom, 1);
IdAtom = _YAP_LookupAtom("id");
IdFunctor = _YAP_MkFunctor(IdAtom, 1);
VarAtom = _YAP_LookupAtom("var");
VarFunctor = _YAP_MkFunctor(VarAtom, 1);
p0 = p;
ch = PlGetchar();
ch = _YAP_PlGetchar();
while (1) {
while (ch <= ' ' && ch != EOF)
ch = PlGetchar();
ch = _YAP_PlGetchar();
if (ch == '.' || ch == EOF)
break;
if (ch == '%') {
while ((ch = PlGetchar()) != 10);
ch = PlGetchar();
while ((ch = _YAP_PlGetchar()) != 10);
ch = _YAP_PlGetchar();
continue;
}
if (ch == '\'') {
chp = IdChars;
while (1) {
ch = PlGetchar();
ch = _YAP_PlGetchar();
if (ch == '\'')
break;
*chp++ = ch;
}
*chp = 0;
t = MkAtomTerm(LookupAtom(IdChars));
*p-- = MkApplTerm(IdFunctor, 1, &t);
ch = PlGetchar();
t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = _YAP_MkApplTerm(IdFunctor, 1, &t);
ch = _YAP_PlGetchar();
continue;
}
@ -632,40 +631,40 @@ p_grab_tokens()
chp = IdChars;
*chp++ = ch;
while (1) {
ch = PlGetchar();
ch = _YAP_PlGetchar();
if (!idchar(ch))
break;
*chp++ = ch;
}
*chp = 0;
t = MkAtomTerm(LookupAtom(IdChars));
*p-- = MkApplTerm(VarFunctor, 1, &t);
t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = _YAP_MkApplTerm(VarFunctor, 1, &t);
continue;
}
if (idstarter(ch)) {
chp = IdChars;
*chp++ = ch;
while (1) {
ch = PlGetchar();
ch = _YAP_PlGetchar();
if (!idchar(ch))
break;
*chp++ = ch;
}
*chp = 0;
t = MkAtomTerm(LookupAtom(IdChars));
*p-- = MkApplTerm(IdFunctor, 1, &t);
t = MkAtomTerm(_YAP_LookupAtom(IdChars));
*p-- = _YAP_MkApplTerm(IdFunctor, 1, &t);
continue;
}
IdChars[0] = ch;
IdChars[1] = 0;
*p-- = MkAtomTerm(LookupAtom(IdChars));
ch = PlGetchar();
*p-- = MkAtomTerm(_YAP_LookupAtom(IdChars));
ch = _YAP_PlGetchar();
}
t = MkAtomTerm(AtomNil);
while (p != p0) {
t = MkPairTerm(*++p, t);
}
return (unify(ARG1, t));
return (_YAP_unify(ARG1, t));
}
#endif /* EUROTRA */
@ -688,8 +687,8 @@ p_softfunctor()
return (FALSE);
a = AtomOfTerm(t1);
WRITE_LOCK(RepAtom(a)->ARWLock);
if ((p0 = GetAProp(a, SFProperty)) == NIL) {
pe = (SFEntry *) AllocAtomSpace(sizeof(*pe));
if ((p0 = _YAP_GetAProp(a, SFProperty)) == NIL) {
pe = (SFEntry *) _YAP_AllocAtomSpace(sizeof(*pe));
pe->NextOfPE = RepAtom(a)->PropsOfAE;
pe->KindOfPE = SFProperty;
RepAtom(a)->PropsOfAE = AbsSFProp(pe);
@ -713,34 +712,34 @@ p_matching_distances(void)
*/
void
InitUserCPreds(void)
_YAP_InitUserCPreds(void)
{
#ifdef XINTERFACE
InitXPreds();
_YAP_InitXPreds();
#endif
#ifdef EUROTRA
InitCPred("clean", 2, p_clean, SafePredFlag|SyncPredFlag);
InitCPred("name_length", 2, p_namelength, SafePredFlag|SyncPredFlag);
InitCPred("get_pid", 1, p_getpid, SafePredFlag);
InitCPred("exit", 1, p_exit, SafePredFlag|SyncPredFlag);
InitCPred("incr_counter", 1, p_incrcounter, SafePredFlag|SyncPredFlag);
InitCPred("set_counter", 1, p_setcounter, SafePredFlag|SyncPredFlag);
InitCPred("trap_signal", 0, p_trapsignal, SafePredFlag|SyncPredFlag);
InitCPred("mark2_grab_tokens", 1, p_grab_tokens, SafePredFlag|SyncPredFlag);
InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
_YAP_InitCPred("clean", 2, p_clean, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("name_length", 2, p_namelength, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("get_pid", 1, p_getpid, SafePredFlag);
_YAP_InitCPred("exit", 1, p_exit, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("incr_counter", 1, p_incrcounter, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("set_counter", 1, p_setcounter, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("trap_signal", 0, p_trapsignal, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("mark2_grab_tokens", 1, p_grab_tokens, SafePredFlag|SyncPredFlag);
_YAP_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
#endif
#ifdef SFUNC
InitCPred("sparse_functor", 2, p_softfunctor, SafePredFlag);
_YAP_InitCPred("sparse_functor", 2, p_softfunctor, SafePredFlag);
#endif /* SFUNC */
/* InitCPred("match_distances", 3, p_matching_distances, SafePredFlag); */
/* InitCPred("unify",2,p_unify,SafePredFlag); */
/* InitCPred("occurs_check",2,p_occurs_check,SafePredFlag); */
/* InitCPred("counter",3,p_counter,SafePredFlag); */
/* InitCPred("iconcat",3,p_iconcat,SafePredFlag); */
/* _YAP_InitCPred("match_distances", 3, p_matching_distances, SafePredFlag); */
/* _YAP_InitCPred("unify",2,p_unify,SafePredFlag); */
/* _YAP_InitCPred("occurs_check",2,p_occurs_check,SafePredFlag); */
/* _YAP_InitCPred("counter",3,p_counter,SafePredFlag); */
/* _YAP_InitCPred("iconcat",3,p_iconcat,SafePredFlag); */
}
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++;
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) {
if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -136,7 +136,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) {
if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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;
} else {
if (dvars == NULL) {
dvars = (CELL *)ReadTimedVar(DelayedVars);
dvars = (CELL *)_YAP_ReadTimedVar(DelayedVars);
}
bp[0] = to_visit;
CurTR = TR;
@ -292,7 +292,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
return(-2);
}
Term
static Term
CopyTerm(Term inp) {
Term t = Deref(inp);
@ -309,15 +309,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) {
ARG1 = t;
if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_attached;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -345,15 +345,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) {
ARG1 = t;
if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -380,15 +380,15 @@ CopyTerm(Term inp) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {
ARG1 = t;
if (res == -1) {
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -400,10 +400,15 @@ CopyTerm(Term inp) {
}
}
Term
_YAP_CopyTerm(Term inp) {
return CopyTerm(inp);
}
static Int
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)
@ -434,7 +439,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
*ptf = AbsPair(H);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) {
if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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;
#else
if (pt0 < pt0_end) {
if (to_visit + 3 >= (CELL **)GlobalBase) {
if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
to_visit[0] = pt0;
@ -482,7 +487,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 4 >= (CELL **)GlobalBase) {
if (to_visit + 4 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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);
to_visit += 4;
#else
if (to_visit + 3 >= (CELL **)GlobalBase) {
if (to_visit + 3 >= (CELL **)_YAP_GlobalBase) {
goto heap_overflow;
}
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);
if (res) {
if (res == -1) { /* handle overflow */
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -645,15 +650,15 @@ CopyTermNoDelays(Term inp) {
res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0);
if (res) {
if (res == -1) {
if (!gc(2, ENV, P)) {
Error(OUT_OF_STACK_ERROR, TermNil, ErrorMessage);
if (!_YAP_gc(2, ENV, P)) {
_YAP_Error(OUT_OF_STACK_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!growheap(FALSE)) {
Error(SYSTEM_ERROR, TermNil, ErrorMessage);
if (!_YAP_growheap(FALSE)) {
_YAP_Error(SYSTEM_ERROR, TermNil, _YAP_ErrorMessage);
return(FALSE);
}
t = Deref(ARG1);
@ -667,7 +672,7 @@ CopyTermNoDelays(Term inp) {
static Int
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);
if (IsVarTerm(t2)) {
RESET_VARIABLE(H-1);
unify((CELL)(H-1),ARG2);
_YAP_unify((CELL)(H-1),ARG2);
} else {
H[-1] = t2; /* don't need to trail */
}
@ -789,8 +794,8 @@ p_variables_in_term(void) /* variables in term t */
H += 2;
RESET_VARIABLE(H-2);
RESET_VARIABLE(H-1);
unify((CELL)(H-2),ARG1);
unify((CELL)(H-1),ARG2);
_YAP_unify((CELL)(H-2),ARG1);
_YAP_unify((CELL)(H-1),ARG2);
} else if (IsPrimitiveTerm(t))
out = ARG2;
else if (IsPairTerm(t)) {
@ -803,7 +808,7 @@ p_variables_in_term(void) /* variables in term t */
RepAppl(t)+
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)
@ -906,7 +911,7 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
if (H != InitialH) {
/* close the list */
RESET_VARIABLE(H-1);
unify((CELL)(H-1),ARG2);
_YAP_unify((CELL)(H-1),ARG2);
return(output);
} else {
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),
RepAppl(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)
@ -1246,24 +1251,24 @@ GvNTermHash(void)
if (IsVarTerm(t2)) {
Error(INSTANTIATION_ERROR,t2,"term_hash/4");
_YAP_Error(INSTANTIATION_ERROR,t2,"term_hash/4");
return(FALSE);
}
if (!IsIntegerTerm(t2)) {
Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
_YAP_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4");
return(FALSE);
}
depth = IntegerOfTerm(t2);
if (depth == 0) {
if (IsVarTerm(t1)) return(TRUE);
return(unify(ARG4,MkIntTerm(0)));
return(_YAP_unify(ARG4,MkIntTerm(0)));
}
if (IsVarTerm(t3)) {
Error(INSTANTIATION_ERROR,t3,"term_hash/4");
_YAP_Error(INSTANTIATION_ERROR,t3,"term_hash/4");
return(FALSE);
}
if (!IsIntegerTerm(t3)) {
Error(TYPE_ERROR_INTEGER,t3,"term_hash/4");
_YAP_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4");
return(FALSE);
}
size = IntegerOfTerm(t3);
@ -1278,7 +1283,7 @@ GvNTermHash(void)
i3 = GvNht[2];
i2 ^= i3; i1 ^= i2; i1 = (((i3 << 7) + i2) << 7) + i1;
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
@ -1680,30 +1685,30 @@ camacho_dum(void)
/* build output list */
t1 = MkAtomTerm(LookupAtom("[]"));
t1 = MkAtomTerm(_YAP_LookupAtom("[]"));
t2 = MkPairTerm(MkIntegerTerm(max), t1);
return(unify(t2, ARG1));
return(_YAP_unify(t2, ARG1));
}
#endif /* DEBUG */
void InitUtilCPreds(void)
void _YAP_InitUtilCPreds(void)
{
InitCPred("copy_term", 2, p_copy_term, 0);
InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
InitCPred("ground", 1, p_ground, SafePredFlag);
InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag);
InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag);
InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
InitCPred("variant", 2, p_variant, SafePredFlag);
InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
_YAP_InitCPred("copy_term", 2, p_copy_term, 0);
_YAP_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
_YAP_InitCPred("ground", 1, p_ground, SafePredFlag);
_YAP_InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag);
_YAP_InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
_YAP_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag);
_YAP_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
_YAP_InitCPred("variant", 2, p_variant, SafePredFlag);
_YAP_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
#ifdef DEBUG
InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
InitCPred("dum", 1, camacho_dum, SafePredFlag);
_YAP_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
_YAP_InitCPred("dum", 1, camacho_dum, SafePredFlag);
#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;
#if DEBUG
#if COROUTINING
int Portray_delays = FALSE;
#endif
#endif
#define wrputc(X) ((*writech)(c_output_stream,X)) /* writes a character */
#define wrputc(X) ((*writech)(_YAP_c_output_stream,X)) /* writes a character */
static void
wrputn(Int n) /* writes an integer */
@ -160,24 +154,24 @@ legalAtom(char *s) /* Is this a legal atom ? */
register int ch = *s;
if (ch == '\0')
return(FALSE);
if (chtype[ch] != LC) {
if (_YAP_chtype[ch] != LC) {
if (ch == '[')
return (*++s == ']' && !(*++s));
else if (ch == '{')
return (*++s == '}' && !(*++s));
else if (chtype[ch] == SL)
else if (_YAP_chtype[ch] == SL)
return (!*++s);
else if ((ch == ',' || ch == '.') && !s[1])
return (FALSE);
else
while (ch) {
if (chtype[ch] != SY) return (FALSE);
if (_YAP_chtype[ch] != SY) return (FALSE);
ch = *++s;
}
return (TRUE);
} else
while ((ch = *++s) != 0)
if (chtype[ch] > NU)
if (_YAP_chtype[ch] > NU)
return (FALSE);
return (TRUE);
}
@ -185,25 +179,25 @@ legalAtom(char *s) /* Is this a legal atom ? */
static int LeftOpToProtect(Atom at, int p)
{
int op, rp;
Prop opinfo = GetAProp(at, OpProperty);
return(opinfo && IsPrefixOp(opinfo, &op, &rp) );
Prop opinfo = _YAP_GetAProp(at, OpProperty);
return(opinfo && _YAP_IsPrefixOp(opinfo, &op, &rp) );
}
static int RightOpToProtect(Atom at, int p)
{
int op, lp;
Prop opinfo = GetAProp(at, OpProperty);
return(opinfo && IsPosfixOp(opinfo, &op, &lp) );
Prop opinfo = _YAP_GetAProp(at, OpProperty);
return(opinfo && _YAP_IsPosfixOp(opinfo, &op, &lp) );
}
static wtype
AtomIsSymbols(char *s) /* Is this atom just formed by symbols ? */
{
int ch;
if (chtype[(int)s[0]] == SL && s[1] == '\0')
if (_YAP_chtype[(int)s[0]] == SL && s[1] == '\0')
return(separator);
while ((ch = *s++) != '\0') {
if (chtype[ch] != SY)
if (_YAP_chtype[ch] != SY)
return(alphanum);
}
return(symbol);
@ -218,7 +212,7 @@ putAtom(Atom atom) /* writes an atom */
/* #define CRYPT_FOR_STEVE 1*/
#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];
sprintf(s,"x%x", (CELL)s);
wrputs(s);
@ -308,10 +302,10 @@ write_var(CELL *t)
if (CellPtr(t) < H0) {
#if COROUTINING
#if DEBUG
if (Portray_delays) {
if (_YAP_Portray_delays) {
exts ext = ExtFromCell(t);
Portray_delays = FALSE;
_YAP_Portray_delays = FALSE;
if (ext == susp_ext) {
wrputs("$DL(");
write_var(t);
@ -352,13 +346,13 @@ write_var(CELL *t)
}
wrputc(')');
}
Portray_delays = TRUE;
_YAP_Portray_delays = TRUE;
return;
}
#endif
#endif
wrputc('D');
wrputn(((Int) (t- CellPtr(GlobalBase))));
wrputn(((Int) (t- CellPtr(_YAP_GlobalBase))));
} else {
wrputn(((Int) (t- H0)));
}
@ -371,7 +365,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
{
if (*max_depth != 0 && depth > *max_depth) {
putAtom(LookupAtom("..."));
putAtom(_YAP_LookupAtom("..."));
return;
}
if (EX != 0)
@ -392,9 +386,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
#ifdef USE_GMP
} else if (IsBigIntTerm(t)) {
char *s = (char *)TR;
while (s+2+mpz_sizeinbase(BigIntOfTerm(t), 10) > (char *)TrailTop)
growtrail(64*1024);
mpz_get_str(s, 10, BigIntOfTerm(t));
while (s+2+mpz_sizeinbase(_YAP_BigIntOfTerm(t), 10) > (char *)_YAP_TrailTop)
_YAP_growtrail(64*1024);
mpz_get_str(s, 10, _YAP_BigIntOfTerm(t));
wrputs(s);
#endif
} else if (IsPairTerm(t)) {
@ -407,17 +401,17 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
long sl = 0;
targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil));
_YAP_PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX;
/* *--ASP = MkIntTerm(0); */
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);
_YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE;
Use_portray = TRUE;
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
if (_YAP_GetValue(AtomPortray) == MkAtomTerm(AtomTrue))
return;
}
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;
if (*max_list && eldepth > *max_list) {
putAtom(LookupAtom("..."));
putAtom(_YAP_LookupAtom("..."));
wrputc(']');
lastw = separator;
return;
@ -471,7 +465,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
Arity = ArityOfFunctor(functor);
atom = NameOfFunctor(functor);
opinfo = GetAProp(atom, OpProperty);
opinfo = _YAP_GetAProp(atom, OpProperty);
#ifdef SFUNC
if (Arity == SFArity) {
int argno = 1;
@ -514,19 +508,19 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
long sl = 0;
targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil));
_YAP_PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX;
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);
_YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE;
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
if (_YAP_GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
return;
}
if (!Ignore_ops &&
Arity == 1 && opinfo && IsPrefixOp(opinfo, &op,
Arity == 1 && opinfo && _YAP_IsPrefixOp(opinfo, &op,
&rp)
#ifdef DO_NOT_WRITE_PLUS_AND_MINUS_AS_PREFIX
&&
@ -563,7 +557,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator;
}
} else if (!Ignore_ops &&
Arity == 1 && opinfo && IsPosfixOp(opinfo, &op, &lp)) {
Arity == 1 && opinfo && _YAP_IsPosfixOp(opinfo, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
long sl = 0;
int bracket_left =
@ -600,7 +594,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator;
}
} else if (!Ignore_ops &&
Arity == 2 && opinfo && IsInfixOp(opinfo, &op, &lp,
Arity == 2 && opinfo && _YAP_IsInfixOp(opinfo, &op, &lp,
&rp) ) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
@ -757,7 +751,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
}
void
plwrite(Term t, int (*mywrite) (int, int), int flags)
_YAP_plwrite(Term t, int (*mywrite) (int, int), int flags)
/* term to be written */
/* consumer */
/* write options */

309
C/ypsocks.c
View File

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

2
C/ypstdio.c
View File

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

12
H/Foreign.h
View File

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

72
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* 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 */
@ -121,8 +121,11 @@ typedef struct various_codes {
struct pred_entry *creep_code;
struct pred_entry *undef_code;
struct pred_entry *spy_code;
int profiling;
int call_counting;
int system_profiling;
int system_call_counting;
int compiler_optimizer_on;
int compiler_compile_mode;
struct pred_entry *compiler_current_pred;
AtomHashEntry invisiblechain;
OPCODE dummycode;
Int maxdepth, maxlist;
@ -293,14 +296,40 @@ typedef struct various_codes {
struct pred_entry *pred_handle_throw;
struct array_entry *dyn_array_list;
struct DB_STRUCT *db_erased_marker;
struct stream_desc *yap_streams;
#ifdef DEBUG
int debugger_output_msg;
#endif
UInt n_of_file_aliases;
UInt sz_of_file_aliases;
struct AliasDescS * file_aliases;
struct reduction_counters call_counters;
void *foreign_code_loaded;
char *yap_lib_dir;
Agc_hook agc_hook;
void *foreign_code_loaded;
ADDR foreign_code_base;
ADDR foreign_code_top;
ADDR foreign_code_max;
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)
struct global_data global;
struct local_data remote[MAX_WORKERS];
@ -312,7 +341,7 @@ typedef struct various_codes {
#define HeapUsed heap_regs->heap_used
#define HeapMax heap_regs->heap_max
#define HeapTop heap_regs->heap_top
#define HeapTop heap_regs->heap_top
#ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT heap_regs->seq_def
#define GETWORK (&(heap_regs->getworkcode ))
@ -339,8 +368,8 @@ typedef struct various_codes {
#if USE_THREADED_CODE
#define OP_RTABLE heap_regs->op_rtable
#endif
#define PROFILING heap_regs->profiling
#define CALL_COUNTING heap_regs->call_counting
#define PROFILING heap_regs->system_profiling
#define CALL_COUNTING heap_regs->system_call_counting
#define UPDATE_MODE heap_regs->update_mode
#define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_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 CharConversionTable heap_regs->char_conversion_table
#define CharConversionTable2 heap_regs->char_conversion_table2
#define NUMBER_OF_CPREDS heap_regs->number_of_cpreds
#define NUMBER_OF_CMPFUNCS heap_regs->number_of_cmpfuncs
#define NumberOfCPreds heap_regs->number_of_cpreds
#define NumberOfCmpFuncs heap_regs->number_of_cmpfuncs
#define ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module
@ -491,6 +520,8 @@ typedef struct various_codes {
#define PredHandleThrow heap_regs->pred_handle_throw
#define DynArrayList heap_regs->dyn_array_list
#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 SzOfFileAliases heap_regs->sz_of_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 PredEntriesCounterOn heap_regs->call_counters.reductions_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 AGCHook heap_regs->agc_hook
#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 SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime

283
H/Regs.h
View File

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

330
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* 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 */
@ -25,29 +25,24 @@ typedef Int (*CmpPredicate)(Term, Term);
/* absmi.c */
Int STD_PROTO(absmi,(int));
Int STD_PROTO(_YAP_absmi,(int));
/* adtdefs.c */
Term STD_PROTO(ArrayToList,(Term *,int));
int STD_PROTO(GetName,(char *,UInt,Term));
Term STD_PROTO(GetValue,(Atom));
Atom STD_PROTO(LookupAtom,(char *));
Atom STD_PROTO(FullLookupAtom,(char *));
void STD_PROTO(LookupAtomWithAddress,(char *,AtomEntry *));
Term STD_PROTO(MkApplTerm,(Functor,unsigned int,Term *));
Term STD_PROTO(MkNewApplTerm,(Functor,unsigned int));
Prop STD_PROTO(NewPredPropByFunctor,(struct FunctorEntryStruct *, SMALLUNSGN));
Prop STD_PROTO(NewPredPropByAtom,(struct AtomEntryStruct *, SMALLUNSGN));
Functor STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int));
Functor STD_PROTO(MkFunctor,(Atom,unsigned int));
void STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
Term STD_PROTO(MkPairTerm,(Term,Term));
Term STD_PROTO(MkNewPairTerm,(void));
void STD_PROTO(PutValue,(Atom,Term));
void STD_PROTO(ReleaseAtom,(Atom));
Term STD_PROTO(StringToList,(char *));
Term STD_PROTO(StringToListOfAtoms,(char *));
Term STD_PROTO(_YAP_ArrayToList,(Term *,int));
int STD_PROTO(_YAP_GetName,(char *,UInt,Term));
Term STD_PROTO(_YAP_GetValue,(Atom));
Atom STD_PROTO(_YAP_LookupAtom,(char *));
Atom STD_PROTO(_YAP_FullLookupAtom,(char *));
void STD_PROTO(_YAP_LookupAtomWithAddress,(char *,AtomEntry *));
Prop STD_PROTO(_YAP_NewPredPropByFunctor,(struct FunctorEntryStruct *, SMALLUNSGN));
Prop STD_PROTO(_YAP_NewPredPropByAtom,(struct AtomEntryStruct *, SMALLUNSGN));
Functor STD_PROTO(_YAP_UnlockedMkFunctor,(AtomEntry *,unsigned int));
Functor STD_PROTO(_YAP_MkFunctor,(Atom,unsigned int));
void STD_PROTO(_YAP_MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
void STD_PROTO(_YAP_PutValue,(Atom,Term));
void STD_PROTO(_YAP_ReleaseAtom,(Atom));
Term STD_PROTO(_YAP_StringToList,(char *));
Term STD_PROTO(_YAP_StringToListOfAtoms,(char *));
long STD_PROTO(_YAP_InitSlot,(Term));
long STD_PROTO(_YAP_NewSlots,(int));
@ -63,255 +58,246 @@ Term STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
CELL STD_PROTO(*ArgsOfSFTerm,(Term));
#endif
SMALLUNSGN STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredPropByAtom,(Atom, SMALLUNSGN));
Prop STD_PROTO(GetPredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN));
Prop STD_PROTO(GetExpProp,(Atom,unsigned int));
Prop STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int));
Term STD_PROTO(Module_Name, (CODEADDR));
Prop STD_PROTO(_YAP_GetPredPropByAtom,(Atom, SMALLUNSGN));
Prop STD_PROTO(_YAP_GetPredPropByFunc,(Functor, SMALLUNSGN));
Prop STD_PROTO(_YAP_GetPredPropHavingLock,(Atom,unsigned int,SMALLUNSGN));
Prop STD_PROTO(_YAP_GetExpProp,(Atom,unsigned int));
Prop STD_PROTO(_YAP_GetExpPropHavingLock,(AtomEntry *,unsigned int));
/* agc.c */
void STD_PROTO(atom_gc, (void));
void STD_PROTO(init_agc, (void));
void STD_PROTO(_YAP_atom_gc, (void));
void STD_PROTO(_YAP_init_agc, (void));
/* alloc.c */
int STD_PROTO(SizeOfBlock,(CODEADDR));
void STD_PROTO(FreeCodeSpace,(char *));
ADDR STD_PROTO(PreAllocCodeSpace, (void));
char *STD_PROTO(AllocAtomSpace,(unsigned int));
char STD_PROTO(*AllocScannerMemory,(unsigned int));
char STD_PROTO(*AllocCodeSpace,(unsigned int));
ADDR STD_PROTO(AllocFromForeignArea,(Int));
int STD_PROTO(ExtendWorkSpace,(Int));
void STD_PROTO(FreeAtomSpace,(char *));
int STD_PROTO(FreeWorkSpace, (void));
void STD_PROTO(InitMemory,(int,int,int));
MALLOC_T STD_PROTO(InitWorkSpace, (Int));
int STD_PROTO(_YAP_SizeOfBlock,(CODEADDR));
void STD_PROTO(_YAP_FreeCodeSpace,(char *));
char *STD_PROTO(_YAP_AllocAtomSpace,(unsigned int));
char *STD_PROTO(_YAP_AllocCodeSpace,(unsigned int));
ADDR STD_PROTO(_YAP_AllocFromForeignArea,(Int));
int STD_PROTO(_YAP_ExtendWorkSpace,(Int));
void STD_PROTO(_YAP_FreeAtomSpace,(char *));
int STD_PROTO(_YAP_FreeWorkSpace, (void));
void STD_PROTO(_YAP_InitMemory,(int,int,int));
/* amasm.c */
OPCODE STD_PROTO(opcode,(op_numbers));
CODEADDR STD_PROTO(assemble,(int));
OPCODE STD_PROTO(_YAP_opcode,(op_numbers));
/* analyst.c */
#ifdef ANALYST
void STD_PROTO(InitAnalystPreds,(void));
void STD_PROTO(_YAP_InitAnalystPreds,(void));
#endif /* ANALYST */
/* arrays.c */
void STD_PROTO(InitArrayPreds,(void));
CELL *STD_PROTO(ClearNamedArray,(CELL *));
void STD_PROTO(_YAP_InitArrayPreds,(void));
/* attvar.c */
Term STD_PROTO(CurrentAttVars,(void));
void STD_PROTO(InitAttVarPreds,(void));
Term STD_PROTO(_YAP_CurrentAttVars,(void));
void STD_PROTO(_YAP_InitAttVarPreds,(void));
/* bb.c */
void STD_PROTO(InitBBPreds,(void));
void STD_PROTO(_YAP_InitBBPreds,(void));
/* bignum.c */
void STD_PROTO(InitBigNums,(void));
void STD_PROTO(_YAP_InitBigNums,(void));
/* c_interface.c */
Int STD_PROTO(YAP_Execute,(struct pred_entry *, CPredicate));
/* cdmgr.c */
Term STD_PROTO(all_calls,(void));
void STD_PROTO(mark_as_fast,(Term));
void STD_PROTO(IPred,(CODEADDR sp));
Int STD_PROTO(PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *));
void STD_PROTO(InitCdMgr,(void));
void STD_PROTO(_YAP_addclause,(Term,CODEADDR,int,int));
Term STD_PROTO(_YAP_all_calls,(void));
Atom STD_PROTO(_YAP_ConsultingFile,(void));
Int STD_PROTO(_YAP_PredForCode,(CODEADDR, Atom *, Int *, SMALLUNSGN *));
void STD_PROTO(_YAP_InitCdMgr,(void));
#if EMACS
int STD_PROTO(where_new_clause, (Prop, int));
#endif
void STD_PROTO(init_consult,(int, char *));
void STD_PROTO(end_consult,(void));
void STD_PROTO(_YAP_init_consult,(int, char *));
void STD_PROTO(_YAP_end_consult,(void));
/* cmppreds.c */
int STD_PROTO(compare_terms,(Term,Term));
int STD_PROTO(iequ,(Term,Term));
void STD_PROTO(InitCmpPreds,(void));
int STD_PROTO(_YAP_compare_terms,(Term,Term));
void STD_PROTO(_YAP_InitCmpPreds,(void));
/* compiler.c */
CODEADDR STD_PROTO(cclause,(Term, int, int));
CODEADDR STD_PROTO(_YAP_cclause,(Term, int, int));
/* computils.c */
/* corout.c */
void STD_PROTO(InitCoroutPreds,(void));
void STD_PROTO(_YAP_InitCoroutPreds,(void));
#ifdef COROUTINING
Term STD_PROTO(ListOfWokenGoals,(void));
void STD_PROTO(WakeUp,(CELL *));
void STD_PROTO(mark_all_suspended_goals,(void));
Term STD_PROTO(_YAP_ListOfWokenGoals,(void));
void STD_PROTO(_YAP_WakeUp,(CELL *));
void STD_PROTO(_YAP_mark_all_suspended_goals,(void));
#endif
/* dbase.c */
int STD_PROTO(DBTrailOverflow,(void));
CELL STD_PROTO(EvalMasks,(Term,CELL *));
void STD_PROTO(InitBackDB,(void));
void STD_PROTO(InitDBPreds,(void));
int STD_PROTO(_YAP_DBTrailOverflow,(void));
CELL STD_PROTO(_YAP_EvalMasks,(Term,CELL *));
void STD_PROTO(_YAP_InitBackDB,(void));
void STD_PROTO(_YAP_InitDBPreds,(void));
/* errors.c */
void STD_PROTO(exit_yap,(int));
yamop *STD_PROTO(Error,(yap_error_number,Term,char *msg, ...));
#if DEBUG
void STD_PROTO(bug_location,(yamop *));
#endif
void STD_PROTO(_YAP_exit,(int));
yamop *STD_PROTO(_YAP_Error,(yap_error_number,Term,char *msg, ...));
/* eval.c */
void STD_PROTO(InitEval,(void));
Int STD_PROTO(EvFArt,(Term));
void STD_PROTO(_YAP_InitEval,(void));
/* exec.c */
Term STD_PROTO(ExecuteCallMetaCall,(SMALLUNSGN mod));
void STD_PROTO(InitExecFs,(void));
Int STD_PROTO(JumpToEnv,(Term));
int STD_PROTO(RunTopGoal,(Term));
Int STD_PROTO(execute_goal,(Term, int, SMALLUNSGN));
int STD_PROTO(exec_absmi,(int));
void STD_PROTO(trust_last,(void));
Term STD_PROTO(_YAP_ExecuteCallMetaCall,(SMALLUNSGN mod));
void STD_PROTO(_YAP_InitExecFs,(void));
Int STD_PROTO(_YAP_JumpToEnv,(Term));
int STD_PROTO(_YAP_RunTopGoal,(Term));
Int STD_PROTO(_YAP_execute_goal,(Term, int, SMALLUNSGN));
int STD_PROTO(_YAP_exec_absmi,(int));
void STD_PROTO(_YAP_trust_last,(void));
/* grow.c */
Int STD_PROTO(total_stack_shift_time,(void));
void STD_PROTO(InitGrowPreds, (void));
int STD_PROTO(growheap, (int));
int STD_PROTO(growstack, (long));
int STD_PROTO(growtrail, (long));
int STD_PROTO(growglobal, (CELL **));
Int STD_PROTO(_YAP_total_stack_shift_time,(void));
void STD_PROTO(_YAP_InitGrowPreds, (void));
int STD_PROTO(_YAP_growheap, (int));
int STD_PROTO(_YAP_growstack, (long));
int STD_PROTO(_YAP_growtrail, (long));
int STD_PROTO(_YAP_growglobal, (CELL **));
/* heapgc.c */
Int STD_PROTO(total_gc_time,(void));
void STD_PROTO(init_gc,(void));
int STD_PROTO(is_gc_verbose, (void));
int STD_PROTO(gc, (Int, CELL *, yamop *));
Int STD_PROTO(_YAP_total_gc_time,(void));
void STD_PROTO(_YAP_init_gc,(void));
int STD_PROTO(_YAP_is_gc_verbose, (void));
int STD_PROTO(_YAP_gc, (Int, CELL *, yamop *));
/* init.c */
#ifdef DEBUG
int STD_PROTO(DebugPutc,(int,int));
void STD_PROTO(DebugSetIFile,(char *));
void STD_PROTO(DebugEndline,(void));
int STD_PROTO(DebugGetc,(void));
int STD_PROTO(_YAP_DebugPutc,(int,int));
void STD_PROTO(_YAP_DebugSetIFile,(char *));
void STD_PROTO(_YAP_DebugEndline,(void));
int STD_PROTO(_YAP_DebugGetc,(void));
#endif
int STD_PROTO(IsOpType,(char *));
void STD_PROTO(InitStacks,(int,int,int,int,int,int));
void STD_PROTO(InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int));
void STD_PROTO(InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(InitYaamRegs,(void));
void STD_PROTO(ReInitWallTime, (void));
int STD_PROTO(OpDec,(int,char *,Atom));
int STD_PROTO(_YAP_IsOpType,(char *));
void STD_PROTO(_YAP_InitStacks,(int,int,int,int,int,int));
void STD_PROTO(_YAP_InitCPred,(char *, unsigned long int, CPredicate, int));
void STD_PROTO(_YAP_InitAsmPred,(char *, unsigned long int, int, CPredicate, int));
void STD_PROTO(_YAP_InitCmpPred,(char *, unsigned long int, CmpPredicate, CPredicate, int));
void STD_PROTO(_YAP_InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(_YAP_InitYaamRegs,(void));
void STD_PROTO(_YAP_ReInitWallTime, (void));
int STD_PROTO(_YAP_OpDec,(int,char *,Atom));
/* inlines.c */
void STD_PROTO(_YAP_InitInlines,(void));
/* iopreds.c */
void STD_PROTO(CloseStreams,(int));
void STD_PROTO(InitPlIO,(void));
void STD_PROTO(InitBackIO,(void));
void STD_PROTO(InitIOPreds,(void));
Atom STD_PROTO(YapConsultingFile,(void));
void STD_PROTO(_YAP_InitPlIO,(void));
void STD_PROTO(_YAP_InitBackIO,(void));
void STD_PROTO(_YAP_InitIOPreds,(void));
/* depth_lim.c */
void STD_PROTO(InitItDeepenPreds,(void));
void STD_PROTO(_YAP_InitItDeepenPreds,(void));
/* load_foreign.c */
void STD_PROTO(InitLoadForeign,(void));
void STD_PROTO(_YAP_InitLoadForeign,(void));
/* mavar.c */
void STD_PROTO(InitMaVarCPreds,(void));
Term STD_PROTO(NewTimedVar,(Term));
Term STD_PROTO(NewEmptyTimedVar,(void));
Term STD_PROTO(ReadTimedVar,(Term));
Term STD_PROTO(UpdateTimedVar,(Term, Term));
void STD_PROTO(_YAP_InitMaVarCPreds,(void));
Term STD_PROTO(_YAP_NewTimedVar,(Term));
Term STD_PROTO(_YAP_NewEmptyTimedVar,(void));
Term STD_PROTO(_YAP_ReadTimedVar,(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
/* mpi.c */
void STD_PROTO(InitMPI,(void));
void STD_PROTO(_YAP_InitMPI,(void));
#endif
#if HAVE_MPE
/* mpe.c */
void STD_PROTO(InitMPE,(void));
void STD_PROTO(_YAP_InitMPE,(void));
#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 */
int STD_PROTO(IsPrefixOp,(Prop,int *,int *));
int STD_PROTO(IsInfixOp,(Prop,int *,int *,int *));
int STD_PROTO(IsPosfixOp,(Prop,int *,int *));
Term STD_PROTO(Parse,(void));
int STD_PROTO(_YAP_IsPrefixOp,(Prop,int *,int *));
int STD_PROTO(_YAP_IsInfixOp,(Prop,int *,int *,int *));
int STD_PROTO(_YAP_IsPosfixOp,(Prop,int *,int *));
Term STD_PROTO(_YAP_Parse,(void));
/* save.c */
int STD_PROTO(SavedInfo,(char *,char *,CELL *,CELL *,CELL *));
int STD_PROTO(Restore,(char *, char *));
void STD_PROTO(InitSavePreds,(void));
int STD_PROTO(_YAP_SavedInfo,(char *,char *,CELL *,CELL *,CELL *));
int STD_PROTO(_YAP_Restore,(char *, char *));
void STD_PROTO(_YAP_InitSavePreds,(void));
/* scanner.c */
/* sort.c */
void STD_PROTO(InitSortPreds,(void));
void STD_PROTO(_YAP_InitSortPreds,(void));
/* stdpreds.c */
#ifdef undefined
CELL STD_PROTO(FindWhatCreep,(CELL));
#endif /* undefined */
void STD_PROTO(InitBackCPreds,(void));
void STD_PROTO(InitCPreds,(void));
Int STD_PROTO(p_creep,(void));
void STD_PROTO(_YAP_InitBackCPreds,(void));
void STD_PROTO(_YAP_InitCPreds,(void));
void STD_PROTO(_YAP_show_statistics,(void));
Int STD_PROTO(_YAP_creep,(void));
/* sysbits.c */
void STD_PROTO(set_fpu_exceptions,(int));
Int STD_PROTO(cputime,(void));
Int STD_PROTO(runtime,(void));
Int STD_PROTO(walltime,(void));
int STD_PROTO(dir_separator,(int));
int STD_PROTO(volume_header,(char *));
void STD_PROTO(InitSysPath,(void));
void STD_PROTO(SetTextFile,(char *));
void STD_PROTO(cputime_interval,(Int *,Int *));
void STD_PROTO(walltime_interval,(Int *,Int *));
void STD_PROTO(InitSysbits,(void));
void STD_PROTO(InitSysPreds,(void));
int STD_PROTO(TrueFileName, (char *, char *, int));
int STD_PROTO(ProcessSIGINT,(void));
double STD_PROTO(yap_random, (void));
void STD_PROTO(set_fpu_exceptions, (int));
void STD_PROTO(_YAP_set_fpu_exceptions,(int));
Int STD_PROTO(_YAP_cputime,(void));
Int STD_PROTO(_YAP_walltime,(void));
int STD_PROTO(_YAP_dir_separator,(int));
int STD_PROTO(_YAP_volume_header,(char *));
void STD_PROTO(_YAP_InitSysPath,(void));
#if MAC
void STD_PROTO(_YAP_SetTextFile,(char *));
#endif
void STD_PROTO(_YAP_cputime_interval,(Int *,Int *));
void STD_PROTO(_YAP_walltime_interval,(Int *,Int *));
void STD_PROTO(_YAP_InitSysbits,(void));
void STD_PROTO(_YAP_InitSysPreds,(void));
int STD_PROTO(_YAP_TrueFileName, (char *, char *, int));
int STD_PROTO(_YAP_ProcessSIGINT,(void));
double STD_PROTO(_YAP_random, (void));
/* tracer.c */
#ifdef LOW_LEVEL_TRACER
void STD_PROTO(InitLowLevelTrace,(void));
void STD_PROTO(_YAP_InitLowLevelTrace,(void));
#endif
/* unify.c */
void STD_PROTO(InitAbsmi,(void));
void STD_PROTO(InitUnify,(void));
int STD_PROTO(IUnify,(register CELL d0,register CELL d1));
EXTERN Term STD_PROTO(Deref,(Term));
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));
void STD_PROTO(_YAP_InitAbsmi,(void));
void STD_PROTO(_YAP_InitUnify,(void));
int STD_PROTO(_YAP_IUnify,(register CELL d0,register CELL d1));
op_numbers STD_PROTO(_YAP_op_from_opcode,(OPCODE));
/* userpreds.c */
void STD_PROTO(InitUserCPreds,(void));
void STD_PROTO(InitUserBacks,(void));
void STD_PROTO(_YAP_InitUserCPreds,(void));
void STD_PROTO(_YAP_InitUserBacks,(void));
/* utilpreds.c */
Term STD_PROTO(CopyTerm,(Term));
void STD_PROTO(InitUtilCPreds,(void));
Term STD_PROTO(_YAP_CopyTerm,(Term));
void STD_PROTO(_YAP_InitUtilCPreds,(void));
/* yap.c */
void STD_PROTO(addclause,(Term,CODEADDR,int,int));
/* ypsocks.c */
void STD_PROTO(InitSockets,(void));
void STD_PROTO(_YAP_InitSockets,(void));
#ifdef USE_SOCKET
void STD_PROTO(init_socks,(char *, long));
void STD_PROTO(_YAP_init_socks,(char *, long));
#endif
/* 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>
#endif
int STD_PROTO(IUnify_complex, (CELL *, CELL *,CELL *));
int STD_PROTO(iequ_complex, (CELL *, CELL *,CELL *));
#ifdef ANALYST
static char *op_names[_std_top + 1] =
@ -172,14 +168,14 @@ static char *op_names[_std_top + 1] =
inline EXTERN void
init_absmi_regs(REGSTORE * absmi_regs)
{
memcpy(absmi_regs, regp, sizeof(REGSTORE));
memcpy(absmi_regs, _YAP_regp, sizeof(REGSTORE));
}
inline EXTERN void
restore_absmi_regs(REGSTORE * old_regs)
{
memcpy(old_regs, regp, sizeof(REGSTORE));
regp = old_regs;
memcpy(old_regs, _YAP_regp, sizeof(REGSTORE));
_YAP_regp = old_regs;
}
#endif /* PUSH_REGS */
@ -216,25 +212,25 @@ restore_absmi_regs(REGSTORE * old_regs)
#define ENDCHO(TMP) }
/***************************************************************
* Y is usually, but not always, a register. This affects *
* YREG is usually, but not always, a register. This affects *
* choicepoints *
***************************************************************/
#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
#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() }
@ -242,19 +238,19 @@ restore_absmi_regs(REGSTORE * old_regs)
#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() }
#else
#define E_Y (Y)
#define E_YREG (YREG)
#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() }
@ -606,12 +602,12 @@ typedef CELL label;
* Next, Y
*/
#if SHADOW_Y
#define set_y() Y = YENV
#define save_y() YENV = Y
#define set_y() YREG = YENV
#define save_y() YENV = YREG
#else
#define set_y()
#define save_y()
#define Y YENV
#define YREG YENV
#endif
/*
@ -692,12 +688,12 @@ Macros to check the limits of stacks
#if defined(SBA) && defined(YAPOR)
#define check_stack(Label, GLOB) \
if ( (Int)(Unsigned(E_Y) - CFREG) < (Int)(GLOB) && \
(choiceptr)E_Y < B_FZ && E_Y > H_FZ && \
if ( (Int)(Unsigned(E_YREG) - CFREG) < (Int)(GLOB) && \
(choiceptr)E_YREG < B_FZ && E_Y > H_FZ && \
(GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label
#else
#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 */
/***************************************************************
@ -718,9 +714,9 @@ Macros to check the limits of stacks
pt0 = XREGS+(arity); \
while ( pt0 > XREGS ) \
{ register CELL x = pt0[0]; \
S_Y = S_Y-1; \
S_YREG = S_YREG-1; \
--pt0; \
(S_Y)[0] = x; \
(S_YREG)[0] = x; \
} \
ENDP(pt0)
@ -728,9 +724,9 @@ Macros to check the limits of stacks
BEGP(pt0); \
pt0 = XREGS+(arity); \
do { register CELL x = pt0[0]; \
S_Y = (S_Y)-1; \
S_YREG = (S_YREG)-1; \
--pt0; \
(S_Y)[0] = x; \
(S_YREG)[0] = x; \
} \
while ( pt0 > XREGS ); \
ENDP(pt0)
@ -753,16 +749,16 @@ Macros to check the limits of stacks
{ register yamop *x1 = (yamop *)(AP); \
register CELL *x2 = ENV; \
/* Jump to CP_BASE */ \
S_Y = (CELL *)((choiceptr)((S_Y)-(I))-1); \
S_YREG = (CELL *)((choiceptr)((S_YREG)-(I))-1); \
/* Save Information */ \
HBREG = H; \
B_Y->cp_tr = TR; \
B_Y->cp_h = H; \
B_Y->cp_b = B; \
store_yaam_reg_cpdepth(B_Y); \
B_Y->cp_cp = CPREG; \
B_Y->cp_ap = x1; \
B_Y->cp_env= x2; \
B_YREG->cp_tr = TR; \
B_YREG->cp_h = H; \
B_YREG->cp_b = B; \
store_yaam_reg_cpdepth(B_YREG); \
B_YREG->cp_cp = CPREG; \
B_YREG->cp_ap = x1; \
B_YREG->cp_env= x2; \
}
#define store_yaam_regs_for_either(AP,d0) \
@ -832,16 +828,16 @@ Macros to check the limits of stacks
#endif /* TABLING */
#define restore_yaam_regs(AP) \
{ register CELL *x1 = B_Y->cp_env; \
{ register CELL *x1 = B_YREG->cp_env; \
register yamop *x2; \
H = HBREG = PROTECT_FROZEN_H(B_Y); \
restore_yaam_reg_cpdepth(B_Y); \
CPREG = B_Y->cp_cp; \
H = HBREG = PROTECT_FROZEN_H(B_YREG); \
restore_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \
/* AP may depend on H */ \
x2 = (yamop *)AP; \
ENV = x1; \
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; \
BEGP(pt0); \
BEGP(pt1); \
pt1 = (CELL *)(B_Y+1)+d0; \
pt1 = (CELL *)(B_YREG+1)+d0; \
pt0 = XREGS+1+d0; \
while (pt0 > XREGS +1 ) \
{ register CELL x = pt1[-1]; \
@ -869,7 +865,7 @@ Macros to check the limits of stacks
d0 = Nargs; \
BEGP(pt0); \
BEGP(pt1); \
pt1 = (CELL *)(B_Y+1)+d0; \
pt1 = (CELL *)(B_YREG+1)+d0; \
pt0 = XREGS+1+d0; \
do { register CELL x = pt1[-1]; \
--pt0; \
@ -898,12 +894,12 @@ Macros to check the limits of stacks
#define pop_yaam_regs() \
{ register CELL *ptr1; \
H = PROTECT_FROZEN_H(B_Y); \
B = B_Y->cp_b; \
pop_yaam_reg_cpdepth(B_Y); \
CPREG = B_Y->cp_cp; \
ptr1 = B_Y->cp_env; \
TABLING_close_alt(B_Y); \
H = PROTECT_FROZEN_H(B_YREG); \
B = B_YREG->cp_b; \
pop_yaam_reg_cpdepth(B_YREG); \
CPREG = B_YREG->cp_cp; \
ptr1 = B_YREG->cp_env; \
TABLING_close_alt(B_YREG); \
HBREG = PROTECT_FROZEN_H(B); \
ENV = ptr1; \
}
@ -913,16 +909,16 @@ Macros to check the limits of stacks
d0 = (NArgs); \
BEGP(pt0); \
BEGP(pt1); \
S_Y = (CELL *)(B_Y+1); \
S_YREG = (CELL *)(B_YREG+1); \
pt0 = XREGS + 1 ; \
pt1 = S_Y ; \
pt1 = S_YREG ; \
while (pt0 < XREGS+1+d0) \
{ register CELL x = pt1[0]; \
pt1++; \
pt0++; \
pt0[-1] = x; \
} \
S_Y = pt1; \
S_YREG = pt1; \
ENDP(pt1); \
ENDP(pt0); \
ENDD(d0);
@ -932,7 +928,7 @@ Macros to check the limits of stacks
d0 = (NArgs); \
BEGP(pt0); \
BEGP(pt1); \
pt1 = (CELL *)(B_Y+1); \
pt1 = (CELL *)(B_YREG+1); \
pt0 = XREGS + 1 ; \
do { register CELL x = pt1[0]; \
pt1++; \
@ -940,7 +936,7 @@ Macros to check the limits of stacks
pt0[-1] = x; \
} \
while (pt0 < XREGS+1+d0); \
S_Y = pt1; \
S_YREG = pt1; \
ENDP(pt1); \
ENDP(pt0); \
ENDD(d0);
@ -1151,4 +1147,353 @@ trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
}
#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 *
* *
@ -77,8 +77,8 @@ typedef struct FREEB {
#define ALIGN_YAPTYPE(X,TYPE) (((CELL)(X)+(sizeof(TYPE)-1)) & ~(sizeof(TYPE)-1))
/* I'll assume page size is always a power of two */
#define AdjustPageSize(X) ((X) & (page_size-1) ? \
((X) + page_size) & (~(page_size-1)) : \
#define AdjustPageSize(X) ((X) & (_YAP_page_size-1) ? \
((X) + _YAP_page_size) & (~(_YAP_page_size-1)) : \
(X) )
#define BlockTrailer(b) ((YAP_SEG_SIZE *)b)[((BlockHeader *) b)->b_size]
@ -86,10 +86,9 @@ typedef struct FREEB {
#define FreeBlocks heap_regs->free_blocks
/* Operating system and architecture dependent page size */
extern int page_size;
void STD_PROTO(YAP_InitHeap, (void *));
extern int _YAP_page_size;
void STD_PROTO(_YAP_InitHeap, (void *));
#if USE_MMAP

98
H/amidefs.h
View File

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

19
H/amiops.h
View File

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

272
H/arith2.h
View File

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

21
H/clause.h
View File

@ -116,24 +116,9 @@ typedef struct clause_struct {
#define CL_IN_USE(X) ((X)->ClFlags & InUseMask)
#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 */
void STD_PROTO(RemoveLogUpdIndex,(Clause *));
void STD_PROTO(IPred,(CODEADDR sp));
void STD_PROTO(_YAP_RemoveLogUpdIndex,(Clause *));
void STD_PROTO(_YAP_IPred,(CODEADDR sp));
/* 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
void STD_PROTO(emit,(compiler_vm_op,Int,CELL));
void STD_PROTO(emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
CELL *STD_PROTO(emit_extra_size,(compiler_vm_op,CELL,int));
char *STD_PROTO(AllocCMem,(int));
int STD_PROTO(is_a_test_pred,(Term, SMALLUNSGN));
void STD_PROTO(bip_name,(Int, char *));
CODEADDR STD_PROTO(_YAP_assemble,(int));
void STD_PROTO(_YAP_emit,(compiler_vm_op,Int,CELL));
void STD_PROTO(_YAP_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
CELL *STD_PROTO(_YAP_emit_extra_size,(compiler_vm_op,CELL,int));
char *STD_PROTO(_YAP_AllocCMem,(int));
int STD_PROTO(_YAP_is_a_test_pred,(Term, SMALLUNSGN));
void STD_PROTO(_YAP_bip_name,(Int, char *));
#ifdef DEBUG
void STD_PROTO(ShowCode,(void));
void STD_PROTO(_YAP_ShowCode,(void));
#endif /* DEBUG */
extern PInstr *cpc, *CodeStart;
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;
extern jmp_buf _YAP_CompilerBotch;

20
H/eval.h
View File

@ -50,8 +50,8 @@ typedef union arith_ret {
/*
#define RINT(v) return(MkIntegerTerm(v))
#define RFLOAT(v) return(MkFloatTerm(v))
#define RBIG(v) return(MkBigIntTerm(v))
#define RBIG_FL(v) return(MkBigIntTerm((MP_INT *)(Int)v))
#define RBIG(v) return(_YAP_MkBigIntTerm(v))
#define RBIG_FL(v) return(_YAP_MkBigIntTerm((MP_INT *)(Int)v))
#define RERROR() return(MkIntTerm(0))
*/
@ -88,14 +88,14 @@ Functor STD_PROTO(EvalArg,(Term,arith_retptr));
#define FL(X) ((double)(X))
#endif
extern yap_error_number YAP_matherror;
extern yap_error_number _YAP_matherror;
void STD_PROTO(InitConstExps,(void));
void STD_PROTO(InitUnaryExps,(void));
void STD_PROTO(InitBinaryExps,(void));
void STD_PROTO(_YAP_InitConstExps,(void));
void STD_PROTO(_YAP_InitUnaryExps,(void));
void STD_PROTO(_YAP_InitBinaryExps,(void));
int STD_PROTO(ReInitConstExps,(void));
int STD_PROTO(ReInitUnaryExps,(void));
int STD_PROTO(ReInitBinaryExps,(void));
int STD_PROTO(_YAP_ReInitConstExps,(void));
int STD_PROTO(_YAP_ReInitUnaryExps,(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)
/* 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? */
@ -138,9 +138,9 @@ typedef CELL *CELL_PTR;
#define ENVSIZE(E) EnvSize(((CELL *)E)[E_CP])
extern Int total_marked;
void STD_PROTO(mark_variable, (CELL *));
void STD_PROTO(mark_external_reference, (CELL *));
void STD_PROTO(_YAP_mark_variable, (CELL *));
void STD_PROTO(_YAP_mark_external_reference, (CELL *));
void STD_PROTO(_YAP_inc_mark_variable, (void));

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 _MSC_VER || defined(__MINGW32__)
@ -34,7 +31,7 @@ FILE *rl_instream, *rl_outstream;
#endif
typedef struct
typedef struct stream_desc
{
union {
struct {
@ -77,8 +74,6 @@ StreamDesc;
#define MaxStreams 32
StreamDesc Stream[MaxStreams];
#define Free_Stream_f 0x000001
#define Output_Stream_f 0x000002
#define Input_Stream_f 0x000004
@ -108,15 +103,11 @@ StreamDesc Stream[MaxStreams];
#define ALIASES_BLOCK_SIZE 8
#if USE_SOCKET
extern int YP_sockets_io;
#endif
void STD_PROTO (InitStdStreams, (void));
void STD_PROTO (_YAP_InitStdStreams, (void));
EXTERN inline int
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);
#ifdef YAPOR
heap_regs->getworkfirsttimecode.opc = opcode(_getwork_first_time);
heap_regs->getworkcode.opc = opcode(_getwork);
heap_regs->getworkfirsttimecode.opc = _YAP_opcode(_getwork_first_time);
heap_regs->getworkcode.opc = _YAP_opcode(_getwork);
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);
#endif /* YAPOR */
#ifdef TABLING
heap_regs->tablecompletioncode.opc = opcode(_table_completion);
heap_regs->tableanswerresolutioncode.opc = opcode(_table_answer_resolution);
heap_regs->tablecompletioncode.opc = _YAP_opcode(_table_completion);
heap_regs->tableanswerresolutioncode.opc = _YAP_opcode(_table_answer_resolution);
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->tablecompletioncode), 0);
INIT_YAMOP_LTT(&(heap_regs->tableanswerresolutioncode), 0);
#endif /* YAPOR */
#endif /* TABLING */
heap_regs->failcode = opcode(_op_fail);
heap_regs->failcode_1 = opcode(_op_fail);
heap_regs->failcode_2 = opcode(_op_fail);
heap_regs->failcode_3 = opcode(_op_fail);
heap_regs->failcode_4 = opcode(_op_fail);
heap_regs->failcode_5 = opcode(_op_fail);
heap_regs->failcode_6 = opcode(_op_fail);
heap_regs->failcode = _YAP_opcode(_op_fail);
heap_regs->failcode_1 = _YAP_opcode(_op_fail);
heap_regs->failcode_2 = _YAP_opcode(_op_fail);
heap_regs->failcode_3 = _YAP_opcode(_op_fail);
heap_regs->failcode_4 = _YAP_opcode(_op_fail);
heap_regs->failcode_5 = _YAP_opcode(_op_fail);
heap_regs->failcode_6 = _YAP_opcode(_op_fail);
heap_regs->env_for_trustfail_code.op = opcode(_call);
heap_regs->trustfailcode = opcode(_trust_fail);
heap_regs->env_for_trustfail_code.op = _YAP_opcode(_call);
heap_regs->trustfailcode = _YAP_opcode(_trust_fail);
heap_regs->env_for_yes_code.op = opcode(_call);
heap_regs->yescode.opc = opcode(_Ystop);
heap_regs->undef_op = opcode(_undef_p);
heap_regs->index_op = opcode(_index_pred);
heap_regs->fail_op = opcode(_op_fail);
heap_regs->nocode.opc = opcode(_Nstop);
heap_regs->env_for_yes_code.op = _YAP_opcode(_call);
heap_regs->yescode.opc = _YAP_opcode(_Ystop);
heap_regs->undef_op = _YAP_opcode(_undef_p);
heap_regs->index_op = _YAP_opcode(_index_pred);
heap_regs->fail_op = _YAP_opcode(_op_fail);
heap_regs->nocode.opc = _YAP_opcode(_Nstop);
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->nocode), 1);
#endif /* YAPOR */
@ -77,7 +77,7 @@ restore_codes(void)
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->rtrycode), 1);
#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)
((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 =
(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) {
heap_regs->file_aliases =
(struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases);
@ -486,7 +490,7 @@ RestoreDBEntry(DBRef dbr)
if (dbr->Flags & DBWithRefs) {
DBRef *cp;
DBRef tm;
cp = (DBRef *) ((CODEADDR) dbr + SizeOfBlock(CodePtr(dbr)));
cp = (DBRef *) ((CODEADDR) dbr + _YAP_SizeOfBlock(CodePtr(dbr)));
while ((tm = *--cp) != 0)
*cp = DBRefAdjust(tm);
}
@ -584,8 +588,8 @@ RestoreClause(Clause *Cl, int mode)
/* Get the stored operator */
pc = Cl->ClCode;
do {
op_numbers op = op_from_opcode(pc->opc);
pc->opc = opcode(op);
op_numbers op = _YAP_op_from_opcode(pc->opc);
pc->opc = _YAP_opcode(op);
#ifdef DEBUG_RESTORE2
YP_fprintf(errout, "%s\n", op_names[op]);
#endif
@ -864,7 +868,7 @@ RestoreClause(Clause *Cl, int mode)
case _save_pair_x:
case _save_appl_x_write:
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 = NEXTOP(pc,ox);
break;
@ -873,7 +877,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_x_var2_write:
case _unify_l_x_var2:
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.xr = XAdjust(pc->u.oxx.xr);
pc = NEXTOP(pc,oxx);
@ -895,7 +899,7 @@ RestoreClause(Clause *Cl, int mode)
case _save_pair_y:
case _save_appl_y_write:
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 = NEXTOP(pc,oy);
break;
@ -908,7 +912,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_list:
case _unify_l_list_write:
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);
break;
/* instructions type os */
@ -916,7 +920,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_n_voids:
case _unify_l_n_voids_write:
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);
break;
/* instructions type oc */
@ -930,7 +934,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_l_longint:
case _unify_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;
if (IsAtomTerm(t))
@ -943,7 +947,7 @@ RestoreClause(Clause *Cl, int mode)
/* instructions type osc */
case _unify_n_atoms_write:
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;
if (IsAtomTerm(t))
@ -956,7 +960,7 @@ RestoreClause(Clause *Cl, int mode)
case _unify_struct:
case _unify_l_struc_write:
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 = NEXTOP(pc,of);
break;
@ -1059,7 +1063,7 @@ RestoreClause(Clause *Cl, int mode)
break;
/* instructions type ollll */
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.l2 = CodeAddrAdjust(pc->u.ollll.l2);
pc->u.ollll.l3 = CodeAddrAdjust(pc->u.ollll.l3);
@ -1454,7 +1458,7 @@ CleanCode(PredEntry *pp)
pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
if (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 & BinaryTestPredFlag) {
pp->TrueCodeOfPred = DirectCCodeAdjust(pp,pp->TrueCodeOfPred);
@ -1615,7 +1619,7 @@ RestoreEntries(PropEntry *pp)
break;
default:
/* OOPS */
Error(SYSTEM_ERROR, TermNil,
_YAP_Error(SYSTEM_ERROR, TermNil,
"Invalid Atom Property %d at %p", pp->KindOfPE, pp);
return;
}

4
H/tracer.h
View File

@ -27,10 +27,10 @@ typedef enum {
} yap_low_level_port;
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));
extern int do_low_level_trace;
extern int _YAP_do_low_level_trace;
#endif

89
H/yapio.h
View File

@ -62,13 +62,11 @@
#endif
#define YP_FILE FILE
extern int YP_stdin;
extern int YP_stdout;
extern int YP_stderr;
extern YP_FILE *_YAP_stdin;
extern YP_FILE *_YAP_stdout;
extern YP_FILE *_YAP_stderr;
int STD_PROTO(YP_fprintf,(int, char *, ...));
int STD_PROTO(YP_putc,(int, int));
int STD_PROTO(YP_fflush,(int));
#else
@ -100,7 +98,6 @@ int STD_PROTO(YP_fflush,(int));
/* flags for files in IOSTREAM struct */
#define _YP_IO_WRITE 1
#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 */
#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;
@ -230,14 +227,14 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
af_unix /* or AF_FILE */
} socket_domain;
Term STD_PROTO(InitSocketStream,(int, socket_info, socket_domain));
int STD_PROTO(CheckSocketStream,(Term, char *));
socket_domain STD_PROTO(GetSocketDomain,(int));
socket_info STD_PROTO(GetSocketStatus,(int));
void STD_PROTO(UpdateSocketStream,(int, socket_info, socket_domain));
Term STD_PROTO(_YAP_InitSocketStream,(int, socket_info, socket_domain));
int STD_PROTO(_YAP_CheckSocketStream,(Term, char *));
socket_domain STD_PROTO(_YAP_GetSocketDomain,(int));
socket_info STD_PROTO(_YAP_GetSocketStatus,(int));
void STD_PROTO(_YAP_UpdateSocketStream,(int, socket_info, socket_domain));
/* routines in ypsocks.c */
Int CloseSocket(int, socket_info, socket_domain);
Int STD_PROTO(_YAP_CloseSocket,(int, socket_info, socket_domain));
#endif /* USE_SOCKET */
@ -249,36 +246,42 @@ typedef struct AliasDescS {
/****************** character definition table **************************/
#define NUMBER_OF_CHARS 256
extern char *chtype;
extern char *_YAP_chtype;
/*************** variables concerned with parsing *********************/
extern TokEntry *tokptr, *toktide;
extern VarEntry *VarTable, *AnonVarTable;
extern int eot_before_eof;
extern TokEntry *_YAP_tokptr, *_YAP_toktide;
extern VarEntry *_YAP_VarTable, *_YAP_AnonVarTable;
extern int _YAP_eot_before_eof;
/* parser stack, used to be AuxSp, now is ASP */
#define ParserAuxSp (TR)
/* routines in parser.c */
VarEntry STD_PROTO(*LookupVar,(char *));
Term STD_PROTO(VarNames,(VarEntry *,Term));
VarEntry STD_PROTO(*_YAP_LookupVar,(char *));
Term STD_PROTO(_YAP_VarNames,(VarEntry *,Term));
/* routines ins scanner.c */
TokEntry STD_PROTO(*tokenizer,(int (*)(int), int (*)(int)));
TokEntry STD_PROTO(*fast_tokenizer,(void));
Term STD_PROTO(scan_num,(int (*)(int)));
TokEntry STD_PROTO(*_YAP_tokenizer,(int (*)(int), int (*)(int)));
TokEntry STD_PROTO(*_YAP_fast_tokenizer,(void));
Term STD_PROTO(_YAP_scan_num,(int (*)(int)));
char STD_PROTO(*_YAP_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */
Int STD_PROTO(FirstLineInParse,(void));
int STD_PROTO(CheckIOStream,(Term, char *));
int STD_PROTO(GetStreamFd,(int));
void STD_PROTO(CloseStream,(int));
int STD_PROTO(PlGetchar,(void));
int STD_PROTO(PlFGetchar,(void));
int STD_PROTO(StreamToFileNo,(Term));
Int STD_PROTO(_YAP_FirstLineInParse,(void));
int STD_PROTO(_YAP_CheckIOStream,(Term, char *));
int STD_PROTO(_YAP_GetStreamFd,(int));
void STD_PROTO(_YAP_CloseStreams,(int));
void STD_PROTO(_YAP_CloseStream,(int));
int STD_PROTO(_YAP_PlGetchar,(void));
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_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_SEEKABLE_STREAM 0x80
Term STD_PROTO(OpenStream,(FILE *,char *,Term,int));
#define Quote_illegal_f 1
#define Ignore_ops_f 2
#define Handle_vars_f 4
#define Use_portray_f 8
/* routines in sysbits.c */
char *STD_PROTO(pfgets,(char *,int,YP_File));
/* write.c */
void STD_PROTO(plwrite,(Term,int (*)(int, int),int));
void STD_PROTO(_YAP_plwrite,(Term,int (*)(int, int),int));
/* 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
#include <errno.h>
@ -313,7 +314,7 @@ extern int errno;
#if DEBUG
#if COROUTINING
extern int Portray_delays;
extern int _YAP_Portray_delays;
#endif
#endif
@ -324,11 +325,13 @@ extern int Portray_delays;
#define CONTINUE_ON_PARSER_ERROR 2
#define EXCEPTION_ON_PARSER_ERROR 3
extern jmp_buf IOBotch;
extern jmp_buf _YAP_IOBotch;
extern int in_getc;
#ifdef HAVE_LIBREADLINE
extern char *_line;
#ifdef DEBUG
extern YP_FILE *_YAP_logfile;
#endif
#if USE_SOCKET
extern int _YAP_sockets_io;
#endif

2
H/yerror.h
View File

@ -30,5 +30,3 @@
#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);
/* we'll need this later */
GlobalBase = mmap_addr + HeapArea;
_YAP_GlobalBase = mmap_addr + HeapArea;
/* model dependent */
/* 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 */
if ((private_fd_mapfile = open("/dev/zero", O_RDWR)) < 0)
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)
abort_optyap("mmap error in function map_memory: %s", strerror(errno));
close(private_fd_mapfile);
#else /* ENV_COPY or SBA */
for (i = 0; i < n_workers; i++) {
/* 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);
#ifdef SHM_MEMORY_MAPPING_SCHEME
/* mapping worker area */
@ -199,11 +199,11 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
if ((CELL)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;
#endif /* SBA */
TrailBase = GlobalBase + GlobalLocalArea;
LocalBase = TrailBase - CellSize;
_YAP_TrailBase = _YAP_GlobalBase + GlobalLocalArea;
_YAP_LocalBase = _YAP_TrailBase - CellSize;
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;
AuxTop = TrailBase + TrailAuxArea - CellSize;
AuxTop = _YAP_TrailBase + TrailAuxArea - CellSize;
AuxSp = (CELL *) AuxTop;
YAP_InitHeap(mmap_addr);
_YAP_InitHeap(mmap_addr);
BaseWorkArea = mmap_addr;
}
@ -292,10 +292,10 @@ void remap_memory(void) {
/* setup workers so that they have different areas */
long WorkerArea = worker_offset(1);
GlobalBase += worker_id * WorkerArea;
TrailBase += worker_id * WorkerArea;
LocalBase += worker_id * WorkerArea;
TrailTop += worker_id * WorkerArea;
_YAP_GlobalBase += worker_id * WorkerArea;
_YAP_TrailBase += worker_id * WorkerArea;
_YAP_LocalBase += worker_id * WorkerArea;
_YAP_TrailTop += worker_id * WorkerArea;
AuxTop += worker_id * WorkerArea;
AuxSp = (CELL *) AuxTop;
#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) {
return(YP_putc(ch, stderr));
return(putc(ch, stderr));
}
#endif /* TABLING_DEBUG */

48
OPTYap/opt.preds.c
View File

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

2
OPTYap/or.engine.c
View File

@ -303,7 +303,7 @@ sync_with_p:
#ifdef YAPOR_ERRORS
if ((CELL *)aux_cell < H0)
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)");
#endif /* YAPOR_ERRORS */
#ifdef TABLING

4
OPTYap/sbaunify.h
View File

@ -30,7 +30,7 @@ static inline
Int bind_variable(Term t0, Term t1)
{
tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) {
if (_YAP_IUnify(t0,t1)) {
return(TRUE);
} else {
while(TR != TR0) {
@ -48,7 +48,7 @@ Int unify(Term t0, Term t1)
Int unify(Term t0, Term t1)
{
tr_fr_ptr TR0 = TR;
if (IUnify(t0,t1)) {
if (_YAP_IUnify(t0,t1)) {
return(TRUE);
} else {
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; \
UInt diff; \
char *OldTrailTop = (char *)TrailTop; \
growtrail(64 * 1024L); \
_YAP_growtrail(64 * 1024Lf); \
diff = (char *)TrailTop - OldTrailTop; \
NEW_STACK = (CELL *)((char *)(STACK)+diff); \
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_instr(node) = opcode(TrNode_instr(node));
TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return ltt;
}
#else
@ -1512,7 +1512,7 @@ int update_answer_trie_branch(ans_node_ptr node) {
ltt = 1;
}
TrNode_or_arg(node) = ltt;
TrNode_instr(node) = opcode(TrNode_instr(node));
TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return ltt;
}
#endif /* TABLING_INNER_CUTS */
@ -1528,7 +1528,7 @@ void update_answer_trie_branch(ans_node_ptr node) {
} else {
TrNode_instr(node) -= 2; /* retry --> trust : try --> do */
}
TrNode_instr(node) = opcode(TrNode_instr(node));
TrNode_instr(node) = _YAP_opcode(TrNode_instr(node));
return;
}
#endif /* YAPOR */

18
library/mpi/mpe.c
View File

@ -9,14 +9,14 @@
**************************************************************************
* *
* File: mpe.c *
* Last rev: $Date: 2002-02-27 13:41:24 $ *
* Last rev: $Date: 2002-11-11 17:38:03 $ *
* mods: *
* comments: Interface to an MPE library *
* *
*************************************************************************/
#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
#include "Yap.h"
@ -204,14 +204,14 @@ p_log() /* mpe_log(+EventType, +EventNum, +EventStr) */
void
InitMPE(void)
_YAP_InitMPE(void)
{
InitCPred( "mpe_open", 0, p_init, SafePredFlag );
InitCPred( "mpe_start", 0, p_start, SafePredFlag );
InitCPred( "mpe_close", 1, p_close, SafePredFlag );
InitCPred( "mpe_create_event", 1, p_create_event, SafePredFlag );
InitCPred( "mpe_create_state", 4, p_create_state, SafePredFlag );
InitCPred( "mpe_log", 3, p_log, SafePredFlag );
_YAP_InitCPred( "mpe_open", 0, p_init, SafePredFlag );
_YAP_InitCPred( "mpe_start", 0, p_start, SafePredFlag );
_YAP_InitCPred( "mpe_close", 1, p_close, SafePredFlag );
_YAP_InitCPred( "mpe_create_event", 1, p_create_event, SafePredFlag );
_YAP_InitCPred( "mpe_create_state", 4, p_create_state, SafePredFlag );
_YAP_InitCPred( "mpe_log", 3, p_log, SafePredFlag );
}
#endif /* HAVE_MPE */

22
library/mpi/mpi.c
View File

@ -9,14 +9,14 @@
**************************************************************************
* *
* File: mpi.c *
* Last rev: $Date: 2002-11-05 11:14:08 $ *
* Last rev: $Date: 2002-11-11 17:38:06 $ *
* mods: *
* comments: Interface to an MPI library *
* *
*************************************************************************/
#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
#include "Yap.h"
@ -654,7 +654,7 @@ p_mpi_barrier() /* mpi_barrier/0 */
void
InitMPI(void)
_YAP_InitMPI(void)
{
int i,j;
@ -690,7 +690,7 @@ InitMPI(void)
}
#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).
See also the comment at "if ! HAVE_LIBMPICH" above!
*/
@ -715,13 +715,13 @@ InitMPI(void)
}
#endif
InitCPred( "mpi_open", 3, p_mpi_open, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_close", 0, p_mpi_close, SyncPredFlag );
InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_receive", 3, p_mpi_receive, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SafePredFlag|SyncPredFlag );
InitCPred( "mpi_barrier", 0, p_mpi_barrier, SyncPredFlag );
_YAP_InitCPred( "mpi_open", 3, p_mpi_open, SafePredFlag|SyncPredFlag );
_YAP_InitCPred( "mpi_close", 0, p_mpi_close, SyncPredFlag );
_YAP_InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag );
_YAP_InitCPred( "mpi_receive", 3, p_mpi_receive, SafePredFlag|SyncPredFlag );
_YAP_InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SafePredFlag|SyncPredFlag );
_YAP_InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SafePredFlag|SyncPredFlag );
_YAP_InitCPred( "mpi_barrier", 0, p_mpi_barrier, SyncPredFlag );
}
#endif /* HAVE_MPI */

6
library/system/Makefile.in
View File

@ -43,9 +43,7 @@ all: @NEWSHOBJ@
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
@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
#
# create a new DLL library on cygwin environments
# create a new DLL library on mingw32 environments
#
# DLLNAME: name of the new dll
# OBJS: list of object files I want to put in

14
m4/TermExt.h.m4
View File

@ -10,7 +10,7 @@
* File: TermExt.h *
* mods: *
* 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
@ -162,11 +162,11 @@ Inline(IsLongIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == Functor
#include <gmp.h>
MP_INT *STD_PROTO(PreAllocBigNum,(void));
MP_INT *STD_PROTO(InitBigNum,(Int));
Term STD_PROTO(MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO(BigIntOfTerm, (Term));
void STD_PROTO(CleanBigNum,(void));
MP_INT *STD_PROTO(_YAP_PreAllocBigNum,(void));
MP_INT *STD_PROTO(_YAP_InitBigNum,(Int));
Term STD_PROTO(_YAP_MkBigIntTerm, (MP_INT *));
MP_INT *STD_PROTO(_YAP_BigIntOfTerm, (Term));
void STD_PROTO(_YAP_CleanBigNum,(void));
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]);
#ifdef USE_GMP
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 */
case double_e:
{

136
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* 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"
@ -234,7 +234,7 @@ typedef unsigned long int YAP_LONG_LONG;
#endif
#if DEBUG
extern char Option[20];
extern char _YAP_Option[20];
#endif
/* #define FORCE_SECOND_QUADRANT 1 */
@ -260,7 +260,7 @@ extern char Option[20];
#elif defined(_WIN32)
#define MMAP_ADDR 0x18000000L
#elif defined(__CYGWIN__)
#define MMAP_ADDR 0x20040000L
#define MMAP_ADDR 0x30000000L
#endif
#endif /* !IN_SECOND_QUADRANT */
@ -268,8 +268,8 @@ extern char Option[20];
#define HEAP_INIT_BASE (MMAP_ADDR)
#define AtomBase ((char *)MMAP_ADDR)
#else
#define HEAP_INIT_BASE ((CELL)HeapBase)
#define AtomBase (HeapBase)
#define HEAP_INIT_BASE ((CELL)_YAP_HeapBase)
#define AtomBase (_YAP_HeapBase)
#endif
@ -393,7 +393,7 @@ typedef volatile int lockvar;
#define siglongjmp(Env, Arg) longjmp(Env, Arg)
#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 */
#include "arrays.h"
@ -485,9 +485,9 @@ typedef enum {
UNKNOWN_ERROR
} yap_error_number;
extern char *ErrorMessage; /* used to pass error messages */
extern Term Error_Term; /* used to pass error terms */
extern yap_error_number Error_TYPE; /* used to pass the error */
extern char *_YAP_ErrorMessage; /* used to pass error messages */
extern Term _YAP_Error_Term; /* used to pass error terms */
extern yap_error_number _YAP_Error_TYPE; /* used to pass the error */
typedef enum {
YAP_INT_BOUNDED_FLAG = 0,
@ -641,11 +641,11 @@ and RefOfTerm(t) : Term -> DBRef = ...
/************* variables related to memory allocation *******************/
/* must be before TermExt.h */
extern ADDR HeapBase,
LocalBase,
GlobalBase,
TrailBase, TrailTop,
ForeignCodeBase, ForeignCodeTop, ForeignCodeMax;
extern ADDR _YAP_HeapBase,
_YAP_LocalBase,
_YAP_GlobalBase,
_YAP_TrailBase,
_YAP_TrailTop;
/* 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(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:
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 *******************/
#define MaxHash 1001
/************ variables concerned with save and restore *************/
extern int splfild;
#define FAIL_RESTORE 0
#define DO_EVERYTHING 1
#define DO_ONLY_CODE 2
@ -749,9 +760,6 @@ extern int emacs_mode;
#endif
/************ variable concerned with version number *****************/
extern char version_number[];
/********* common instructions codes*************************/
#define MAX_PROMPT 256
@ -766,12 +774,9 @@ typedef struct opcode_tab_entry {
#endif
/******************* controlling the compiler ****************************/
extern int optimizer_on;
/******************* storing error messages ****************************/
#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 ***********************/
@ -788,66 +793,63 @@ typedef enum {
ExtendStackMode = 128 /* trying to extend stack */
} prolog_exec_mode;
extern prolog_exec_mode PrologMode;
extern int CritLocks;
extern prolog_exec_mode _YAP_PrologMode;
extern int _YAP_CritLocks;
/************** Access to yap initial arguments ***************************/
extern char **yap_args;
extern int yap_argc;
/******************* controlling debugging ****************************/
extern int creep_on;
extern char **_YAP_argv;
extern int _YAP_argc;
/******************* number of modules ****************************/
#define MaxModules 256
#ifdef YAPOR
#define YAPEnterCriticalSection() \
{ \
if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \
LOCK(GLOBAL_LOCKS_heap_access); \
GLOBAL_LOCKS_who_locked_heap = worker_id; \
} \
PrologMode |= CritMode; \
CritLocks++; \
#define YAPEnterCriticalSection() \
{ \
if (worker_id != GLOBAL_LOCKS_who_locked_heap) { \
LOCK(GLOBAL_LOCKS_heap_access); \
GLOBAL_LOCKS_who_locked_heap = worker_id; \
} \
_YAP_PrologMode |= CritMode; \
_YAP_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
CritLocks--; \
if (!CritLocks) { \
PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \
_YAP_CritLocks--; \
if (!_YAP_CritLocks) { \
_YAP_PrologMode &= ~CritMode; \
if (_YAP_PrologMode & InterruptMode) { \
_YAP_PrologMode &= ~InterruptMode; \
_YAP_ProcessSIGINT(); \
} \
if (PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \
Error(PURE_ABORT, 0, ""); \
if (_YAP_PrologMode & AbortMode) { \
_YAP_PrologMode &= ~AbortMode; \
_YAP_Error(PURE_ABORT, 0, ""); \
} \
GLOBAL_LOCKS_who_locked_heap = MAX_WORKERS; \
UNLOCK(GLOBAL_LOCKS_heap_access); \
} \
}
#else
#define YAPEnterCriticalSection() \
{ \
PrologMode |= CritMode; \
CritLocks++; \
#define YAPEnterCriticalSection() \
{ \
_YAP_PrologMode |= CritMode; \
_YAP_CritLocks++; \
}
#define YAPLeaveCriticalSection() \
{ \
CritLocks--; \
if (!CritLocks) { \
PrologMode &= ~CritMode; \
if (PrologMode & InterruptMode) { \
PrologMode &= ~InterruptMode; \
ProcessSIGINT(); \
_YAP_CritLocks--; \
if (!_YAP_CritLocks) { \
_YAP_PrologMode &= ~CritMode; \
if (_YAP_PrologMode & InterruptMode) { \
_YAP_PrologMode &= ~InterruptMode; \
_YAP_ProcessSIGINT(); \
} \
if (PrologMode & AbortMode) { \
PrologMode &= ~AbortMode; \
Error(PURE_ABORT, 0, ""); \
if (_YAP_PrologMode & AbortMode) { \
_YAP_PrologMode &= ~AbortMode; \
_YAP_Error(PURE_ABORT, 0, ""); \
} \
} \
}
@ -857,10 +859,6 @@ extern int creep_on;
#define AT_BOOT 0
#define AT_RESTORE 1
/********* whether we should try to compile array references ******************/
extern int compile_arrays;
/********* mutable variables ******************/
/* 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 ***********************/
#if DEBUG
extern int output_msg;
#endif
#if EMACS
extern char emacs_tmp[], emacs_tmp2[];
#endif
#if HAVE_SIGNAL
extern int snoozing;
#endif
#if defined(YAPOR) || defined(TABLING)
#include "opt.structs.h"
#include "opt.macros.h"

31
m4/Yatom.h.m4
View File

@ -248,8 +248,8 @@ typedef struct {
CmpPredicate f;
} cmp_entry;
extern CPredicate c_predicates[MAX_C_PREDS];
extern cmp_entry cmp_funcs[MAX_CMP_FUNCS];
extern CPredicate _YAP_c_predicates[MAX_C_PREDS];
extern cmp_entry _YAP_cmp_funcs[MAX_CMP_FUNCS];
/* Flags for code or dbase entry */
@ -487,23 +487,23 @@ Inline(IsArrayProperty, PropFlags, int, flags, (flags == ArrayProperty) )
/* Proto types */
/* cdmgr.c */
int STD_PROTO(RemoveIndexation,(PredEntry *));
int STD_PROTO(_YAP_RemoveIndexation,(PredEntry *));
/* dbase.c */
void STD_PROTO(ErDBE,(DBRef));
DBRef STD_PROTO(StoreTermInDB,(int,int));
Term STD_PROTO(FetchTermFromDB,(DBRef,int));
void STD_PROTO(ReleaseTermFromDB,(DBRef));
void STD_PROTO(_YAP_ErDBE,(DBRef));
DBRef STD_PROTO(_YAP_StoreTermInDB,(int,int));
Term STD_PROTO(_YAP_FetchTermFromDB,(DBRef,int));
void STD_PROTO(_YAP_ReleaseTermFromDB,(DBRef));
/* .c */
CODEADDR STD_PROTO(PredIsIndexable,(PredEntry *));
CODEADDR STD_PROTO(_YAP_PredIsIndexable,(PredEntry *));
/* 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 */
Prop STD_PROTO(GetAProp,(Atom,PropFlags));
Prop STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags));
Prop STD_PROTO(_YAP_GetAProp,(Atom,PropFlags));
Prop STD_PROTO(_YAP_GetAPropHavingLock,(AtomEntry *,PropFlags));
EXTERN inline Prop
PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
@ -523,7 +523,7 @@ PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
}
p0 = p->NextOfPE;
}
return(NewPredPropByFunctor(fe,cur_mod));
return(_YAP_NewPredPropByFunctor(fe,cur_mod));
}
EXTERN inline Prop
@ -544,11 +544,12 @@ PredPropByAtom(Atom at, SMALLUNSGN cur_mod)
}
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)
void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR));
void STD_PROTO(_YAP_ReleasePreAllocCodeSpace, (ADDR));
#else
#define ReleasePreAllocCodeSpace(x)
#define _YAP_ReleasePreAllocCodeSpace(x)
#endif

14
m4/sshift.h.m4
View File

@ -33,7 +33,7 @@ extern ADDR OldHeapBase, OldHeapTop;
#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 */
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(PtoArrayEAdjust, ArrayEntry *, ArrayEntry *, ptr, ((ArrayEntry *)(CharP(ptr) + HDiff)) )
#if PRECOMPUTE_REGADDRESS
Inline(XAdjust, AREG, AREG, reg, (AREG)((reg)+XDiff) )
Inline(XAdjust, wamreg, wamreg, reg, (wamreg)((reg)+XDiff) )
#else
Inline(XAdjust, AREG, AREG, reg, (reg) )
Inline(XAdjust, wamreg, wamreg, reg, (reg) )
#endif
Inline(YAdjust, YREG, YREG, reg, (reg) )
Inline(YAdjust, yslot, yslot, reg, (reg) )
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(IsOldCode, int, CELL, reg, IN_BETWEEN(OldHeapBase, reg, 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(AdjustRegs, (int));
void STD_PROTO(_YAP_AdjustStacksAndTrail, (void));
void STD_PROTO(_YAP_AdjustRegs, (int));

2
pl/listing.yap
View File

@ -19,6 +19,7 @@
*/
listing :-
current_output(Stream),
'$current_module'(Mod),
@ -173,3 +174,4 @@ portray_clause(_).
'$list_transform'(L,N).
'$list_transform'('$VAR'(-1).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) :-
'$do_error'(domain_error(builtin_procedure,G), G).
'$iso_builtin'(abolish(_)).
'$iso_builtin'(arg(_,_,_)).
'$iso_builtin'(_=:=_).