From 09d8d07b7e0ed4dbf3a87af81e11da15f025f749 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 28 Jan 2019 15:02:55 +0000 Subject: [PATCH] ugh --- C/globals.c | 911 +++++++++++++----- C/qlyr.c | 7 + C/utilpreds.c | 2351 +++++++++++++++++++++++++++++----------------- C/write.c | 91 +- pl/messages.yap | 6 +- pl/undefined.yap | 7 +- 6 files changed, 2186 insertions(+), 1187 deletions(-) diff --git a/C/globals.c b/C/globals.c index 56aa0a41e..59be2a42b 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1,19 +1,19 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: non backtrackable term support * - * Last rev: 2/8/06 * - * mods: * - * comments: non-backtrackable term support * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: non backtrackable term support * +* Last rev: 2/8/06 * +* mods: * +* comments: non-backtrackable term support * +* * +*************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -30,82 +30,82 @@ static char SccsId[] = "%W% %G%"; /** - @defgroup Global_Variables Global Variables - @ingroup builtins - @{ + @defgroup Global_Variables Global Variables +@ingroup builtins +@{ - Global variables are associations between names (atoms) and - terms. They differ in various ways from storing information using - assert/1 or recorda/3. +Global variables are associations between names (atoms) and +terms. They differ in various ways from storing information using +assert/1 or recorda/3. - + The value lives on the Prolog (global) stack. This implies that - lookup time is independent from the size of the term. This is - particularly interesting for large data structures such as parsed XML - documents or the CHR global constraint store. ++ The value lives on the Prolog (global) stack. This implies that +lookup time is independent from the size of the term. This is +particularly interesting for large data structures such as parsed XML +documents or the CHR global constraint store. - + They support both global assignment using nb_setval/2 and - backtrackable assignment using b_setval/2. ++ They support both global assignment using nb_setval/2 and +backtrackable assignment using b_setval/2. - + Only one value (which can be an arbitrary complex Prolog term) - can be associated to a variable at a time. ++ Only one value (which can be an arbitrary complex Prolog term) +can be associated to a variable at a time. - + Their value cannot be shared among threads. Each thread has its own - namespace and values for global variables. ++ Their value cannot be shared among threads. Each thread has its own +namespace and values for global variables. - Currently global variables are scoped globally. We may consider module - scoping in future versions. Both b_setval/2 and - nb_setval/2 implicitly create a variable if the referenced name - does not already refer to a variable. +Currently global variables are scoped globally. We may consider module +scoping in future versions. Both b_setval/2 and +nb_setval/2 implicitly create a variable if the referenced name +does not already refer to a variable. - Global variables may be initialized from directives to make them - available during the program lifetime, but some considerations are - necessary for saved-states and threads. Saved-states to not store - global variables, which implies they have to be declared with - initialization/1 to recreate them after loading the saved - state. Each thread has its own set of global variables, starting with - an empty set. Using `thread_initialization/1` to define a global - variable it will be defined, restored after reloading a saved state - and created in all threads that are created after the - registration. Finally, global variables can be initialized using the - exception hook called exception/3. The latter technique is used - by CHR. +Global variables may be initialized from directives to make them +available during the program lifetime, but some considerations are +necessary for saved-states and threads. Saved-states to not store +global variables, which implies they have to be declared with +initialization/1 to recreate them after loading the saved +state. Each thread has its own set of global variables, starting with +an empty set. Using `thread_initialization/1` to define a global +variable it will be defined, restored after reloading a saved state +and created in all threads that are created after the +registration. Finally, global variables can be initialized using the +exception hook called exception/3. The latter technique is used +by CHR. - SWI-Prolog global variables are associations between names (atoms) and - terms. They differ in various ways from storing information using - assert/1 or recorda/3. +SWI-Prolog global variables are associations between names (atoms) and +terms. They differ in various ways from storing information using +assert/1 or recorda/3. - + The value lives on the Prolog (global) stack. This implies - that lookup time is independent from the size of the term. - This is particulary interesting for large data structures - such as parsed XML documents or the CHR global constraint - store. ++ The value lives on the Prolog (global) stack. This implies +that lookup time is independent from the size of the term. +This is particulary interesting for large data structures +such as parsed XML documents or the CHR global constraint +store. - They support both global assignment using nb_setval/2 and - backtrackable assignment using b_setval/2. +They support both global assignment using nb_setval/2 and +backtrackable assignment using b_setval/2. - + Only one value (which can be an arbitrary complex Prolog - term) can be associated to a variable at a time. ++ Only one value (which can be an arbitrary complex Prolog +term) can be associated to a variable at a time. - + Their value cannot be shared among threads. Each thread - has its own namespace and values for global variables. ++ Their value cannot be shared among threads. Each thread +has its own namespace and values for global variables. - + Currently global variables are scoped globally. We may - consider module scoping in future versions. ++ Currently global variables are scoped globally. We may +consider module scoping in future versions. - Both b_setval/2 and nb_setval/2 implicitly create a variable if the - referenced name does not already refer to a variable. +Both b_setval/2 and nb_setval/2 implicitly create a variable if the +referenced name does not already refer to a variable. - Global variables may be initialized from directives to make them - available during the program lifetime, but some considerations are - necessary for saved-states and threads. Saved-states to not store global - variables, which implies they have to be declared with initialization/1 - to recreate them after loading the saved state. Each thread has - its own set of global variables, starting with an empty set. Using - `thread_inititialization/1` to define a global variable it will be - defined, restored after reloading a saved state and created in all - threads that are created after the registration. +Global variables may be initialized from directives to make them +available during the program lifetime, but some considerations are +necessary for saved-states and threads. Saved-states to not store global +variables, which implies they have to be declared with initialization/1 +to recreate them after loading the saved state. Each thread has +its own set of global variables, starting with an empty set. Using +`thread_inititialization/1` to define a global variable it will be +defined, restored after reloading a saved state and created in all +threads that are created after the registration. */ @@ -123,7 +123,7 @@ static char SccsId[] = "%W% %G%"; special term on the heap. Arenas automatically contract as we add terms to the front. -*/ + */ #define QUEUE_FUNCTOR_ARITY 4 @@ -145,21 +145,21 @@ static char SccsId[] = "%W% %G%"; #define Global_MkIntegerTerm(I) MkIntegerTerm(I) -static size_t big2arena_sz(CELL *arena_base) { +static UInt big2arena_sz(CELL *arena_base) { return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / - sizeof(CELL); + sizeof(CELL); } -static size_t arena2big_sz(size_t sz) { +static UInt arena2big_sz(UInt sz) { return sz - - (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); + (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } /* pointer to top of an arena */ static inline CELL *ArenaLimit(Term arena) { CELL *arena_base = RepAppl(arena); - size_t sz = big2arena_sz(arena_base); + UInt sz = big2arena_sz(arena_base); return arena_base + sz; } @@ -171,9 +171,9 @@ CELL *Yap_ArenaLimit(Term arena) { /* pointer to top of an arena */ static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); } -static inline size_t ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } +static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); } -static Term CreateNewArena(CELL *ptr, size_t size) { +static Term CreateNewArena(CELL *ptr, UInt size) { Term t = AbsAppl(ptr); MP_INT *dst; @@ -186,29 +186,29 @@ static Term CreateNewArena(CELL *ptr, size_t size) { return t; } -static Term NewArena(size_t size, int wid, UInt arity, CELL *where) { +static Term NewArena(UInt size, int wid, UInt arity, CELL *where) { Term t; - size_t new_size; + UInt new_size; WORKER_REGS(wid) - if (where == NULL || where == HR) { - while (HR + size > ASP - 1024) { - if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return TermNil; - } + if (where == NULL || where == HR) { + while (HR + size > ASP - 1024) { + if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return TermNil; } - t = CreateNewArena(HR, size); - HR += size; - } else { - if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, - "No Stack Space for Non-Backtrackable terms"); - return TermNil; - } - size = new_size / sizeof(CELL); - t = CreateNewArena(where, size); } + t = CreateNewArena(HR, size); + HR += size; + } else { + if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, + "No Stack Space for Non-Backtrackable terms"); + return TermNil; + } + size = new_size / sizeof(CELL); + t = CreateNewArena(where, size); + } return t; } @@ -232,7 +232,7 @@ void Yap_AllocateDefaultArena(size_t gsize, int wid) { REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL); } -static void adjust_cps(size_t size USES_REGS) { +static void adjust_cps(UInt size USES_REGS) { /* adjust possible back pointers in choice-point stack */ choiceptr b_ptr = B; while (b_ptr->cp_h == HR) { @@ -290,37 +290,37 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size, return TRUE; } -CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { +CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) { CACHE_REGS - restart : { - Term arena = *arenap; - CELL *max = ArenaLimit(arena); - CELL *base = ArenaPt(arena); - CELL *newH; - size_t old_sz = ArenaSz(arena), new_size; +restart : { + Term arena = *arenap; + CELL *max = ArenaLimit(arena); + CELL *base = ArenaPt(arena); + CELL *newH; + UInt old_sz = ArenaSz(arena), new_size; - if (IN_BETWEEN(base, HR, max)) { - base = HR; - HR += cells; - return base; - } - if (base + cells > max - 1024) { - if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, - arity PASS_REGS)) - return NULL; - goto restart; - } - - newH = base + cells; - new_size = old_sz - cells; - *arenap = CreateNewArena(newH, new_size); + if (IN_BETWEEN(base, HR, max)) { + base = HR; + HR += cells; return base; } + if (base + cells > max - 1024) { + if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, + arity PASS_REGS)) + return NULL; + goto restart; + } + + newH = base + cells; + new_size = old_sz - cells; + *arenap = CreateNewArena(newH, new_size); + return base; +} } static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, - size_t old_size USES_REGS) { - size_t new_size; + UInt old_size USES_REGS) { + UInt new_size; if (HR == oldH) return; @@ -331,6 +331,319 @@ static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, ASP = oldASP; } +static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { + if (TR != TR0) { + tr_fr_ptr pt = TR0; + + do { + Term p = TrailTerm(pt++); + if (IsVarTerm(p)) { + RESET_VARIABLE(p); + } else { + /* copy downwards */ + TrailTerm(TR0 + 1) = TrailTerm(pt); + TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; + pt += 2; + TR0 += 3; + } + } while (pt != TR); + TR = TR0; + } +} + +#define expand_stack(S0,SP,SF,TYPE) \ + { size_t sz = SF-S0, used = SP-S0; \ + S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ + SP = S0+used; SF = S0+sz; } + +static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, + int share, int copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS) { + + int lvl = push_text_stack(); + struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit_max; + + CELL *HB0 = HB; + tr_fr_ptr TR0 = TR; + int ground = TRUE; + + HB = HLow; + to_visit0 = to_visit; + to_visit_max = to_visit+1024; +loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, copy_term_unk); + copy_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + *ptf = AbsPair(HR); + ptf++; +#ifdef RATIONAL_TREES + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 32 >= to_visit_max - 32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = ap2[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; +#endif + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); + HR += ap2[1] + 3; + break; + default: { + /* big int */ + UInt sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = ap2[i]; + } + HR += sz; + } + } + continue; + } + *ptf = AbsAppl(HR); + ptf++; +/* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit + 32 >= to_visit_max) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit++ >= (CELL **)AuxSp) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + } else { + /* just copy atoms or integers */ + *ptf++ = d0; + } + continue; + } + + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + ground = FALSE; + /* don't need to copy variables if we want to share the global term */ + if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) { + /* we have already found this cell */ + *ptf++ = (CELL)ptd0; + } else { +#if COROUTINING + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; + + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_and_Trail(ptd0, new); + ptf++; + } else { +#endif + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + Bind_and_Trail(ptd0, (CELL)ptf); + ptf++; +#ifdef COROUTINING + } +#endif + } + } + + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; +#ifdef RATIONAL_TREES + *pt0 = to_visit->oldv; +#endif + ground = (ground && to_visit->ground); + goto loop; + } + + /* restore our nice, friendly, term to its original state */ + HB = HB0; + clean_dirty_tr(TR0 PASS_REGS); + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; + +overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; + } +#endif + reset_trail(TR0); + pop_text_stack(lvl); + return -1; + +trail_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; + } +#endif + reset_trail(TR0); + pop_text_stack(lvl); + return -4; +} + static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { @@ -341,7 +654,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, int res = 0; Term tn; - restart: +restart: t = Deref(t); if (IsVarTerm(t)) { ASP = ArenaLimit(arena); @@ -353,7 +666,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi, + if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -373,22 +686,108 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, return tn; } else if (IsAtomOrIntTerm(t)) { return t; - } else { + } else if (IsPairTerm(t)) { + Term tf; + CELL *ap; CELL *Hi; - Hi = HR; - HR++; - oldH = HR; + if (share && ArenaPt(arena) > RepPair(t)) { + return t; + } HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); - if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi, - HR PASS_REGS)) < 0) { + ap = RepPair(t); + Hi = HR; + tf = AbsPair(HR); + HR += 2; + if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + Hi PASS_REGS)) < 0) { goto error_handler; } CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); - return Hi[0]; + return tf; + } else { + Functor f; + Term tf; + CELL *HB0; + CELL *ap; + + if (share && ArenaPt(arena) > RepAppl(t)) { + return t; + } + HR = HB = ArenaPt(arena); + ASP = ArenaLimit(arena); + f = FunctorOfTerm(t); + HB0 = HR; + ap = RepAppl(t); + tf = AbsAppl(HR); + HR[0] = (CELL)f; + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); + return t; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + res = -1; + goto error_handler; + } + HR[1] = ap[1]; + HR[2] = EndSpecials; + HR += 3; + break; + case (CELL) FunctorDouble: + if (HR > ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + res = -1; + goto error_handler; + } + HR[1] = ap[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = ap[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; +#endif + break; + case (CELL) FunctorString: + if (HR > ASP - (MIN_ARENA_SIZE + 3 + ap[1])) { + res = -1; + goto error_handler; + } + memmove(HR, ap, sizeof(CELL) * (3 + ap[1])); + HR += ap[1] + 3; + break; + default: { + UInt sz = ArenaSz(t), i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + res = -1; + goto error_handler; + } + for (i = 1; i < sz; i++) { + HR[i] = ap[i]; + } + HR += sz; + } + } + } else { + HR += 1 + ArityOfFunctor(f); + if (HR > ASP - MIN_ARENA_SIZE) { + res = -1; + goto error_handler; + } + if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, + copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < + 0) { + goto error_handler; + } + } + CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); + return tf; } - error_handler: +error_handler: HR = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); XREGS[arity + 1] = t; @@ -436,7 +835,7 @@ static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Functor f = Yap_MkFunctor(Na, Nar); UInt i; - restart: +restart: HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); HB0 = HR; @@ -585,8 +984,8 @@ static Int p_nb_setarg(USES_REGS1) { to = Deref(ARG3); to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; @@ -629,8 +1028,8 @@ static Int p_nb_set_shared_arg(USES_REGS1) { if (pos < 1 || pos > arity) return FALSE; to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; if (IsPairTerm(dest)) { @@ -711,8 +1110,8 @@ static Int p_nb_create_accumulator(USES_REGS1) { return FALSE; } to = CopyTermToArena( - t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; t2 = Deref(ARG2); @@ -765,9 +1164,9 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { } else { /* we need to create a new long int */ new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) - PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) + PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; } @@ -795,8 +1194,8 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { new = Yap_Eval(new); new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; @@ -826,12 +1225,12 @@ static Int p_nb_accumulator_value(USES_REGS1) { Term Yap_SetGlobalVal(Atom at, Term t0) { CACHE_REGS - Term to; + Term to; GlobalEntry *ge; ge = GetGlobalEntry(at PASS_REGS); to = CopyTermToArena( - t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; WRITE_LOCK(ge->GRWLock); @@ -842,10 +1241,10 @@ Term Yap_SetGlobalVal(Atom at, Term t0) { Term Yap_SaveTerm(Term t0) { CACHE_REGS - Term to; + Term to; to = CopyTermToArena( Deref(t0), LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; return to; @@ -875,8 +1274,8 @@ static Int p_nb_set_shared_val(USES_REGS1) { } ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS); to = CopyTermToArena( - ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; WRITE_LOCK(ge->GRWLock); @@ -960,7 +1359,7 @@ static Int p_nb_getval(USES_REGS1) { Term Yap_GetGlobal(Atom at) { CACHE_REGS - GlobalEntry *ge; + GlobalEntry *ge; Term to; ge = FindGlobalEntry(at PASS_REGS); @@ -1018,7 +1417,7 @@ static Int nbdelete(Atom at USES_REGS) { Int Yap_DeleteGlobal(Atom at) { CACHE_REGS - return nbdelete(at PASS_REGS); + return nbdelete(at PASS_REGS); } @@ -1153,7 +1552,7 @@ static Int nb_queue(UInt arena_sz USES_REGS) { return (FunctorOfTerm(t) == FunctorNBQueue); } ar[QUEUE_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = - MkIntTerm(0); + MkIntTerm(0); queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar); if (!Yap_unify(queue, ARG1)) return FALSE; @@ -1461,8 +1860,8 @@ static Int p_nb_heap(USES_REGS1) { } while ((heap = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), - 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), + 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((2 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1560,7 +1959,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) { if (!qd) return FALSE; - restart: +restart: hsize = IntegerOfTerm(qd[HEAP_SIZE]); hmsize = IntegerOfTerm(qd[HEAP_MAX]); if (hsize == hmsize) { @@ -1728,8 +2127,8 @@ static Int p_nb_beam(USES_REGS1) { hsize = IntegerOfTerm(tsize); } while ((beam = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), - 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), + 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((4 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1760,7 +2159,7 @@ static Int p_nb_beam_close(USES_REGS1) { return p_nb_heap_close(PASS_REGS1); } */ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { CACHE_REGS - UInt off = hsize, off2 = hsize; + UInt off = hsize, off2 = hsize; Term toff, toff2; /* push into first queue */ @@ -1804,7 +2203,7 @@ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off = IntegerOfTerm(pt2[1]); + UInt off = IntegerOfTerm(pt2[1]); UInt indx = 0; Term tk, ti, tv; @@ -1878,7 +2277,7 @@ static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off2 = IntegerOfTerm(pt[1]); + UInt off2 = IntegerOfTerm(pt[1]); Term ov = pt2[3 * off2 + 2]; /* return value */ UInt indx = 0; Term tk, tv; @@ -2098,7 +2497,7 @@ static Int p_nb_beam_keys(USES_REGS1) { CELL *pt, *ho; UInt i; - restart: +restart: qd = GetHeap(ARG1, "beam_keys"); if (!qd) return FALSE; @@ -2199,7 +2598,7 @@ static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom) */ void Yap_InitGlobals(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); @@ -2207,22 +2606,22 @@ void Yap_InitGlobals(void) { /** @pred b_setval(+ _Name_, + _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - [] is created (the empty list). On backtracking the assignment is - reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + [] is created (the empty list). On backtracking the assignment is + reversed. */ /** @pred b_setval(+ _Name_,+ _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - `[]` is created (the empty list). On backtracking the - assignment is reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + `[]` is created (the empty list). On backtracking the + assignment is reversed. */ @@ -2231,18 +2630,18 @@ void Yap_InitGlobals(void) { /** @pred nb_setval(+ _Name_, + _Value_) - Associates a copy of _Value_ created with duplicate_term/2 with - the atom _Name_. Note that this can be used to set an initial - value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 with + the atom _Name_. Note that this can be used to set an initial + value other than `[]` prior to backtrackable assignment. */ /** @pred nb_setval(+ _Name_,+ _Value_) - Associates a copy of _Value_ created with duplicate_term/2 - with the atom _Name_. Note that this can be used to set an - initial value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 + with the atom _Name_. Note that this can be used to set an + initial value other than `[]` prior to backtrackable assignment. */ @@ -2250,25 +2649,25 @@ void Yap_InitGlobals(void) { /** @pred nb_set_shared_val(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_, but sharing - non-backtrackable terms. This may be useful if you want to rewrite a - global variable so that the new copy will survive backtracking, but - you want to share structure with the previous term. + Associates the term _Value_ with the atom _Name_, but sharing + non-backtrackable terms. This may be useful if you want to rewrite a + global variable so that the new copy will survive backtracking, but + you want to share structure with the previous term. - The next example shows the differences between the three built-ins: + The next example shows the differences between the three built-ins: - ~~~~~ - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(_B,a(_C)) ? + ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(_B,a(_C)) ? - ?- - nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). + ?- + nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(C,a(_A)) ? - ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(C,a(_A)) ? + ~~~~~ */ @@ -2276,26 +2675,26 @@ void Yap_InitGlobals(void) { /** @pred nb_linkval(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_ without - copying it. This is a fast special-purpose variation of nb_setval/2 - intended for expert users only because the semantics on backtracking - to a point before creating the link are poorly defined for compound - terms. The principal term is always left untouched, but backtracking - behaviour on arguments is undone if the original assignment was - trailed and left alone otherwise, which implies that the history that - created the term affects the behaviour on backtracking. Please - consider the following example: + Associates the term _Value_ with the atom _Name_ without + copying it. This is a fast special-purpose variation of nb_setval/2 + intended for expert users only because the semantics on backtracking + to a point before creating the link are poorly defined for compound + terms. The principal term is always left untouched, but backtracking + behaviour on arguments is undone if the original assignment was + trailed and left alone otherwise, which implies that the history that + created the term affects the behaviour on backtracking. Please + consider the following example: - ~~~~~ - demo_nb_linkval :- - T = nice(N), - ( N = world, - nb_linkval(myvar, T), - fail - ; nb_getval(myvar, V), - writeln(V) - ). - ~~~~~ + ~~~~~ + demo_nb_linkval :- + T = nice(N), + ( N = world, + nb_linkval(myvar, T), + fail + ; nb_getval(myvar, V), + writeln(V) + ). + ~~~~~ */ @@ -2307,31 +2706,31 @@ void Yap_InitGlobals(void) { - Assigns the _Arg_-th argument of the compound term _Term_ with - the given _Value_ as setarg/3, but on backtracking the assignment - is not reversed. If _Term_ is not atomic, it is duplicated using - duplicate_term/2. This predicate uses the same technique as - nb_setval/2. We therefore refer to the description of - nb_setval/2 for details on non-backtrackable assignment of - terms. This predicate is compatible to GNU-Prolog - `setarg(A,T,V,false)`, removing the type-restriction on - _Value_. See also nb_linkarg/3. Below is an example for - counting the number of solutions of a goal. Note that this - implementation is thread-safe, reentrant and capable of handling - exceptions. Realising these features with a traditional implementation - based on assert/retract or flag/3 is much more complicated. + Assigns the _Arg_-th argument of the compound term _Term_ with + the given _Value_ as setarg/3, but on backtracking the assignment + is not reversed. If _Term_ is not atomic, it is duplicated using + duplicate_term/2. This predicate uses the same technique as + nb_setval/2. We therefore refer to the description of + nb_setval/2 for details on non-backtrackable assignment of + terms. This predicate is compatible to GNU-Prolog + `setarg(A,T,V,false)`, removing the type-restriction on + _Value_. See also nb_linkarg/3. Below is an example for + counting the number of solutions of a goal. Note that this + implementation is thread-safe, reentrant and capable of handling + exceptions. Realising these features with a traditional implementation + based on assert/retract or flag/3 is much more complicated. - ~~~~~ + ~~~~~ succeeds_n_times(Goal, Times) :- - Counter = counter(0), - ( Goal, - arg(1, Counter, N0), - N is N0 + 1, - nb_setarg(1, Counter, N), - fail - ; arg(1, Counter, Times) - ). - ~~~~~ + Counter = counter(0), + ( Goal, + arg(1, Counter, N0), + N is N0 + 1, + nb_setarg(1, Counter, N), + fail + ; arg(1, Counter, Times) + ). + ~~~~~ */ @@ -2340,9 +2739,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate the global sub-terms in _Value_. Use with extreme care - and consult the documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate the global sub-terms in _Value_. Use with extreme care + and consult the documentation of nb_linkval/2 before use. */ @@ -2351,9 +2750,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate _Value_. Use with extreme care and consult the - documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate _Value_. Use with extreme care and consult the + documentation of nb_linkval/2 before use. */ @@ -2361,20 +2760,20 @@ void Yap_InitGlobals(void) { /** @pred nb_delete(+ _Name_) - Delete the named global variable. + Delete the named global variable. - Global variables have been introduced by various Prolog - implementations recently. We follow the implementation of them in - SWI-Prolog, itself based on hProlog by Bart Demoen. + Global variables have been introduced by various Prolog + implementations recently. We follow the implementation of them in + SWI-Prolog, itself based on hProlog by Bart Demoen. - GNU-Prolog provides a rich set of global variables, including - arrays. Arrays can be implemented easily in YAP and SWI-Prolog using - functor/3 and `setarg/3` due to the unrestricted arity of - compound terms. + GNU-Prolog provides a rich set of global variables, including + arrays. Arrays can be implemented easily in YAP and SWI-Prolog using + functor/3 and `setarg/3` due to the unrestricted arity of + compound terms. - @} */ + @} */ Yap_InitCPred("nb_create", 3, p_nb_create, 0L); Yap_InitCPred("nb_create", 4, p_nb_create2, 0L); Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, @@ -2418,5 +2817,5 @@ void Yap_InitGlobals(void) { } /** - @} +@} */ diff --git a/C/qlyr.c b/C/qlyr.c index 53907c602..c961dc7b9 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -863,6 +863,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, } while (cl != NULL); } if (!nclauses) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + return; } while ((read_tag(stream) == QLY_START_LU_CLAUSE)) { @@ -947,6 +950,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, Yap_EraseStaticClause(cl, pp, CurrentModule); cl = ncl; } while (cl != NULL); + } else if (flags & MultiFileFlag) { + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE; + pp->OpcodeOfPred = FAIL_OPCODE; + } for (i = 0; i < nclauses; i++) { char *base = (void *)read_UInt(stream); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2067b0ea4..bcb42b72d 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,23 +1,23 @@ /************************************************************************* - * * - * YAP Prolog * - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: utilpreds.c * Last rev: 4/03/88 - ** mods: * comments: new utility predicates for YAP * - * * - *************************************************************************/ +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: utilpreds.c * +* Last rev: 4/03/88 * +* mods: * +* comments: new utility predicates for YAP * +* * +*************************************************************************/ #ifdef SCCS static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** - * @file utilpreds.c - * * @addtogroup Terms */ @@ -30,109 +30,14 @@ static char SccsId[] = "@(#)utilpreds.c 1.3"; #include "string.h" #endif - typedef struct { - Term old_var; - Term new_var; + Term old_var; + Term new_var; } *vcell; -typedef struct non_single_struct_t { - CELL *ptd0; - CELL d0; - CELL *pt0, *pt0_end; -} non_singletons_t; - -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) { \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - LIST0; \ - ptd0 = RepPair(d0); \ - if (*ptd0 == TermFreeTerm) continue; \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ptd0; \ - to_visit->d0 = *ptd0; \ - to_visit ++; \ - d0 = ptd0[0]; \ - pt0 = ptd0; \ - *ptd0 = TermFreeTerm; \ - pt0_end = pt0 + 1; \ - if (pt0 <= pt0_end) \ - goto list_loop; \ - } else if (IsApplTerm(d0)) { \ - register Functor f; \ - register CELL *ap2; \ - /* store the terms to visit */ \ - ap2 = RepAppl(d0); \ - f = (Functor)(*ap2); \ - \ - if (IsExtensionFunctor(f) || \ - IsAtomTerm((CELL)f)) { \ - \ - continue; \ - } \ - STRUCT0; \ - if (to_visit + 32 >= to_visit_max) { \ - goto aux_overflow; \ - } \ - to_visit->pt0 = pt0; \ - to_visit->pt0_end = pt0_end; \ - to_visit->ptd0 = ap2; \ - to_visit->d0 = *ap2; \ - to_visit ++; \ - \ - *ap2 = TermNil; \ - d0 = ArityOfFunctor(f); \ - pt0 = ap2; \ - pt0_end = ap2 + d0; \ - } - -#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) - -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - return 0L; \ - } - -#define def_aux_overflow() \ - aux_overflow:{ \ - size_t d1 = to_visit-to_visit0; \ - size_t d2 = to_visit_max-to_visit0; \ - to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ - to_visit = to_visit0+d1; \ - to_visit_max = to_visit0+(d2+128); \ - pt0--; \ - goto restart; \ - } - -#define def_global_overflow() \ - global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --; \ - CELL *ptd0 = to_visit->ptd0; \ - *ptd0 = to_visit->d0; \ - } \ - pop_text_stack(lvl); \ - clean_tr(TR0 PASS_REGS); \ - HR = InitialH; \ - LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \ - return false; } - - +static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); +static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); static Int p_non_singletons_in_term( USES_REGS1); static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_variables_in_term( USES_REGS1 ); @@ -140,7 +45,6 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG static Int p_force_trail_expansion( USES_REGS1 ); @@ -158,273 +62,145 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - tr_fr_ptr pt0 = TR; - while (pt0 != TR0) { - Term p = TrailTerm(--pt0); - if (IsApplTerm(p)) { - CELL *pt = RepAppl(p); -#ifdef FROZEN_STACKS - pt[0] = TrailVal(pt0); -#else - pt[0] = TrailTerm(pt0 - 1); - pt0 --; -#endif /* FROZEN_STACKS */ - } else { + if (TR != TR0) { + tr_fr_ptr pt = TR0; + + do { + Term p = TrailTerm(pt++); RESET_VARIABLE(p); - } - } - TR = TR0; + } while (pt != TR); + TR = TR0; + } } -/// @brief recover original term while fixing direct refs. -/// -/// @param USES_REGS -/// -static inline void -clean_complex_tr(tr_fr_ptr TR0 USES_REGS) { - tr_fr_ptr pt0 = TR; - while (pt0 != TR0) { - Term p = TrailTerm(--pt0); - if (IsApplTerm(p)) { - /// pt: points to the address of the new term we may want to fix. - CELL *pt = RepAppl(p); - if (pt >= HB && pt < HR) { /// is it new? - Term v = pt[0]; - if (IsApplTerm(v)) { - /// yes, more than a single ref - *pt = (CELL)RepAppl(v); - } -#ifndef FROZEN_STACKS - pt0 --; -#endif /* FROZEN_STACKS */ - continue; - } -#ifdef FROZEN_STACKS - pt[0] = TrailVal(pt0); -#else - pt[0] = TrailTerm(pt0 - 1); - pt0 --; -#endif /* FROZEN_STACKS */ - } else { - RESET_VARIABLE(p); - } - } - TR = TR0; -} - -#define expand_stack(S0,SP,SF,TYPE) \ - { size_t sz = SF-S0, used = SP-S0; \ - S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \ - SP = S0+used; SF = S0+sz; } - -#define MIN_ARENA_SIZE (1048L) - -int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, Term *split, bool copy_att_vars, CELL *ptf, - CELL *HLow USES_REGS) { - // fprintf(stderr,"+++++++++\n"); - //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); - - int lvl = push_text_stack(); - Term o = TermNil; - struct cp_frame *to_visit0, - *to_visit = Malloc(1024*sizeof(struct cp_frame)); - struct cp_frame *to_visit_max; +static int +copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) +{ + struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; - int ground = true; + int ground = TRUE; - HB = HLow; + HB = HR; to_visit0 = to_visit; - to_visit_max = to_visit+1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - - ptd0 = ++pt0; + ++ pt0; + ptd0 = pt0; d0 = *ptd0; - deref: deref_head(d0, copy_term_unk); - copy_term_nvar : { + copy_term_nvar: + { if (IsPairTerm(d0)) { - CELL *headp = RepPair(d0); - Term head = *headp; - if (IsPairTerm(head) && RepPair(head) >= HB && RepPair(head) < HR) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = AbsPair(ptf); - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - *ptf++ = head; - } - continue; - } else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { - *ptf++ = AbsPair(RepAppl(*headp)); - continue; - } - *ptf = AbsPair(HR); - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->curp = headp; - d0 = to_visit->oldv = head; - to_visit->ground = ground; - to_visit++; - // move to new list - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { /* If this is newer than the current term, just reuse */ - *headp = AbsPair(HR); - } - if (split) { - TrailedMaBind(ptf,AbsPair(HR)); - } - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - goto deref; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *headp, head; - /* store the terms to visit */ - headp = RepAppl(d0); - head = *headp; - - if (IsPairTerm(head)//(share && headp < HB) || - ) { - if (split) { - Term v = Yap_MkNewApplTerm(FunctorEq, 2); - RepAppl(v)[1] = head; - *headp = *ptf++ = RepAppl(v)[0]; - o = MkPairTerm( v, o ); - } else { - /* If this is newer than the current term, just reuse */ - *ptf++ = AbsAppl(RepPair(head)); - } - continue; - } - if (IsApplTerm(head)//(share && headp < HB) || - ) { - *ptf++ = head; - continue; - } - f = (Functor)(head); - if (share && (ground || IsExtensionFunctor(f))) { *ptf++ = d0; continue; } - /* store the terms to visit */ + *ptf = AbsPair(HR); + ptf++; + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->curp = headp; - to_visit->oldv = head; + to_visit->oldv = *pt0; to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit ++; + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; } - *ptf = AbsAppl(HR); - ptf++; - + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; +#if MULTIPLE_STACKS + if (f == FunctorDBRef) { + DBRef entryref = DBRefOfTerm(d0); + if (entryref->Flags & LogUpdMask) { + LogUpdClause *luclause = (LogUpdClause *)entryref; + PELOCK(100,luclause->ClPred); + UNLOCK(luclause->ClPred->PELock); + } else { + LOCK(entryref->lock); + TRAIL_REF(entryref); /* So that fail will erase it */ + INC_DBREF_COUNT(entryref); + UNLOCK(entryref->lock); } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = headp[2]; - HR[3] = EndSpecials; - HR += 4; -#else - HR[2] = EndSpecials; - HR += 3; + *ptf++ = d0; /* you can just copy other extensions. */ + } else #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + if (!share) { + UInt sz; + + *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ + /* make sure to copy floats */ + if (f== FunctorDouble) { + sz = sizeof(Float)/sizeof(CELL)+2; + } else if (f== FunctorLongInt) { + sz = 3; + } else if (f== FunctorString) { + sz = 3+ap2[1]; + } else { + CELL *pt = ap2+1; + sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); + } + if (HR+sz > ASP - 2048) { goto overflow; } - *ptf++ = AbsAppl(HR); - memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); - HR += headp[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; - - } + memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); HR += sz; - } + } else { + *ptf++ = d0; /* you can just copy other extensions. */ } continue; } - if (share) { - TrailedMaBind(headp,AbsPair(HR)); - } else { - *headp = AbsPair(HR); + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; } - if (split) { - // must be after trailing source term, so that we can check the source - // term and confirm it is still ok. - TrailedMaBind(ptf,AbsAppl(HR)); - } - ptf = HR; - ptf[0] = (CELL)f; - ground = true; - arity_t a = ArityOfFunctor(f); - if (HR > ASP - MIN_ARENA_SIZE) { + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit ++; + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR+1; + HR += 1+d0; + if (HR > ASP - 2048) { goto overflow; } - ptf++; - HR = ptf+a; - pt0_end = headp+(a); - pt0 = headp; - ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ *ptf++ = d0; @@ -433,62 +209,66 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HB && ptd0 < HR)) { + ground = FALSE; + if (ptd0 >= HLow && ptd0 < HR) { /* we have already found this cell */ - *ptf++ = (CELL)ptd0; - } else - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + *ptf++ = (CELL) ptd0; + } else +#if COROUTINING + if (newattvs && IsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; + CELL new; bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { goto overflow; } to_visit = bp; new = *ptf; + Bind_NonAtt(ptd0, new); + ptf++; + } else { +#endif + /* first time we met this term */ + RESET_VARIABLE(ptf); if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { goto trail_overflow; } } - - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - DO_TRAIL(ptd0, (CELL)ptf); - *ptd0 = (CELL)ptf; + Bind_NonAtt(ptd0, (CELL)ptf); ptf++; - if ((ADDR)TR > LOCAL_TrailTop - 16) - goto trail_overflow; - } } - /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - if (!share) - *to_visit->curp = to_visit->oldv; + to_visit --; + if (ground && share) { + CELL old = to_visit->oldv; + CELL *newp = to_visit->to-1; + CELL new = *newp; + + *newp = old; + if (IsApplTerm(new)) + HR = RepAppl(new); + else + HR = RepPair(new); + } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; ground = (ground && to_visit->ground); goto loop; } /* restore our nice, friendly, term to its original state */ - clean_complex_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; - + clean_dirty_tr(TR0 PASS_REGS); + HB = HB0; + return ground; overflow: /* oops, we're in trouble */ @@ -497,38 +277,62 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; } reset_trail(TR0); - pop_text_stack(lvl); + /* follow chain of multi-assigned variables */ return -1; - trail_overflow: +trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit--; + to_visit --; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; + *pt0 = to_visit->oldv; + } + { + tr_fr_ptr oTR = TR; + reset_trail(TR0); + if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + return -4; + } + return -2; + } + + heap_overflow: + /* oops, we're in trouble */ + HR = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; } reset_trail(TR0); - pop_text_stack(lvl); - return -4; -} + LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + return -3; + } static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) { CACHE_REGS - XREGS[arity+1] = t; + XREGS[arity+1] = t; switch(res) { case -1: if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { @@ -565,39 +369,97 @@ static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; + + if (IsVarTerm(t)) { +#if COROUTINING + if (newattvs && IsAttachedTerm(t)) { + CELL *Hi; + int res; + restart_attached: + + *HR = t; + Hi = HR+1; + HR += 2; + if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + HR = Hi-1; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_attached; + } + return Hi[0]; + } +#endif + return MkVarTerm(); + } else if (IsPrimitiveTerm(t)) { + return t; + } else if (IsPairTerm(t)) { + Term tf; + CELL *ap; CELL *Hi; - if (IsPrimitiveTerm(t)) { - return t; - } - while( true ) { - int res; + restart_list: + ap = RepPair(t); Hi = HR; - HR ++; - - if ((res = Yap_copy_complex_term((&t)-1, &t, share, NULL, newattvs, Hi, HR PASS_REGS)) < 0) { + tf = AbsPair(HR); + HR += 2; + { + int res; + if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; + goto restart_list; } else if (res && share) { HR = Hi; return t; } - return Hi[0]; } - return 0; + return tf; + } else { + Functor f = FunctorOfTerm(t); + Term tf; + CELL *HB0; + CELL *ap; + + restart_appl: + f = FunctorOfTerm(t); + HB0 = HR; + ap = RepAppl(t); + tf = AbsAppl(HR); + HR[0] = (CELL)f; + HR += 1+ArityOfFunctor(f); + if (HR > ASP-128) { + HR = HB0; + if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) + return FALSE; + goto restart_appl; + } else { + int res; + + if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) + return FALSE; + goto restart_appl; + } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { + HR = HB0; + return t; + } + } + return tf; + } } Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); } Term Yap_CopyTermNoShare(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); + return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); } static Int @@ -670,7 +532,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HR; to_visit0 = to_visit; - loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -681,9 +543,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te copy_term_nvar: { if (IsPairTerm(d0)) { - CELL *headp = RepPair(d0); - //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); - if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { + CELL *ap2 = RepPair(d0); + fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); + if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { Term v = MkVarTerm(); *ptf = v; vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); @@ -697,19 +559,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = headp; - pt0_end = headp + 1; + pt0 = ap2; + pt0_end = ap2 + 1; ptf = HR; - *headp = AbsPair(HR); + *ap2 = AbsPair(HR); HR += 2; if (HR > ASP - 2048) { goto overflow; } - if (IsVarTerm(d0) && d0 == (CELL)headp) { + if (IsVarTerm(d0) && d0 == (CELL)ap2) { RESET_VARIABLE(ptf); ptf++; continue; @@ -723,17 +585,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te continue; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *headp; + register CELL *ap2; /* store the terms to visit */ - headp = RepAppl(d0)+1; - f = (Functor)(headp[-1]); + ap2 = RepAppl(d0)+1; + f = (Functor)(ap2[-1]); if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ + *ptf++ = d0; /* you can just copy other extensions. */ continue; } - if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { + if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, headp[0] ); + vin = add_to_list(vin, (CELL)ptf, ap2[0] ); ptf++; continue; } @@ -746,19 +608,24 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = headp; - d0 = to_visit->oldv = headp[0]; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = headp; - pt0_end = headp + (arity-1); + pt0 = ap2; + pt0_end = ap2 + (arity-1); ptf = HR; if (HR > ASP - 2048) { goto overflow; } *ptf++ =(CELL)f; - *headp = AbsAppl(HR); + *ap2 = AbsAppl(HR); HR += (arity+1); + if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } d0 = Deref(d0); if (!IsVarTerm(d0)) { goto copy_term_nvar; @@ -831,7 +698,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te } -Term + Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); Term tii = ti; @@ -841,7 +708,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -882,7 +749,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { arity = ArityOfFunctor(f); HR += 1+arity; - { + { Int res; if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { HR = HB0; @@ -899,7 +766,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } } -static int + static int break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) { @@ -920,7 +787,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL if (new) { /* mark cell as pointing to new copy */ /* we can only mark after reading the value of the first argument */ - TrailedMaBind(pt0, new); + MaBind(pt0, new); new = 0L; } deref_head(d0, break_rationals_unk); @@ -1054,7 +921,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL return -3; } -Term + Term Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -1106,21 +973,21 @@ p_break_rational3( USES_REGS1 ) /* - FAST EXPORT ROUTINE. Export a Prolog term to something like: + FAST EXPORT ROUTINE. Export a Prolog term to something like: - CELL 0: offset for start of term - CELL 1: size of actual term (to be copied to stack) - CELL 2: the original term (just for reference) + CELL 0: offset for start of term + CELL 1: size of actual term (to be copied to stack) + CELL 2: the original term (just for reference) - Atoms and functors: - - atoms are either: - 0 and a char *string - -1 and a wchar_t *string - - functors are a CELL with arity and a string. + Atoms and functors: + - atoms are either: + 0 and a char *string + -1 and a wchar_t *string + - functors are a CELL with arity and a string. - Compiled Term. + Compiled Term. -*/ + */ static inline CELL *CellDifH(CELL *hptr, CELL *hlow) @@ -1175,14 +1042,14 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len) return (Functor)(((char *)hptr-buf)+1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ - do { \ - if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ - (A) = (CELL *)(D); \ - (D) = *(CELL *)(D); \ - if(!IsVarTerm(D)) goto LabelNonVar; \ - LabelUnk: ; \ - } while (Unsigned(A) != (D)) +#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ + do { \ + if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ + (A) = (CELL *)(D); \ + (D) = *(CELL *)(D); \ + if(!IsVarTerm(D)) goto LabelNonVar; \ + LabelUnk: ; \ + } while (Unsigned(A) != (D)) static int @@ -1424,7 +1291,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, /* follow chain of multi-assigned variables */ return -1; - trail_overflow: +trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1501,7 +1368,7 @@ ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) size_t Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) { CACHE_REGS - return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); + return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); } @@ -1519,7 +1386,7 @@ addAtom(Atom t, char *buf) if (!*s) { return Yap_LookupAtom(s+1); } - return NULL; + return NULL; } static UInt @@ -1591,7 +1458,7 @@ import_pair(CELL *hp, char *abase, char *buf, CELL *amax) Term Yap_ImportTerm(char * buf) { CACHE_REGS - CELL *bc = (CELL *)buf; + CELL *bc = (CELL *)buf; size_t sz = bc[1]; Term tinp, tret; tinp = bc[2]; @@ -1672,31 +1539,74 @@ p_kill_exported_term( USES_REGS1 ) static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); + to_visit0 = to_visit; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - restart: - ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } - WALK_COMPLEX_TERM(); - continue ; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -1719,19 +1629,21 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif goto loop; } - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1746,9 +1658,50 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter return(inp); } - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } @@ -1810,9 +1763,25 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ } do { Term t = Deref(ARG1); - out = vars_in_complex_term(&(t)-1, - &(t), - ARG2 PASS_REGS); + if (IsVarTerm(t)) { + out = AbsPair(HR); + HR += 2; + RESET_VARIABLE(HR-2); + RESET_VARIABLE(HR-1); + Yap_unify((CELL)(HR-2),ARG1); + Yap_unify((CELL)(HR-1),ARG2); + } else if (IsPrimitiveTerm(t)) + out = ARG2; + else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, ARG2 PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), ARG2 PASS_REGS); + } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -1826,7 +1795,6 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ static Int p_term_variables( USES_REGS1 ) /* variables in term t */ { - Term t = Deref(ARG1); Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { @@ -1836,9 +1804,24 @@ p_term_variables( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + if (IsVarTerm(t)) { + Term out = Yap_MkNewPairTerm(); + return + Yap_unify(t,HeadOfTerm(out)) && + Yap_unify(TermNil, TailOfTerm(out)) && + Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { + return Yap_unify(TermNil, ARG2); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); + } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) return FALSE; @@ -1858,15 +1841,21 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ { Term out; - do { + do { t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return TermNil; - } else { - out = vars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( arity PASS_REGS )) @@ -1884,26 +1873,82 @@ typedef struct att_rec { static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { int lvl = push_text_stack(); - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); + to_visit0 = to_visit; + to_visit_max = to_visit0+1024; restart: + do { while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, attvars_in_term_unk); attvars_in_term_nvar: { - WALK_COMPLEX_TERM(); + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + { + CELL *npt0 = RepPair(d0); + if(IsAtomicTerm(Deref(npt0[0]))) { + pt0 = npt0; + pt0_end = pt0 + 1; + continue; + } + } +#ifdef RATIONAL_TREES + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = pt0+2; + } else if (IsApplTerm(d0)) { + Functor f; + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + arity_t a = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + a; + } continue; } @@ -1911,44 +1956,62 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); if (IsAttVar(ptd0)) { /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; + *ptd0 = TermNil; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { - goto global_overflow; + goto global_overflow; } HR[1] = AbsPair(HR+2); HR += 2; - HR[-2] = (CELL)&(a0->Done); + HR[-2] = (CELL)ptd0; /* store the terms to visit */ if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } - ptd0 = (CELL*)a0; - to_visit->pt0 = pt0; - to_visit->pt0_end = pt0_end; - to_visit->d0 = *ptd0; - to_visit->ptd0 = ptd0; - to_visit ++; - *ptd0 = TermNil; +#ifdef RATIONAL_TREES + + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = &RepAttVar(ptd0)->Value; pt0_end = &RepAttVar(ptd0)->Atts; - pt0 = pt0_end-1; } + continue; } /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; + if (to_visit == to_visit0) + break; +#ifdef RATIONAL_TREES + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + } while(true); - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; - } - - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1963,8 +2026,46 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return(inp); } - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + *pt0 = to_visit->oval; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + pop_text_stack(lvl); + HR = InitialH; + return 0L; + + aux_overflow: + { + size_t d1 = to_visit-to_visit0; + size_t d2 = to_visit_max-to_visit0; + to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +} +pt0--; +goto restart; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + *pt0 = to_visit->oval; + } +#endif + clean_tr(TR0 PASS_REGS); +pop_text_stack(lvl); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } @@ -1975,16 +2076,27 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ do { Term t = Deref(ARG1); - if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + out = attvars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t)+1, TermNil PASS_REGS); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); - } else { - out = attvars_in_complex_term(&(t)-1, - &(t), TermNil PASS_REGS); + } else if (IsPairTerm(t)) { + out = attvars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + if (IsExtensionFunctor(f)) + return Yap_unify(TermNil, ARG2); + out = attvars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) - return false; - } + return FALSE; + } } while (out == 0L); return Yap_unify(ARG2,out); } @@ -2004,9 +2116,15 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Yap_unify(out, ARG2); } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); - } else { - out = vars_in_complex_term(&(t)-1, - &(t), ARG3 PASS_REGS); + } else if (IsPairTerm(t)) { + out = vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, ARG3 PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), ARG3 PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2021,12 +2139,7 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2046,19 +2159,65 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { goto global_overflow; @@ -2068,24 +2227,28 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, HR[-2] = (CELL)ptd0; *ptd0 = TermNil; } + continue; } - continue; derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2093,10 +2256,51 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); } static Int @@ -2106,11 +2310,21 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = vars_within_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), Deref(ARG1) PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = vars_within_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else if (IsPairTerm(t)) { + out = vars_within_complex_term(RepPair(t)-1, + RepPair(t)+1, Deref(ARG1) PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = vars_within_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2122,12 +2336,7 @@ p_variables_within_term( USES_REGS1 ) /* variables within term t */ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -2147,19 +2356,65 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } inp = TailOfTerm(inp); } - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); - + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -2184,17 +2439,21 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); if (HR != InitialH) { HR[-1] = TermNil; return output; @@ -2202,9 +2461,51 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; + } static Int @@ -2214,11 +2515,21 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ do { Term t = Deref(ARG2); - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = new_vars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), Deref(ARG1) PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; - else { - out = new_vars_in_complex_term(&(t)-1, - &(t), Deref(ARG1) PASS_REGS); + else if (IsPairTerm(t)) { + out = new_vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, Deref(ARG1) PASS_REGS); + } + else { + Functor f = FunctorOfTerm(t); + out = new_vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), Deref(ARG1) PASS_REGS); } if (out == 0L) { if (!expand_vts( 3 PASS_REGS )) @@ -2230,27 +2541,70 @@ p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; - Term o = TermNil; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; + *HR++ = MkAtomTerm(AtomDollar); + to_visit0 = to_visit; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -2259,13 +2613,10 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { - o = TermNil; goto global_overflow; } HR[0] = (CELL)ptd0; - HR[1] = o; - o = AbsPair(HR); - HR += 2; + HR ++; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ @@ -2277,30 +2628,78 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - return o; + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + if (HR != InitialH) { + InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); + return AbsAppl(InitialH); + } else { + return MkAtomTerm(AtomDollar); + } - - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + aux_overflow: + LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + return 0L; } static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { - register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2443,7 +2842,7 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ Functor f = FunctorOfTerm(t); if (f == FunctorHat) { out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); + RepAppl(t)+1, TR0 PASS_REGS); if (out == 0L) { goto trail_overflow; } @@ -2461,11 +2860,21 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ } t = ArgOfTerm(2,t); } - if (IsPrimitiveTerm(t)) + if (IsVarTerm(t)) { + out = free_vars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t), TR0 PASS_REGS); + + } else if (IsPrimitiveTerm(t)) out = TermNil; + else if (IsPairTerm(t)) { + out = free_vars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TR0 PASS_REGS); + } else { - out = free_vars_in_complex_term(&(t)-1, - &(t), TR0 PASS_REGS); + Functor f = FunctorOfTerm(t); + out = free_vars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: @@ -2486,36 +2895,80 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - WALK_COMPLEX_TERM() - else if (d0 == TermFoundVar) { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { CELL *pt2 = pt0; while(IsVarTerm(*pt2)) pt2 = (CELL *)(*pt2); - HR[1] = AbsPair(HR+2); - HR[0] = (CELL)pt2; + HR[0] = AbsPair(HR+2); HR += 2; + HR[-1] = (CELL)pt2; *pt2 = TermRefoundVar; } continue; @@ -2530,26 +2983,47 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; + goto loop; } clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); if (HR != InitialH) { - /* close the list */ + CELL *pt0 = InitialH, *pt1 = pt0; + while (pt0 < InitialH) { + if(Deref(pt0[0]) == TermFoundVar) { + pt1[0] = pt0[0]; + pt1[1] = AbsAppl(pt1+2); + pt1 += 2; + } + pt0 += 2; + } + } + if (HR != InitialH) { + /* close the list */ HR[-1] = Deref(ARG2); return output; } else { return ARG2; } - def_aux_overflow(); + aux_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0 PASS_REGS); + if (HR != InitialH) { + /* close the list */ + RESET_VARIABLE(HR-1); + } + return 0L; } static Int @@ -2564,9 +3038,13 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ out = ARG2; } else if (IsPrimitiveTerm(t)) { out = ARG2; + } else if (IsPairTerm(t)) { + out = non_singletons_in_complex_term(RepPair(t)-1, + RepPair(t)+1 PASS_REGS); } else { - out = non_singletons_in_complex_term(&(t)-1, - &(t) PASS_REGS); + out = non_singletons_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); } if (out != 0L) { return Yap_unify(ARG3,out); @@ -2581,15 +3059,11 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) { - int lvl = push_text_stack(); - struct non_single_struct_t *to_visit0, - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit_max; + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -2597,64 +3071,137 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R ++pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue; + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; } - pop_text_stack(lvl); - return false; +#endif + return FALSE; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } - pop_text_stack(lvl); - return true; + return TRUE; - def_aux_overflow(); + aux_overflow: + /* unwind stack */ +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + return -1; } bool Yap_IsGroundTerm(Term t) { CACHE_REGS - while (TRUE) { - Int out; + while (TRUE) { + Int out; - if (IsVarTerm(t)) { - return FALSE; - } else if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + return FALSE; + } else if (IsPrimitiveTerm(t)) { + return TRUE; + } else if (IsPairTerm(t)) { + if ((out =ground_complex_term(RepPair(t)-1, + RepPair(t)+1 PASS_REGS)) >= 0) { + return out != 0; + } + } else { + Functor fun = FunctorOfTerm(t); + + if (IsExtensionFunctor(fun)) return TRUE; - } else { - if ((out =ground_complex_term(&(t)-1, - &(t) PASS_REGS)) >= 0) { - return out != 0; - } - if (out < 0) { - *HR++ = t; - if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; - } - t = *--HR; + else if ((out = ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun) PASS_REGS)) >= 0) { + return out != 0; } } + if (out < 0) { + *HR++ = t; + if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); + return false; + } + t = *--HR; } + } } static Int @@ -2807,32 +3354,32 @@ int Yap_SizeGroundTerm(Term t, int ground) { CACHE_REGS - if (IsVarTerm(t)) { - if (!ground) - return 1; - return 0; - } else if (IsPrimitiveTerm(t)) { + if (IsVarTerm(t)) { + if (!ground) return 1; - } else if (IsPairTerm(t)) { - int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); - if (sz <= 0) - return sz; - return sz+2; - } else { - int sz = 0; - Functor fun = FunctorOfTerm(t); + return 0; + } else if (IsPrimitiveTerm(t)) { + return 1; + } else if (IsPairTerm(t)) { + int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); + if (sz <= 0) + return sz; + return sz+2; +} else { + int sz = 0; + Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) - return 1+ SizeOfExtension(t); + if (IsExtensionFunctor(fun)) + return 1+ SizeOfExtension(t); - sz = sz_ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun), - ground PASS_REGS); - if (sz <= 0) - return sz; - return 1+ArityOfFunctor(fun)+sz; - } + sz = sz_ground_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(fun), + ground PASS_REGS); + if (sz <= 0) + return sz; + return 1+ArityOfFunctor(fun)+sz; + } } static Int var_in_complex_term(register CELL *pt0, @@ -3003,52 +3550,52 @@ p_var_in_term( USES_REGS1 ) // And it has a few limitations - // 1. It will not work incrementally. -// 2. It will not produce the same results on litle-endian and big-endian +// 2. It will not produce the same results on little-endian and big-endian // machines. static unsigned int MurmurHashNeutral2 ( const void * key, int len, unsigned int seed ) { - const unsigned int m = 0x5bd1e995; - const int r = 24; + const unsigned int m = 0x5bd1e995; + const int r = 24; - unsigned int h = seed ^ len; + unsigned int h = seed ^ len; - const unsigned char * data = (const unsigned char *)key; + const unsigned char * data = (const unsigned char *)key; - while(len >= 4) - { - unsigned int k; + while(len >= 4) + { + unsigned int k; - k = data[0]; - k |= data[1] << 8; - k |= data[2] << 16; - k |= data[3] << 24; + k = data[0]; + k |= data[1] << 8; + k |= data[2] << 16; + k |= data[3] << 24; - k *= m; - k ^= k >> r; - k *= m; + k *= m; + k ^= k >> r; + k *= m; - h *= m; - h ^= k; + h *= m; + h ^= k; - data += 4; - len -= 4; - } + data += 4; + len -= 4; + } - switch(len) - { - case 3: h ^= data[2] << 16; - case 2: h ^= data[1] << 8; - case 1: h ^= data[0]; - h *= m; - }; + switch(len) + { + case 3: h ^= data[2] << 16; + case 2: h ^= data[1] << 8; + case 1: h ^= data[0]; + h *= m; + }; - h ^= h >> 13; - h *= m; - h ^= h >> 15; + h ^= h >> 13; + h *= m; + h ^= h >> 15; - return h; + return h; } static CELL * @@ -3056,20 +3603,20 @@ addAtomToHash(CELL *st, Atom at) { unsigned int len; - char *c = RepAtom(at)->StrOfAE; - int ulen = strlen(c); - /* fix hashing over empty atom */ - if (!ulen) { - return st; - } - if (ulen % CellSize == 0) { - len = ulen/CellSize; - } else { - len = ulen/CellSize; - len++; - } - st[len-1] = 0L; - strncpy((char *)st, c, ulen); + char *c = RepAtom(at)->StrOfAE; + int ulen = strlen(c); + /* fix hashing over empty atom */ + if (!ulen) { + return st; + } + if (ulen % CellSize == 0) { + len = ulen/CellSize; + } else { + len = ulen/CellSize; + len++; + } + st[len-1] = 0L; + strncpy((char *)st, c, ulen); return st+len; } @@ -3241,7 +3788,7 @@ Int Yap_TermHash(Term t, Int size, Int depth, int variant) { CACHE_REGS - unsigned int i1; + unsigned int i1; Term t1 = Deref(t); while (TRUE) { @@ -3386,7 +3933,7 @@ p_instantiated_term_hash( USES_REGS1 ) } static int variant_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { tr_fr_ptr OLDTR = TR; register CELL **to_visit = (CELL **)ASP; @@ -3475,16 +4022,16 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register continue; } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR+1024) + goto out_of_stack; + 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) { @@ -3628,7 +4175,7 @@ bool Yap_Variant(Term t1, Term t2) { CACHE_REGS - return is_variant(t1, t2, 0 PASS_REGS); + return is_variant(t1, t2, 0 PASS_REGS); } static Int @@ -3639,7 +4186,7 @@ p_variant( USES_REGS1 ) /* variant terms t1 and t2 */ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) + CELL *pt1 USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR, new_tr; @@ -3868,8 +4415,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { return(subsumes_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS)); + RepPair(t1)+1, + RepPair(t2)-1 PASS_REGS)); } else return (FALSE); } else { @@ -3883,8 +4430,8 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ return(unify_extension(f1, t1, RepAppl(t1), t2)); } return(subsumes_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS)); + RepAppl(t1)+ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS)); } } @@ -4135,7 +4682,7 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ HB = B->cp_h; return Yap_unify(ARG3,tf); } - } else if (IsApplTerm(t1) && IsApplTerm(t2)) { + } else if (IsApplTerm(t1) && IsApplTerm(t2)) { Functor f1; if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) { @@ -4270,41 +4817,64 @@ extern int vsc; int vsc; -#define RENUMBER_SINGLES \ - if (singles && ap2 >= InitialH && ap2 < HR) { \ - renumbervar(d0, numbv++ PASS_REGS); \ - continue; \ - } - - static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) { - int lvl = push_text_stack(); - - struct non_single_struct_t - *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), - *to_visit0 = to_visit, - *to_visit_max = to_visit+1024; + att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + to_visit_max = to_visit0+1024; +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; - list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: { - WALK_COMPLEX_TERM__({},RENUMBER_SINGLES); - + if (IsPairTerm(d0)) { + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + Functor f; + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (singles && ap2 >= InitialH && ap2 < HR) { + renumbervar(d0, numbv++ PASS_REGS); + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } continue; } @@ -4334,30 +4904,74 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; - - pt0 = to_visit->pt0; - pt0_end = to_visit->pt0_end; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - goto restart; +#ifdef RATIONAL_TREES + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; } prune(B PASS_REGS); pop_text_stack(lvl); return numbv; - def_trail_overflow(); - def_aux_overflow(); - def_global_overflow(); + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; + } +#endif + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0 PASS_REGS); + HR = InitialH; + pop_text_stack(lvl); + return numbv-1; + + aux_overflow: + { + size_t d1 = to_visit-to_visit0; + size_t d2 = to_visit_max-to_visit0; + to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +} +pt0--; +goto loop; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; + *pt0 = to_visit->oval; + } +#endif + clean_tr(TR0 PASS_REGS); + HR = InitialH; + LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; + LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + pop_text_stack(lvl); + return numbv-1; + } Int Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ + * numbervariables in term t */ { CACHE_REGS - Int out; + Int out; Term t; restart: @@ -4381,7 +4995,7 @@ Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* Functor f = FunctorOfTerm(t); out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ + RepAppl(t)+ ArityOfFunctor(f), numbv, handle_singles PASS_REGS); } if (out < numbv) { @@ -4421,7 +5035,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share int ground = share; Int max = -1; - int lvl = push_text_stack(); HB = HLow; to_visit0 = to_visit; loop: @@ -4443,6 +5056,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } *ptf = AbsPair(HR); ptf++; +#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4454,6 +5068,18 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsPair(HR); to_visit ++; +#else + if (pt0 < pt0_end) { + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit ++; + } +#endif ground = share; pt0 = ap2 - 1; pt0_end = ap2 + 1; @@ -4482,7 +5108,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share Int id = IntegerOfTerm(ap2[1]); ground = FALSE; if (id < -1) { - pop_text_stack(lvl); Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); return 0L; } @@ -4517,6 +5142,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ +#ifdef RATIONAL_TREES if (to_visit+1 >= (struct cp_frame *)AuxSp) { goto heap_overflow; } @@ -4528,6 +5154,18 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* fool the system into thinking we had a variable there */ *pt0 = AbsAppl(HR); to_visit ++; +#else + if (pt0 < pt0_end) { + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit ++; + } +#endif ground = (f != FunctorMutable) && share; d0 = ArityOfFunctor(f); pt0 = ap2; @@ -4578,7 +5216,6 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); HB = HB0; - pop_text_stack(lvl); return ground; overflow: @@ -4587,6 +5224,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4594,9 +5232,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } +#endif reset_trail(TR0); /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); return -1; heap_overflow: @@ -4605,6 +5243,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; +#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit --; pt0 = to_visit->start_cp; @@ -4612,9 +5251,9 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share ptf = to_visit->to; *pt0 = to_visit->oldv; } +#endif reset_trail(TR0); LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - pop_text_stack(lvl); return -3; } @@ -4689,7 +5328,7 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { Term Yap_UnNumberTerm(Term inp, int share) { CACHE_REGS - return UnnumberTerm(inp, 0, share PASS_REGS); + return UnnumberTerm(inp, 0, share PASS_REGS); } static Int @@ -4709,19 +5348,19 @@ Yap_SkipList(Term *l, Term **tailp) s = l; if ( IsPairTerm(*l) ) - { intptr_t power = 1, lam = 0; - do - { if ( power == lam ) - { s = l; - power *= 2; - lam = 0; - } - lam++; - length++; - l = RepPair(*l)+1; - do_derefa(v,l,derefa2_unk,derefa2_nonvar); - } while ( *l != *s && IsPairTerm(*l) ); - } + { intptr_t power = 1, lam = 0; + do + { if ( power == lam ) + { s = l; + power *= 2; + lam = 0; + } + lam++; + length++; + l = RepPair(*l)+1; + do_derefa(v,l,derefa2_unk,derefa2_nonvar); + } while ( *l != *s && IsPairTerm(*l) ); + } *tailp = l; return length; @@ -4844,121 +5483,121 @@ p_reset_variables( USES_REGS1 ) void Yap_InitUtilCPreds(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); - /** @pred copy_term(? _TI_,- _TF_) is iso +/** @pred copy_term(? _TI_,- _TF_) is iso - Term _TF_ is a variant of the original term _TI_, such that for - each variable _V_ in the term _TI_ there is a new variable _V'_ - in term _TF_. Notice that: +Term _TF_ is a variant of the original term _TI_, such that for +each variable _V_ in the term _TI_ there is a new variable _V'_ +in term _TF_. Notice that: - + suspended goals and attributes for attributed variables in _TI_ are also duplicated; - + ground terms are shared between the new and the old term. ++ suspended goals and attributes for attributed variables in _TI_ are also duplicated; ++ ground terms are shared between the new and the old term. - If you do not want any sharing to occur please use - duplicate_term/2. +If you do not want any sharing to occur please use +duplicate_term/2. - */ +*/ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); - /** @pred duplicate_term(? _TI_,- _TF_) +/** @pred duplicate_term(? _TI_,- _TF_) - Term _TF_ is a variant of the original term _TI_, such that - for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any - structure. All suspended goals and attributes for attributed variables - in _TI_ are also duplicated. +Term _TF_ is a variant of the original term _TI_, such that +for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any +structure. All suspended goals and attributes for attributed variables +in _TI_ are also duplicated. - Also refer to copy_term/2. +Also refer to copy_term/2. - */ +*/ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); - /** @pred copy_term_nat(? _TI_,- _TF_) +/** @pred copy_term_nat(? _TI_,- _TF_) - As copy_term/2. Attributes however, are not copied but replaced - by fresh variables. +As copy_term/2. Attributes however, are not copied but replaced +by fresh variables. - */ + */ Yap_InitCPred("ground", 1, p_ground, SafePredFlag); - /** @pred ground( _T_) is iso +/** @pred ground( _T_) is iso - Succeeds if there are no free variables in the term _T_. +Succeeds if there are no free variables in the term _T_. - */ +*/ Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); - /** @pred term_variables(? _Term_, - _Variables_) is iso +/** @pred term_variables(? _Term_, - _Variables_) is iso - Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first - appearance when traversing the term depth-first, left-to-right. +Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first +appearance when traversing the term depth-first, left-to-right. - */ +*/ Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); - /** @pred term_attvars(+ _Term_,- _AttVars_) +/** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and - its attributes. I.e., term_attvars/2 works recursively through - attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and +its attributes. I.e., term_attvars/2 works recursively through +attributes. This predicate is Cycle-safe. - */ +*/ Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); - /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) +/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) - The term _TF_ is a forest representation (without cycles and repeated - terms) for the Prolog term _TI_. The term _TF_ is the main term. The - difference list _SubTerms_-_MoreSubterms_ stores terms of the form - _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy - of a sub-term from _TI_. +The term _TF_ is a forest representation (without cycles and repeated +terms) for the Prolog term _TI_. The term _TF_ is the main term. The +difference list _SubTerms_-_MoreSubterms_ stores terms of the form +_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy +of a sub-term from _TI_. - */ +*/ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); - /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) +/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) - Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. +Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. - */ +*/ Yap_InitCPred("=@=", 2, p_variant, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0); - /** @pred numbervars( _T_,+ _N1_,- _Nn_) +/** @pred numbervars( _T_,+ _N1_,- _Nn_) - Instantiates each variable in term _T_ to a term of the form: - `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. +Instantiates each variable in term _T_ to a term of the form: +`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. - */ +*/ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); - /** @pred unnumbervars( _T_,+ _NT_) +/** @pred unnumbervars( _T_,+ _NT_) - Replace every `$VAR( _I_)` by a free variable. +Replace every `$VAR( _I_)` by a free variable. - */ +*/ /* use this carefully */ Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); diff --git a/C/write.c b/C/write.c index d2c49ab89..95df7a945 100644 --- a/C/write.c +++ b/C/write.c @@ -77,8 +77,6 @@ typedef struct write_globs { int last_atom_minus; UInt MaxDepth, MaxArgs; wtype lw; - yhandle_t sl0, sl; - bool protectedEntry; } wglbs; #define lastw wglb->lw @@ -102,10 +100,11 @@ static bool callPortray(Term t, int sno USES_REGS) { return false; } -#define PROTECT(t, F) \ - { \ - F; \ - t = Yap_GetFromSlot(wglb->sl); \ +#define PROTECT(t, F) \ + { \ + yhandle_t yt = Yap_InitHandle(t); \ + F; \ + t = Yap_PopHandle(yt); \ } static void wrputn(Int, struct write_globs *); static void wrputf(Float, struct write_globs *); @@ -117,11 +116,6 @@ static wtype AtomIsSymbols(unsigned char *); static void putAtom(Atom, int, struct write_globs *); static void writeTerm(Term, int, int, int, struct write_globs *, struct rewind_term *); -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt); - -static void write_list(Term t, int direction, int depth, - struct write_globs *wglb, struct rewind_term *rwt); #define wrputc(WF, X) \ (X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */ @@ -273,7 +267,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg, return; } else if (big_tag == BIG_RATIONAL) { Term trat = Yap_RatTermToApplTerm(t); - writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt); + writeTerm(trat, p, depth, rinfixarg, wglb, rwt); return; #endif } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) { @@ -387,7 +381,8 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { struct write_globs wglb; int sno; - sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); + sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding, + 0); if (sno < 0) return false; wglb.lw = separator; @@ -706,9 +701,7 @@ static void write_var(CELL *t, struct write_globs *wglb, wrputs("$AT(", wglb->stream); write_var(t, wglb, rwt); wrputc(',', wglb->stream); - CELL tt = (CELL)t; - PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); - t = (CELL *)tt; + PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt)); attv = RepAttVar(t); wrputc(',', wglb->stream); l++; @@ -725,32 +718,13 @@ static void write_var(CELL *t, struct write_globs *wglb, } } -static bool check_for_loops(Term t, struct write_globs *wglb) -{ - yhandle_t i, sl = wglb->sl; - if ((wglb->Write_Loops)) { - return false; - } - for (i=sl-1; i>wglb->sl0;i--) { - if (Yap_GetFromHandle(i) == t) { - char buf[64]; - snprintf(buf,63," @{ ^^%ld } " ,sl-i); - wrputs(buf, wglb->stream); - return true; - } - } - return false; -} - - -static void write_list__(Term t, yhandle_t sl, int direction, int depth, +static void write_list(Term t, int direction, int depth, struct write_globs *wglb, struct rewind_term *rwt) { Term ti; struct rewind_term nrwt; nrwt.parent = rwt; nrwt.u_sd.s.ptr = 0; - while (1) { int ndirection; int do_jump; @@ -761,18 +735,16 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, break; if (!IsPairTerm(ti)) break; - if (check_for_loops(ti,wglb)) return; - wglb->sl = Yap_InitHandle(ti); ndirection = RepPair(ti) - RepPair(t); /* make sure we're not trapped in loops */ if (ndirection > 0) { do_jump = (direction <= 0); - } /*else if (ndirection == 0) { + } else if (ndirection == 0) { wrputc(',', wglb->stream); putAtom(AtomFoundVar, wglb->Quote_illegal, wglb); lastw = separator; return; - } */ else { + } else { do_jump = (direction >= 0); } if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { @@ -806,24 +778,16 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth, } } -static void write_list(Term t, int direction, int depth, - struct write_globs *wglb, struct rewind_term *rwt) { - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - write_list__(t, sl, direction, depth, - wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; -} - - -static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt) +static void writeTerm(Term t, int p, int depth, int rinfixarg, + struct write_globs *wglb, struct rewind_term *rwt) /* term to write */ /* context priority */ { CACHE_REGS - struct rewind_term nrwt; + struct rewind_term nrwt; + nrwt.parent = rwt; + nrwt.u_sd.s.ptr = 0; + if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; @@ -857,7 +821,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, wrputc('[', wglb->stream); lastw = separator; /* we assume t was already saved in the stack */ - write_list__(t, wglb->sl, 0, depth, wglb, rwt); + write_list(t, 0, depth, wglb, rwt); wrputc(']', wglb->stream); lastw = separator; } @@ -909,7 +873,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, *p++; lastw = separator; /* cannot use the term directly with the SBA */ - writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt); + PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt)); if (*p) wrputc(',', wglb->stream); argno++; @@ -1126,17 +1090,6 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg, } } -static void writeTerm(Term t, int p, int depth, int rinfixarg, - struct write_globs *wglb, struct rewind_term *rwt) -{ - if (check_for_loops(t,wglb)) return; - yhandle_t sl = wglb->sl = Yap_InitHandle(t); - writeTerm__(t, sl, p, depth, rinfixarg, - wglb, rwt); - Yap_PopHandle(sl); - wglb->sl = sl-1; -} - void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority) /* term to be written */ @@ -1171,7 +1124,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, rwt.parent = NULL; wglb.Ignore_ops = flags & Ignore_ops_f; wglb.Write_strings = flags & BackQuote_String_f; - wglb.Write_Loops = flags & YAP_WRITE_HANDLE_CYCLES; if (!(flags & Ignore_cyclics_f) && false) { Term ts[2]; ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS); @@ -1183,8 +1135,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, } } /* protect slots for portray */ - wglb.sl0 = (wglb.sl = Yap_InitHandle(t))-1; - writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt); + writeTerm(t, priority, 1, FALSE, &wglb, &rwt); if (flags & New_Line_f) { if (flags & Fullstop_f) { wrputc('.', wglb.stream); diff --git a/pl/messages.yap b/pl/messages.yap index 9209911f1..a1fb3a93e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -108,7 +108,8 @@ In YAP, the info field describes: :- use_system_module( user, [message_hook/3]). %:- start_low_level_trace. -:- multifile prolog:message/3. +:- dynamic prolog:message//1. +:- multifile prolog:message//1. %:- stop_low_level_trace. :- multifile user:message_hook/3. @@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) --> '$error_descriptor'(Info, Desc), query_exception(prologParserFile, Desc, F0), query_exception(prologParserLine, Desc, L), - F \= F0 + integer(L) +, F \= F0 }, !, [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ]. display_consulting( F, Level, _, LC) --> diff --git a/pl/undefined.yap b/pl/undefined.yap index 963a481a5..811891732 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,7 +97,7 @@ undefined_query(G0, M0, Cut) :- '$undefp'([M0|G0],MG) :- % make sure we do not loop on undefined predicates '$undef_setup'(M0:G0, Action,Debug,Current, MGI), - ('$get_undefined_predicates'(Current, MGI, MG ) , MG) + ('$get_undefined_predicates'( MGI, MG ) , MG) -> true ; @@ -119,10 +119,11 @@ undefined_query(G0, M0, Cut) :- '$handle_error'(fail,_Goal,_Mod) :- fail. -'$undef_setup'(Action,Debug,Current) :- +'$undef_setup'(G0,Action,Debug,Current,GI) :- yap_flag( unknown, Action, fail), yap_flag( debug, Debug, false), - '$stop_creeping'(Current). + '$stop_creeping'(Current), + '$g2i'(G0,GI). '$g2i'(user:G, Na/Ar ) :- !,