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

fix allocation of temporary stack so that unification can work even for

Browse Source 
very deep terms.
fix occur_unification_bug X = a(f(Y)).
This commit is contained in:
Costa Vitor 2009-05-22 18:35:24 -05:00
parent cfbd2f8886
commit ec595374a6
19 changed files with 310 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
C/alloc.c
View File

@ -61,14 +61,57 @@ static char SccsId[] = "%W% %G%";
/************************************************************************/
/* Yap workspace management */
#if USE_DL_MALLOC
#define malloc Yap_dlmalloc
#define free Yap_dlfree
#define realloc Yap_dlrealloc
#if USE_SYSTEM_MALLOC
#define my_malloc(sz) malloc(sz)
#define my_realloc(ptr, sz, safe) realloc(ptr, sz)
#define my_free(ptr) free(ptr)
#else
void Yap_add_memory_hole(ADDR Start, ADDR End)
#define my_malloc(sz) Yap_dlmalloc(sz)
#define my_free(sz) Yap_dlfree(sz)
static char * my_realloc(char *ptr, UInt sz, UInt osz, int safe)
{
Yap_HoleSize += Start-End;
char *nptr;
restart:
/* simple case */
if (ptr < Yap_HeapBase || ptr > HeapTop) {
/* we have enough room */
nptr = Yap_dlmalloc(sz);
if (nptr) {
memmove(nptr, ptr, osz);
free(ptr);
}
} else {
nptr = Yap_dlrealloc(ptr, sz);
}
if (nptr) {
return nptr;
}
/* we do not have enough room */
if (safe) {
if (Yap_growheap(FALSE, sz, NULL)) {
/* now, we have room */
goto restart;
}
}
/* no room in Heap, gosh */
if (ptr < Yap_HeapBase || ptr > HeapTop) {
/* try expanding outside the heap */
nptr = realloc(ptr, sz);
if (nptr) {
memmove(nptr, ptr, osz);
}
} else {
/* try calling the outside world for help */
nptr = malloc(sz);
if (!nptr)
return NULL;
memmove(nptr, ptr, osz);
Yap_dlfree(ptr);
}
/* did we suceed? at this point we could not care less */
return nptr;
}
#endif
@ -98,7 +141,7 @@ call_malloc(unsigned long int size)
tmalloc += size;
#endif
Yap_PrologMode |= MallocMode;
out = (char *) malloc(size);
out = (char *) my_malloc(size);
Yap_PrologMode &= ~MallocMode;
return out;
}
@ -119,7 +162,7 @@ Yap_FreeCodeSpace(char *p)
minfo('F');
frees++;
#endif
free (p);
my_free (p);
Yap_PrologMode &= ~MallocMode;
}
@ -138,7 +181,7 @@ Yap_FreeAtomSpace(char *p)
minfo('F');
frees++;
#endif
free (p);
my_free (p);
Yap_PrologMode &= ~MallocMode;
}
@ -153,7 +196,7 @@ Yap_InitPreAllocCodeSpace(void)
UInt sz = ScratchPad.msz;
if (ScratchPad.ptr == NULL) {
Yap_PrologMode |= MallocMode;
while (!(ptr = malloc(sz))) {
while (!(ptr = my_malloc(sz))) {
Yap_PrologMode &= ~MallocMode;
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
@ -166,12 +209,13 @@ Yap_InitPreAllocCodeSpace(void)
} else {
ptr = ScratchPad.ptr;
}
AuxSp = (CELL *)(AuxTop = (ADDR)(ptr+ScratchPad.sz));
AuxBase = (ADDR)(ptr);
AuxSp = (CELL *)(AuxTop = AuxBase+ScratchPad.sz);
return ptr;
}
ADDR
Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip)
Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip, int safe)
{
char *ptr;
UInt sz = ScratchPad.msz;
@ -189,20 +233,14 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip)
reallocs++;
#endif
Yap_PrologMode |= MallocMode;
while (!(ptr = realloc(ScratchPad.ptr, sz))) {
if (!(ptr = my_realloc(ScratchPad.ptr, sz, ScratchPad.sz, safe))) {
Yap_PrologMode &= ~MallocMode;
#if USE_DL_MALLOC
if (!Yap_growheap((cip!=NULL), sz, cip)) {
return NULL;
}
#else
return NULL;
#endif
Yap_PrologMode |= MallocMode;
}
Yap_PrologMode &= ~MallocMode;
ScratchPad.sz = ScratchPad.msz = sz;
ScratchPad.ptr = ptr;
AuxBase = ptr;
AuxSp = (CELL *)(AuxTop = ptr+sz);
return ptr;
}
@ -1420,6 +1458,14 @@ Yap_InitExStacks(int Trail, int Stack)
#define MAP_FIXED 1
#endif
#if !USE_DL_MALLOC
/* dead code */
void Yap_add_memory_hole(ADDR Start, ADDR End)
{
Yap_HoleSize += Start-End;
}
#endif
int
Yap_ExtendWorkSpace(Int s)
{

2
C/amasm.c
View File

@ -3780,7 +3780,7 @@ fetch_clause_space(Term* tp, UInt size, struct intermediates *cip, UInt *osizep)
break;
case OUT_OF_AUXSPACE_ERROR:
ARG1 = *tp;
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, (void *)cip)) {
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, (void *)cip, TRUE)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;

