diff --git a/C/alloc.c b/C/alloc.c index d2d7e8814..699f80523 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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) { diff --git a/C/amasm.c b/C/amasm.c index b1a469679..60ffdf83c 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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; diff --git a/C/compiler.c b/C/compiler.c index 4699e1e95..cdf548b27 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -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; } diff --git a/C/corout.c b/C/corout.c index fd8d200d7..f9d7a605d 100644 --- a/C/corout.c +++ b/C/corout.c @@ -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; } diff --git a/C/dbase.c b/C/dbase.c index c58eec95f..44ddfa0b4 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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; } diff --git a/C/exec.c b/C/exec.c index b795a316c..7273dde00 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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 diff --git a/C/globals.c b/C/globals.c index 625c66cf9..3255a80db 100644 --- a/C/globals.c +++ b/C/globals.c @@ -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; } diff --git a/C/gprof.c b/C/gprof.c index e16e788a3..44819276b 100644 --- a/C/gprof.c +++ b/C/gprof.c @@ -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 */ diff --git a/C/grow.c b/C/grow.c index 4fc92953a..1933d3a19 100644 --- a/C/grow.c +++ b/C/grow.c @@ -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 diff --git a/C/heapgc.c b/C/heapgc.c index 6cfeff8cf..548ddc43c 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -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; diff --git a/C/iopreds.c b/C/iopreds.c index 1ebb92394..097734475 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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) { diff --git a/C/save.c b/C/save.c index d363c80b2..8eae21322 100644 --- a/C/save.c +++ b/C/save.c @@ -1230,10 +1230,17 @@ RestoreFreeSpace(void) #if USE_DL_MALLOC Yap_av = (struct malloc_state *)AddrAdjust((ADDR)Yap_av); Yap_RestoreDLMalloc(); - if (AuxSp != NULL) - AuxSp = PtoHeapCellAdjust(AuxSp); - if (AuxTop != NULL) - AuxTop = AddrAdjust(AuxTop); + if (AuxSp != NULL) { + if (AuxBase < OldHeapBase || AuxBase > OldHeapTop) { + AuxSp = NULL; + AuxBase = NULL; + AuxTop = NULL; + } else { + AuxSp = PtoHeapCellAdjust(AuxSp); + 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)); diff --git a/C/stdpreds.c b/C/stdpreds.c index 7d473dc76..ced0083d4 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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"); diff --git a/C/unify.c b/C/unify.c index c57cbf138..a6a1ab2b2 100644 --- a/C/unify.c +++ b/C/unify.c @@ -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; - 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; - } + if (unify_extension(f, d0, ap2, d1)) + continue; + 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 diff --git a/C/utilpreds.c b/C/utilpreds.c index fa8daaa9c..89682234c 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -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; } diff --git a/C/write.c b/C/write.c index 10b7549dc..c6d1fc1d8 100644 --- a/C/write.c +++ b/C/write.c @@ -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; } diff --git a/H/Heap.h b/H/Heap.h index 30d039b1a..feedccaeb 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -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) +Yap_PreAllocCodeSpace(void) { - ADDR ptr = ScratchPad.ptr; - if (ptr) return ptr; - return Yap_InitPreAllocCodeSpace(); + return AuxBase; } #endif /* HEAP_H */ diff --git a/H/Regs.h b/H/Regs.h index f85e56a2f..6db618db6 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -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_ diff --git a/H/absmi.h b/H/absmi.h index fa222c236..0a2096b0f 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -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