2
C/compiler.c
View File

@ -3347,7 +3347,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, Term mod, volatile Term src)
YAPLeaveCriticalSection();
ARG1 = inp_clause;
ARG3 = src;
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL, TRUE)) {
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
Yap_Error_Term = inp_clause;
}

2
C/corout.c
View File

@ -503,7 +503,7 @@ non_ground(Term t, Term *Var)
if (out >= 0)
return out;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in ground");
return FALSE;
}

2
C/dbase.c
View File

@ -279,7 +279,7 @@ recover_from_record_error(int nargs)
}
goto recover_record;
case OUT_OF_AUXSPACE_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, Yap_Error_Term, Yap_ErrorMessage);
return FALSE;
}

2
C/exec.c
View File

@ -1652,7 +1652,7 @@ Yap_InitYaamRegs(void)
PREG_ADDR = NULL;
#endif
Yap_AllocateDefaultArena(128*1024, 2);
Yap_PreAllocCodeSpace();
Yap_InitPreAllocCodeSpace();
#ifdef CUT_C
cut_c_initialize();
#endif

2
C/globals.c
View File

@ -889,7 +889,7 @@ CopyTermToArena(Term t, Term arena, int share, UInt arity, Term *newarena, Term
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL,TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}

4
C/gprof.c
View File

@ -732,7 +732,7 @@ search_pc_pred(yamop *pc_ptr,clauseentry *beg, clauseentry *end) {
}
extern void Yap_InitAbsmi(void);
extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0);
extern int Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0, CELL **to_visit_max);
static Int profend(void);
@ -788,7 +788,7 @@ showprofres(UInt type) {
if ((unsigned long)oldpc & GCMode) { InGC++; continue; }
if ((unsigned long)oldpc & (ErrorHandlingMode | InErrorMode)) { InError++; continue; }
}
if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
if (oldpc>(void *) Yap_rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
y=(yamop *) ((long) pc_ptr-20);
if (y->opc==Yap_opcode(_call_cpred) || y->opc==Yap_opcode(_call_usercpred)) {
InCCall++; /* I Was in a C Call */

38
C/grow.c
View File

@ -1606,41 +1606,39 @@ Yap_growtrail_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
CELL **
Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
{
#if USE_SYSTEM_MALLOC
CELL **to_visit_max = *to_visit_maxp;
Int sz1 = (CELL)to_visit-(CELL)to_visit_max;
Int sz0 = AuxTop - (ADDR)to_visit_max, sz, dsz;
char *newb = Yap_ExpandPreAllocCodeSpace(0, NULL);
/* relative position of top of stack */
Int off = (ADDR)to_visit-AuxBase;
/* how much space the top stack was using */
Int sz = AuxTop - (ADDR)to_visit_max;
/* how much space the bottom stack was using */
Int szlow = (ADDR)to_visit_max-AuxBase;
/* original size for AuxSpace */
Int totalsz0 = AuxTop - AuxBase; /* totalsz0 == szlow+sz */
/* new size for AuxSpace */
Int totalsz;
/* how much we grow */
Int dsz; /* totalsz == szlow+dsz+sz */
char *newb = Yap_ExpandPreAllocCodeSpace(0, NULL, FALSE);
if (newb == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"cannot allocate temporary space for unification (%p)", to_visit);
return to_visit;
}
/* check new size */
sz = AuxTop-newb;
totalsz = AuxTop-AuxBase;
/* how much we grew */
dsz = sz-sz0;
dsz = totalsz-totalsz0;
if (dsz == 0) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"cannot allocate temporary space for unification (%p)", to_visit);
return to_visit;
}
/* copy whole block to end */
cpcellsd((CELL *)newb, (CELL *)(newb+dsz), sz0/sizeof(CELL));
cpcellsd((CELL *)(newb+(dsz+szlow)), (CELL *)(newb+szlow), sz/sizeof(CELL));
/* base pointer is block start */
*to_visit_maxp = (CELL **)newb;
*to_visit_maxp = (CELL **)(newb+szlow);
/* current top is originall diff + diff size */
return (CELL **)((char *)newb+(sz1+dsz));
#else
CELL **old_top = (CELL **)Yap_TrailTop;
if (do_growtrail(64 * 1024L, FALSE, FALSE, NULL, NULL, NULL)) {
CELL **dest = (CELL **)((char *)to_visit+(Yap_TrailTop-(ADDR)old_top));
cpcellsd((CELL *)dest, (CELL *)to_visit, (CELL)((CELL *)old_top-(CELL *)to_visit));
return dest;
} else {
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"cannot grow temporary stack for unification (%p)", Yap_TrailTop);
return to_visit;
}
#endif
return (CELL **)(newb+(off+dsz));
}
static Int

2
C/heapgc.c
View File

@ -3772,7 +3772,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
while (Yap_bp+alloc_sz > (char *)AuxSp) {
/* not enough space */
*--ASP = (CELL)current_env;
Yap_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL);
Yap_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL, TRUE);
if (!Yap_bp)
return -1;
current_env = (CELL *)*ASP;

2
C/iopreds.c
View File

@ -3936,7 +3936,7 @@ static Int
}
} else if (Yap_Error_TYPE == OUT_OF_AUXSPACE_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
return FALSE;
}
} else if (Yap_Error_TYPE == OUT_OF_HEAP_ERROR) {

16
C/save.c
View File

@ -1230,10 +1230,17 @@ RestoreFreeSpace(void)
#if USE_DL_MALLOC
Yap_av = (struct malloc_state *)AddrAdjust((ADDR)Yap_av);
Yap_RestoreDLMalloc();
if (AuxSp != NULL)
if (AuxSp != NULL) {
if (AuxBase < OldHeapBase || AuxBase > OldHeapTop) {
AuxSp = NULL;
AuxBase = NULL;
AuxTop = NULL;
} else {
AuxSp = PtoHeapCellAdjust(AuxSp);
if (AuxTop != NULL)
AuxBase = AddrAdjust(AuxBase);
AuxTop = AddrAdjust(AuxTop);
}
}
#else
/* restores the list of free space, with its curious structure */
BlockHeader *bpt, *bsz;
@ -1765,6 +1772,11 @@ Restore(char *s, char *lib_dir)
/* reset time */
Yap_ReInitWallTime();
Yap_InitSysPath();
#if USE_DL_MALLOC || USE_SYSTEM_MALLOC
if (!AuxSp) {
Yap_InitPreAllocCodeSpace();
}
#endif
CloseRestore();
if (which_save == 2) {
Yap_unify(ARG2, MkIntTerm(0));

24
C/stdpreds.c
View File

@ -1065,7 +1065,7 @@ p_name(void)
/* error handling */
expand_auxsp:
String = Yap_ExpandPreAllocCodeSpace(0,NULL);
String = Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in name/2");
@ -1246,7 +1246,7 @@ p_atom_chars(void)
}
/* error handling */
expand_auxsp:
String = Yap_ExpandPreAllocCodeSpace(0,NULL);
String = Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atom_chars/2");
@ -1407,7 +1407,7 @@ p_atomic_concat(void)
restart:
base = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
while (base+1024 > (char *)AuxSp) {
base = Yap_ExpandPreAllocCodeSpace(0,NULL);
base = Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE);
if (base + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atomic_concat/2");
@ -1727,7 +1727,7 @@ p_atom_codes(void)
/* error handling */
expand_auxsp:
if (String + 1024 > (char *)AuxSp) {
String = Yap_ExpandPreAllocCodeSpace(0,NULL);
String = Yap_ExpandPreAllocCodeSpace(0,NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
@ -1914,7 +1914,7 @@ p_number_chars(void)
restart_aux:
String = Yap_PreAllocCodeSpace();
if (String+1024 > (char *)AuxSp) {
String = Yap_ExpandPreAllocCodeSpace(0,NULL);
String = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_chars/2");
@ -1980,7 +1980,7 @@ p_number_chars(void)
}
if (s+1024 > (char *)AuxSp) {
int offs = (s-String);
String = Yap_ExpandPreAllocCodeSpace(0,NULL);
String = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
if (String + (offs+1024) > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_chars/2");
@ -2021,7 +2021,7 @@ p_number_chars(void)
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0,NULL);
nString = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
t = *--H;
s = nString+(s-String);
String = nString;
@ -2055,7 +2055,7 @@ p_number_atom(void)
s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
if (String+1024 > (char *)AuxSp) {
s = String = Yap_ExpandPreAllocCodeSpace(0,NULL);
s = String = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_atom/2");
@ -2124,7 +2124,7 @@ p_number_codes(void)
String = Yap_PreAllocCodeSpace();
if (String+1024 > (char *)AuxSp) {
s = String = Yap_ExpandPreAllocCodeSpace(0,NULL);
s = String = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_codes/2");
@ -2186,7 +2186,7 @@ p_number_codes(void)
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0,NULL);
nString = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
t = *--H;
s = nString+(s-String);
String = nString;
@ -2224,7 +2224,7 @@ p_atom_number(void)
}
String = Yap_PreAllocCodeSpace();
if (String+1024 > (char *)AuxSp) {
s = String = Yap_ExpandPreAllocCodeSpace(0,NULL);
s = String = Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in number_codes/2");
@ -2493,7 +2493,7 @@ p_sub_atom_extract(void)
expand_auxsp:
{
char *String = Yap_ExpandPreAllocCodeSpace(len,NULL);
char *String = Yap_ExpandPreAllocCodeSpace(len, NULL, TRUE);
if (String + 1024 > (char *)AuxSp) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in sub_atom/5");

250
C/unify.c
View File

@ -18,7 +18,9 @@
#include "absmi.h"
STATIC_PROTO(Int OCUnify_complex, (register CELL *, register CELL *, register CELL *));
STD_PROTO(int Yap_rational_tree_loop, (CELL *, CELL *, CELL **, CELL **));
STATIC_PROTO(int OCUnify_complex, (CELL *, CELL *, CELL *));
STATIC_PROTO(int OCUnify, (register CELL, register CELL));
STATIC_PROTO(Int p_ocunify, (void));
#ifdef THREADED_CODE
@ -28,32 +30,13 @@ STATIC_PROTO(void InitReverseLookupOpcode, (void));
/* support for rational trees and unification with occur checking */
#if USE_SYSTEM_MALLOC
#define address_to_visit_max (&to_visit_max)
#define to_visit_base ((CELL **)AuxSp)
#define TO_VISIT to_visit, to_visit_max
int STD_PROTO(rational_tree_loop,(CELL *, CELL *, CELL **, CELL **));
#else
#define to_visit_max ((CELL **)TR+16)
#define address_to_visit_max NULL
#define to_visit_base ((CELL **)Yap_TrailTop)
#define TO_VISIT to_visit
int STD_PROTO(rational_tree_loop,(CELL *, CELL *, CELL **));
#endif
#define to_visit_base ((struct v_record *)AuxSp)
int
rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit
#if USE_SYSTEM_MALLOC
, CELL **to_visit_max
#endif
)
Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit, CELL **to_visit_max)
{
loop:
rtree_loop:
while (pt0 < pt0_end) {
register CELL *ptd0;
register CELL d0;
@ -69,7 +52,9 @@ loop:
if (IsPairTerm(d0)) {
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
to_visit = Yap_shift_visit(to_visit, &to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
@ -91,7 +76,7 @@ loop:
}
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
to_visit = Yap_shift_visit(to_visit, &to_visit_max);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
@ -108,12 +93,12 @@ loop:
derefa_body(d0, ptd0, rtree_loop_unk, rtree_loop_nvar);
}
/* Do we still have compound terms to visit */
if (to_visit < to_visit_max) {
if (to_visit < (CELL **)to_visit_base) {
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
to_visit += 3;
goto loop;
goto rtree_loop;
}
return FALSE;
@ -125,56 +110,60 @@ cufail:
*pt0 = (CELL)to_visit[2];
to_visit += 3;
}
return (TRUE);
return TRUE;
}
static inline int
rational_tree(Term d0) {
#if USE_SYSTEM_MALLOC
CELL **to_visit_max = (CELL **)Yap_PreAllocCodeSpace(), **to_visit = (CELL **)AuxSp;
#else
CELL **to_visit = (CELL **)Yap_TrailTop;
#endif
CELL **to_visit_max = (CELL **)AuxBase, **to_visit = (CELL **)AuxSp;
if (IsPairTerm(d0)) {
CELL *pt0 = RepPair(d0);
return rational_tree_loop(pt0-1, pt0+1, TO_VISIT);
return Yap_rational_tree_loop(pt0-1, pt0+1, to_visit, to_visit_max);
} else if (IsApplTerm(d0)) {
CELL *pt0 = RepAppl(d0);
Functor f = (Functor)(*pt0);
if (IsExtensionFunctor(f))
return FALSE;
return rational_tree_loop(pt0, pt0+ArityOfFunctor(f), TO_VISIT);
return Yap_rational_tree_loop(pt0, pt0+ArityOfFunctor(f), to_visit, to_visit_max);
} else
return FALSE;
}
static Int
OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1
)
static int
OCUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
#ifdef THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#if USE_SYSTEM_MALLOC
CELL **to_visit_max = (CELL **)Yap_PreAllocCodeSpace(), **to_visit = (CELL **)AuxSp;
#else
CELL **to_visit = (CELL **)Yap_TrailTop;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) || defined(HB) */
#endif
#if SHADOW_HB
register CELL *HBREG;
HBREG = HB;
#endif
#ifdef SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
loop:
struct unif_record *unif = (struct unif_record *)AuxBase;
struct v_record *to_visit = (struct v_record *)AuxSp;
#define unif_base ((struct unif_record *)AuxBase)
loop:
while (pt0 < pt0_end) {
register CELL *ptd0 = ++pt0;
register CELL d0 = *ptd0;
register CELL *ptd0 = pt0+1;
register CELL d0;
++pt1;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, unify_comp_unk);
unify_comp_nvar:
{
@ -184,93 +173,90 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
deref_head(d1, unify_comp_nvar_unk);
unify_comp_nvar_nvar:
if (d0 == d1) {
if (rational_tree_loop(pt0-1, pt0, TO_VISIT))
if (Yap_rational_tree_loop(pt0-1, pt0, (CELL **)to_visit, (CELL **)unif))
goto cufail;
continue;
} if (IsPairTerm(d0)) {
}
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
goto cufail;
}
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 5;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
struct unif_record *urec = unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)&urec);
unif = urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
/* we want unification of rational trees to fail */
to_visit[3] = (CELL *)*pt0;
to_visit[4] = (CELL *)*pt1;
*pt0 = TermFoundVar;
*pt1 = TermFoundVar;
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
}
else if (IsApplTerm(d0)) {
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor) (*ap2);
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) {
if (f != (Functor) *ap3)
goto cufail;
}
if (IsExtensionFunctor(f)) {
switch((CELL)f) {
case (CELL)FunctorDBRef:
if (d0 == d1) continue;
if (unify_extension(f, d0, ap2, d1))
continue;
goto cufail;
case (CELL)FunctorLongInt:
if (ap2[1] == ap3[1]) continue;
goto cufail;
case (CELL)FunctorDouble:
if (FloatOfTerm(d0) == FloatOfTerm(d1)) continue;
goto cufail;
#ifdef USE_GMP
case (CELL)FunctorBigInt:
if (mpz_cmp(Yap_BigIntOfTerm(d0),Yap_BigIntOfTerm(d1)) == 0) continue;
goto cufail;
#endif /* USE_GMP */
default:
goto cufail;
}
}
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 5;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
struct unif_record *urec = unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)&urec);
unif = urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit[4] = (CELL *)*pt1;
*pt0 = TermFoundVar;
*pt1 = TermFoundVar;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
} else {
if (d0 == d1)
continue;
else goto cufail;
}
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_GLOBAL(ptd1, d0, bind_ocunify1);
#ifdef COROUTINING
@ -278,18 +264,19 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
if (ptd1 < H0) Yap_WakeUp(ptd1);
bind_ocunify1:
#endif
if (rational_tree_loop(ptd1-1, ptd1, TO_VISIT))
if (Yap_rational_tree_loop(ptd1-1, ptd1, (CELL **)to_visit, (CELL **)unif))
goto cufail;
continue;
}
derefa_body(d0, ptd0, unify_comp_unk, unify_comp_nvar);
/* first arg var */
{
register CELL d1;
register CELL *ptd1 = NULL;
register CELL *ptd1;
d1 = *(ptd1 = pt1);
ptd1 = pt1;
d1 = ptd1[0];
/* pt2 is unbound */
deref_head(d1, unify_comp_var_unk);
unify_comp_var_nvar:
@ -300,7 +287,7 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
if (ptd0 < H0) Yap_WakeUp(ptd0);
bind_ocunify2:
#endif
if (rational_tree_loop(ptd0-1, ptd0, TO_VISIT))
if (Yap_rational_tree_loop(ptd0-1, ptd0, (CELL **)to_visit, (CELL **)unif))
goto cufail;
continue;
@ -311,37 +298,44 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
}
/* Do we still have compound terms to visit */
if (to_visit < to_visit_base) {
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
*pt1 = (CELL)to_visit[4];
to_visit += 5;
pt0 = to_visit->start0;
pt0_end = to_visit->end0;
pt1 = to_visit->start1;
to_visit++;
goto loop;
}
/* successful exit */
return (TRUE);
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return TRUE;
cufail:
/* failure */
while (to_visit < to_visit_base) {
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = to_visit[0];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
*pt1 = (CELL)to_visit[4];
to_visit += 5;
pt0 = unif->ptr;
*pt0 = unif->old;
}
/* failure */
return (FALSE);
#if SHADOW_REGS
#endif
return FALSE;
#ifdef THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
#undef Yap_REGS
#if PUSH_REGS
#define Yap_REGS (*Yap_regp)
#endif
#endif /* defined(B) || defined(TR) */
#endif
#undef unif_base
#undef to_visit_base
}
static int

12
C/utilpreds.c
View File

@ -406,7 +406,7 @@ handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t)
Yap_Error_Size = 0L;
if (size > 4*1024*1024)
size = 4*1024*1024;
if (!Yap_ExpandPreAllocCodeSpace(size,NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
@ -736,7 +736,7 @@ expand_vts(void)
/* Aux space overflow */
if (expand > 4*1024*1024)
expand = 4*1024*1024;
if (!Yap_ExpandPreAllocCodeSpace(expand, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) {
return FALSE;
}
} else {
@ -1429,7 +1429,7 @@ p_non_singletons_in_term(void) /* non_singletons in term t */
if (out != 0L) {
return Yap_unify(ARG3,out);
} else {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in singletons");
return FALSE;
}
@ -1577,7 +1577,7 @@ p_ground(void) /* ground(+T) */
}
}
if (out < 0) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in ground");
return FALSE;
}
@ -2206,7 +2206,7 @@ p_term_hash(void)
while (TRUE) {
CELL *ar = hash_complex_term(&t1-1, &t1, depth, H, FALSE);
if (ar == (CELL *)-1) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in term_hash");
return FALSE;
}
@ -2264,7 +2264,7 @@ p_instantiated_term_hash(void)
while (TRUE) {
CELL *ar = hash_complex_term(&t1-1, &t1, depth, H, TRUE);
if (ar == (CELL *)-1) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "overflow in term_hash");
return FALSE;
}

2
C/write.c
View File

@ -570,7 +570,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
while (s+3+mpz_sizeinbase(big, 10) >= (char *)AuxSp) {
#if USE_SYSTEM_MALLOC
/* may require stack expansion */
if (!Yap_ExpandPreAllocCodeSpace(3+mpz_sizeinbase(big, 10),NULL)) {
if (!Yap_ExpandPreAllocCodeSpace(3+mpz_sizeinbase(big, 10), NULL, TRUE)) {
s = NULL;
break;
}

6
H/Heap.h
View File

@ -812,15 +812,13 @@ extern struct various_codes *Yap_heap_regs;
UInt STD_PROTO(Yap_givemallinfo, (void));
#endif
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (UInt, void *));
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (UInt, void *, int));
#define Yap_ReleasePreAllocCodeSpace(x)
ADDR STD_PROTO(Yap_InitPreAllocCodeSpace, (void));
EXTERN inline ADDR
Yap_PreAllocCodeSpace(void)
{
ADDR ptr = ScratchPad.ptr;
if (ptr) return ptr;
return Yap_InitPreAllocCodeSpace();
return AuxBase;
}
#endif /* HEAP_H */

2
H/Regs.h
View File

@ -105,6 +105,7 @@ typedef struct
CELL *ENV_; /* 1 current environment */
CELL *ASP_; /* 8 top of local stack */
CELL *LCL0_; /* 3 local stack base */
ADDR AuxBase_; /* 9 Auxiliary base pointer */
CELL *AuxSp_; /* 9 Auxiliary stack pointer */
ADDR AuxTop_; /* 10 Auxiliary stack top */
/* visualc*/
@ -697,6 +698,7 @@ EXTERN inline void restore_B(void) {
#endif
#define AuxBase Yap_REGS.AuxBase_
#define AuxSp Yap_REGS.AuxSp_
#define AuxTop Yap_REGS.AuxTop_
#define TopB Yap_REGS.TopB_

114
H/absmi.h
View File

@ -1083,17 +1083,21 @@ Macros to check the limits of stacks
#define save_hb()
#endif
#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)
typedef struct unif_record {
CELL *ptr;
Term old;
} unif_record;
typedef struct u_record {
typedef struct v_record {
CELL *start0;
CELL *end0;
CELL *start1;
Term old;
} unif_record;
} v_record;
#if defined(IN_ABSMI_C) || defined(IN_UNIFY_C)
static int
IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
#ifdef THREADS
@ -1112,16 +1116,10 @@ IUnify_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
#ifdef USE_SYSTEM_MALLOC
struct u_record *to_visit_max = (struct u_record *)Yap_PreAllocCodeSpace(), *to_visit = (struct u_record *)AuxSp;
#define address_to_visit_max (&to_visit_max)
#define to_visit_base ((CELL **)AuxSp)
#else
struct u_record *to_visit = (struct u_record *)Yap_TrailTop;
#define to_visit_max ((struct u_record *)TR+16)
#define address_to_visit_max NULL
#define to_visit_base ((struct u_record *)Yap_TrailTop)
#endif
struct unif_record *unif = (struct unif_record *)AuxBase;
struct v_record *to_visit = (struct v_record *)AuxSp;
#define unif_base ((struct unif_record *)AuxBase)
#define to_visit_base ((struct v_record *)AuxSp)
loop:
while (pt0 < pt0_end) {
@ -1145,31 +1143,28 @@ loop:
if (!IsPairTerm(d1)) {
goto cufail;
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -- ;
if (to_visit < to_visit_max) {
to_visit = (struct u_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)address_to_visit_max);
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
to_visit->old = *pt0;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
if (to_visit < to_visit_max) {
to_visit = (struct u_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)address_to_visit_max);
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
struct unif_record *urec = unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)&urec);
unif = urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
}
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt1 = RepPair(d1) - 1;
continue;
@ -1193,30 +1188,28 @@ loop:
continue;
goto cufail;
}
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit --;
if (to_visit < to_visit_max) {
to_visit = (struct u_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)address_to_visit_max);
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
to_visit->old = *pt0;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, address_to_visit_max);
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
struct unif_record *urec = unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, (CELL ***)&urec);
unif = urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
}
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
@ -1254,23 +1247,28 @@ loop:
pt0 = to_visit->start0;
pt0_end = to_visit->end0;
pt1 = to_visit->start1;
#ifdef RATIONAL_TREES
*pt0 = to_visit->old;
#endif
to_visit ++;
to_visit++;
goto loop;
}
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return TRUE;
cufail:
#ifdef RATIONAL_TREES
/* failure */
while (to_visit < to_visit_base) {
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = to_visit->start0;
*pt0 = to_visit->old;
to_visit ++;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return FALSE;
@ -1285,14 +1283,8 @@ cufail:
}
/* don't pollute name space */
#if USE_SYSTEM_MALLOC
#undef address_to_visit_max
#undef to_visit_base
#else
#undef to_visit_max
#undef address_to_visit_max
#undef to_visit_base
#endif
#undef unif_base
#endif