diff --git a/C/globals.c b/C/globals.c
index 5f5ec6963..6d6e06d16 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 <em>after</em> 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 <em>after</em> the registration.
*/
@@ -123,7 +123,7 @@ threads that are created <em>after</em> the registration.
special term on the heap. Arenas automatically contract as we add terms to
the front.
- */
+*/
#define QUEUE_FUNCTOR_ARITY 4
@@ -148,12 +148,12 @@ threads that are created <em>after</em> the registration.
static size_t 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) {
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 */
@@ -191,24 +191,24 @@ static Term NewArena(size_t size, int wid, UInt arity, CELL *where) {
size_t 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;
}
@@ -292,30 +292,30 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
CELL *Yap_GetFromArena(Term *arenap, size_t 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;
+ size_t old_sz = ArenaSz(arena), new_size;
- if (IN_BETWEEN(base, HR, max)) {
- base = HR;
- HR += cells;
+ 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;
}
- 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,
@@ -340,6 +340,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
if (IsVarTerm(p)) {
RESET_VARIABLE(p);
} else {
+
/* copy downwards */
TrailTerm(TR0 + 1) = TrailTerm(pt);
TrailTerm(TR0) = TrailTerm(TR0 + 2) = p;
@@ -351,299 +352,6 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
}
}
-#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,
- bool share, bool 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 */
- size_t 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) {
@@ -654,7 +362,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);
@@ -666,7 +374,7 @@ restart:
*HR = t;
Hi = HR + 1;
HR += 2;
- if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi,
+ if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi,
Hi PASS_REGS)) < 0)
goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
@@ -700,7 +408,7 @@ restart:
Hi = HR;
tf = AbsPair(HR);
HR += 2;
- if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi,
+ if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, NULL, copy_att_vars, Hi,
Hi PASS_REGS)) < 0) {
goto error_handler;
}
@@ -778,8 +486,8 @@ restart:
res = -1;
goto error_handler;
}
- if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share,
- copy_att_vars, HB0 + 1, HB0 PASS_REGS)) <
+ if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share,
+ NULL, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) <
0) {
goto error_handler;
}
@@ -787,7 +495,7 @@ restart:
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;
@@ -835,7 +543,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;
@@ -984,8 +692,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;
@@ -1028,8 +736,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)) {
@@ -1110,8 +818,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);
@@ -1164,9 +872,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;
}
@@ -1194,8 +902,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;
@@ -1225,12 +933,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);
@@ -1241,10 +949,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;
@@ -1274,8 +982,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);
@@ -1359,7 +1067,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);
@@ -1417,7 +1125,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);
}
@@ -1552,7 +1260,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;
@@ -1860,8 +1568,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;
@@ -1959,7 +1667,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) {
@@ -2127,8 +1835,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;
@@ -2159,7 +1867,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 */
@@ -2203,7 +1911,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;
@@ -2277,7 +1985,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;
@@ -2497,7 +2205,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;
@@ -2598,7 +2306,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);
@@ -2606,22 +2314,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.
*/
@@ -2630,18 +2338,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.
*/
@@ -2649,25 +2357,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)) ?
+ ~~~~~
*/
@@ -2675,26 +2383,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)
+ ).
+ ~~~~~
*/
@@ -2706,31 +2414,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)
+ ).
+ ~~~~~
*/
@@ -2739,9 +2447,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.
*/
@@ -2750,9 +2458,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.
*/
@@ -2760,20 +2468,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,
@@ -2817,5 +2525,5 @@ void Yap_InitGlobals(void) {
}
/**
-@}
+ @}
*/
diff --git a/C/modules.c b/C/modules.c
index 798e05cb5..465025b20 100644
--- a/C/modules.c
+++ b/C/modules.c
@@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "Yatom.h"
-static Int currgent_module(USES_REGS1);
+static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a);
static ModEntry *LookupSystemModule(Term a);
diff --git a/C/stack.c b/C/stack.c
index 4c67b57e4..618aedf02 100644
--- a/C/stack.c
+++ b/C/stack.c
@@ -2134,7 +2134,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) {
void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */
void *ep = YENV; /* and current environment */
- void *cp;
+ void *cp ;
PredEntry *pe;
struct buf_struct_t buf0, *bufp = &buf0;
diff --git a/C/utilpreds.c b/C/utilpreds.c
index 2a60761b5..cdf66b7d5 100644
--- a/C/utilpreds.c
+++ b/C/utilpreds.c
@@ -45,91 +45,92 @@ typedef struct non_single_struct_t {
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);\
- 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 = TermNil;\
- pt0_end = pt0 + 1;\
- 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)) {\
-\
- 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__(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; \
+ 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)) { \
+ \
+ 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_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_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() \
+#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; }
+ 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 p_non_singletons_in_term( USES_REGS1);
@@ -139,7 +140,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 int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE);
static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
#ifdef DEBUG
@@ -158,269 +158,320 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) {
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++);
+ 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 {
RESET_VARIABLE(p);
- } while (pt != TR);
- TR = TR0;
- }
+ }
+ }
+ TR = TR0;
}
-static int
-copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS)
-{
+#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;
- 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 = HR;
+ 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;
+
+ ptd0 = ++pt0;
d0 = *ptd0;
+ deref:
deref_head(d0, copy_term_unk);
- copy_term_nvar:
- {
+ copy_term_nvar : {
if (IsPairTerm(d0)) {
- CELL *ap2 = RepPair(d0);
- if (ap2 >= HB && ap2 < HR) {
- /* If this is newer than the current term, just reuse */
- *ptf++ = d0;
- continue;
- }
- *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->oldv = *pt0;
- to_visit->ground = ground;
- /* 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;
- }
- } 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)) {
-#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++ = d0; /* you can just copy other extensions. */
- } else
-#endif
- 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;
- }
- memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
- HR += sz;
- } else {
- *ptf++ = d0; /* you can just copy other extensions. */
- }
- continue;
- }
- *ptf = AbsAppl(HR);
- ptf++;
- /* store the terms to visit */
- 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->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;
- }
- } else {
- /* just copy atoms or integers */
- *ptf++ = d0;
- }
- continue;
- }
-
- derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
- ground = FALSE;
- if (ptd0 >= HLow && ptd0 < HR) {
- /* we have already found this cell */
- *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)) {
- 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)) {
- goto trail_overflow;
+ CELL *headp = RepPair(d0);
+ if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) {
+ if (split) {
+ Term v = Yap_MkNewApplTerm(FunctorEq, 2);
+ RepAppl(v)[1] = *headp;
+ *headp = *ptf++ = RepAppl(v)[0];
+ o = MkPairTerm( v, o );
+ } else {
+ /* If this is newer than the current term, just reuse */
+ *ptf++ = (CELL)RepAppl(*headp);
}
}
- Bind_NonAtt(ptd0, (CELL)ptf);
- ptf++;
+ else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
+ *ptf++ = AbsPair(RepAppl(*headp));
+ continue;
}
- }
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit --;
- if (ground && share) {
- CELL old = to_visit->oldv;
- CELL *newp = to_visit->to-1;
- CELL new = *newp;
+ if (to_visit >= to_visit_max-32) {
+ expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
+ }
+ *ptf = AbsPair(HR);
+ ptf++;
+ to_visit->start_cp = pt0;
+ to_visit->end_cp = pt0_end;
+ to_visit->to = ptf;
+ to_visit->curp = headp;
+ d0 = *headp;
+ to_visit->oldv = d0;
+ to_visit->ground = ground;
+ to_visit++;
+ // move to new list
+ if (share) {
+ TrailedMaBind(headp,AbsPair(HR));
+ } else {
+ *headp = AbsPair(HR);
+ }
+ pt0 = headp;
+ pt0_end = headp + 1;
+ ptf = HR;
+ ground = true;
+ HR += 2;
+ if (HR > ASP - MIN_ARENA_SIZE) {
+ goto overflow;
+ }
+ ptd0 = pt0;
+ goto deref;
+ } else if (IsApplTerm(d0)) {
+ register Functor f;
+ register CELL *headp;
+ /* store the terms to visit */
+ headp = RepAppl(d0);
+ if (IsPairTerm(*headp)//(share && headp < HB) ||
+ ) {
+ if (split) {
+ Term v = Yap_MkNewApplTerm(FunctorEq, 2);
+ RepAppl(v)[1] = *headp;
+ *headp = *ptf++ = RepAppl(v)[0];
+ o = MkPairTerm( v, o );
+ } else {
+ /* If this is newer than the current term, just reuse */
+ *ptf++ = AbsPair(RepAppl(*headp));
+ }
+ continue;
+ }
+ f = (Functor)(*headp);
- *newp = old;
- if (IsApplTerm(new))
- HR = RepAppl(new);
- else
- HR = RepPair(new);
+ if (IsExtensionFunctor(f)) {
+ if (share) {
+ *ptf++ = d0;
+ continue;
+ }
+ 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] = 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;
+#endif
+ break;
+ case (CELL) FunctorString:
+ if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) {
+ 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];
+
+ }
+ HR += sz;
+ }
+ }
+ continue;
+ }
+ *ptf = AbsAppl(HR);
+ ptf++;
+ /* store the terms to visit */
+ to_visit->start_cp = pt0;
+ to_visit->end_cp = pt0_end;
+ to_visit->to = ptf;
+ to_visit->curp = headp;
+ d0 = *headp;
+ to_visit->oldv = d0;
+ to_visit->ground = ground;
+ if (++to_visit >= to_visit_max-32) {
+ expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
+ }
+ if (share) {
+ TrailedMaBind(headp,AbsPair(HR));
+ } else {
+ *headp = AbsPair(HR);
+ }
+ ptf = HR;
+ ptf[-1] = (CELL)f;
+ ground = true;
+ arity_t a = ArityOfFunctor(f);
+ HR = ptf+a;
+ if (HR > ASP - MIN_ARENA_SIZE) {
+ goto overflow;
+ }
+ pt0 = headp;
+ pt0_end = headp+a;
+ ground = (f != FunctorMutable);
+ } else {
+ /* just copy atoms or integers */
+ *ptf++ = d0;
}
- 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;
+ continue;
}
- /* restore our nice, friendly, term to its original state */
- clean_dirty_tr(TR0 PASS_REGS);
- HB = HB0;
- return ground;
+ 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 (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
+ /* if unbound, call the standard copy term routine */
+ struct cp_frame *bp;
+ CELL new;
- 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);
- /* follow chain of multi-assigned variables */
- 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;
- 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;
- }
- {
- tr_fr_ptr oTR = TR;
- reset_trail(TR0);
- if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
- return -4;
+ 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;
+ }
+ }
+ TrailedMaBind(ptd0, new);
+ ptf++;
+ } else {
+ /* first time we met this term */
+ RESET_VARIABLE(ptf);
+ if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
+ goto trail_overflow;
+ TrailedMaBind(ptd0, (CELL)ptf);
+ ptf++;
}
- 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);
- LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
- return -3;
+/* Do we still have compound terms to visit */
+if (to_visit > to_visit0) {
+ to_visit--;
+ if (!share)
+ *to_visit->curp = to_visit->oldv;
+ pt0 = to_visit->start_cp;
+ pt0_end = to_visit->end_cp;
+ ptf = to_visit->to;
+ ground = (ground && to_visit->ground);
+ goto loop;
+ }
+
+/* restore our nice, friendly, term to its original state */
+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;
+while (to_visit > to_visit0) {
+ to_visit--;
+ pt0 = to_visit->start_cp;
+ pt0_end = to_visit->end_cp;
+ ptf = to_visit->to;
+ }
+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;
+while (to_visit > to_visit0) {
+ to_visit--;
+ pt0 = to_visit->start_cp;
+ pt0_end = to_visit->end_cp;
+ ptf = to_visit->to;
+ }
+reset_trail(TR0);
+pop_text_stack(lvl);
+return -4;
}
@@ -476,7 +527,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
*HR = t;
Hi = HR+1;
HR += 2;
- if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
+ if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) {
HR = Hi-1;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@@ -500,7 +551,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
HR += 2;
{
int res;
- if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
+ if ((res = Yap_copy_complex_term(ap-1, ap+1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) {
HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@@ -532,7 +583,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
} else {
int res;
- if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
+ if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, NULL, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE;
@@ -639,9 +690,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te
copy_term_nvar:
{
if (IsPairTerm(d0)) {
- CELL *ap2 = RepPair(d0);
- //fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf);
- if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) {
+ CELL *headp = RepPair(d0);
+ //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf);
+ if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) {
Term v = MkVarTerm();
*ptf = v;
vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) );
@@ -655,19 +706,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 = ap2;
- d0 = to_visit->oldv = ap2[0];
+ to_visit->oldp = headp;
+ d0 = to_visit->oldv = headp[0];
/* fool the system into thinking we had a variable there */
to_visit ++;
- pt0 = ap2;
- pt0_end = ap2 + 1;
+ pt0 = headp;
+ pt0_end = headp + 1;
ptf = HR;
- *ap2 = AbsPair(HR);
+ *headp = AbsPair(HR);
HR += 2;
if (HR > ASP - 2048) {
goto overflow;
}
- if (IsVarTerm(d0) && d0 == (CELL)ap2) {
+ if (IsVarTerm(d0) && d0 == (CELL)headp) {
RESET_VARIABLE(ptf);
ptf++;
continue;
@@ -681,17 +732,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 *ap2;
+ register CELL *headp;
/* store the terms to visit */
- ap2 = RepAppl(d0)+1;
- f = (Functor)(ap2[-1]);
+ headp = RepAppl(d0)+1;
+ f = (Functor)(headp[-1]);
if (IsExtensionFunctor(f)) {
*ptf++ = d0; /* you can just copy other extensions. */
continue;
}
- if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) {
+ if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) {
RESET_VARIABLE(ptf);
- vin = add_to_list(vin, (CELL)ptf, ap2[0] );
+ vin = add_to_list(vin, (CELL)ptf, headp[0] );
ptf++;
continue;
}
@@ -704,24 +755,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 = ap2;
- d0 = to_visit->oldv = ap2[0];
+ to_visit->oldp = headp;
+ d0 = to_visit->oldv = headp[0];
/* fool the system into thinking we had a variable there */
to_visit ++;
- pt0 = ap2;
- pt0_end = ap2 + (arity-1);
+ pt0 = headp;
+ pt0_end = headp + (arity-1);
ptf = HR;
if (HR > ASP - 2048) {
goto overflow;
}
*ptf++ =(CELL)f;
- *ap2 = AbsAppl(HR);
+ *headp = 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;
@@ -883,7 +929,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 */
- MaBind(pt0, new);
+ TrailedMaBind(pt0, new);
new = 0L;
}
deref_head(d0, break_rationals_unk);
@@ -1641,7 +1687,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
+ register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL output = AbsPair(HR);
@@ -1656,8 +1702,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
list_loop:
deref_head(d0, vars_in_term_unk);
vars_in_term_nvar:
- WALK_COMPLEX_TERM();
- continue ;
+ WALK_COMPLEX_TERM();
+ continue ;
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
/* do or pt2 are unbound */
@@ -1680,14 +1726,14 @@ 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--;
+ to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
goto loop;
- }
+ }
clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl);
@@ -1884,63 +1930,63 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit+1024;
- register tr_fr_ptr TR0 = TR;
+ register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL output = AbsPair(HR);
restart:
- 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();
- continue;
- }
-
-
- 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;
- /* leave an empty slot to fill in later */
- if (HR+1024 > ASP) {
- goto global_overflow;
- }
- HR[1] = AbsPair(HR+2);
- HR += 2;
- HR[-2] = (CELL)&(a0->Done);
- /* 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;
- pt0 = ptd0;
- pt0_end = &RepAttVar(ptd0)->Atts;
- }
+ 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();
+ continue;
}
- /* Do we still have compound terms to visit */
- if (to_visit > to_visit0) {
- to_visit--;
+
+
+ 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;
+ /* leave an empty slot to fill in later */
+ if (HR+1024 > ASP) {
+ goto global_overflow;
+ }
+ HR[1] = AbsPair(HR+2);
+ HR += 2;
+ HR[-2] = (CELL)&(a0->Done);
+ /* 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;
+ pt0 = ptd0;
+ pt0_end = &RepAttVar(ptd0)->Atts;
+ }
+ }
+ /* 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;
- }
+ }
clean_tr(TR0 PASS_REGS);
@@ -2088,7 +2134,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
- to_visit--;
+ to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
@@ -2181,7 +2227,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
deref_head(d0, vars_within_term_unk);
vars_within_term_nvar:
{
- WALK_COMPLEX_TERM();
+ WALK_COMPLEX_TERM();
continue;
}
@@ -2207,7 +2253,7 @@ 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--;
+ to_visit--;
pt0 = to_visit->pt0;
pt0_end = to_visit->pt0_end;
@@ -2269,9 +2315,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit+1024;
+ Term o = TermNil;
CELL *InitialH = HR;
- *HR++ = MkAtomTerm(AtomDollar);
-
to_visit0 = to_visit;
restart:
while (pt0 < pt0_end) {
@@ -2284,8 +2329,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
deref_head(d0, vars_within_term_unk);
vars_within_term_nvar:
{
- WALK_COMPLEX_TERM()
- continue;
+ WALK_COMPLEX_TERM();
+ continue;
}
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
@@ -2293,10 +2338,13 @@ 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 ++;
+ HR[1] = o;
+ o = AbsPair(HR);
+ HR += 2;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
@@ -2318,13 +2366,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
}
clean_tr(TR0 PASS_REGS);
-pop_text_stack(lvl);
- if (HR > InitialH+1) {
- InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
- return AbsAppl(InitialH);
- } else {
- return MkAtomTerm(AtomDollar);
- }
+ pop_text_stack(lvl);
+ return o;
def_trail_overflow();
@@ -2336,7 +2379,7 @@ pop_text_stack(lvl);
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();
+ **to_visit = (CELL **)Yap_PreAllocCodeSpace();
CELL *InitialH = HR;
to_visit0 = to_visit;
@@ -2678,7 +2721,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
return true;
def_aux_overflow();
- }
+}
bool Yap_IsGroundTerm(Term t)
{
@@ -4330,11 +4373,11 @@ extern int vsc;
int vsc;
-#define RENUMBER_SINGLES\
- if (singles && ap2 >= InitialH && ap2 < HR) {\
- renumbervar(d0, numbv++ PASS_REGS);\
- continue;\
- }
+#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)
diff --git a/C/yap-args.c b/C/yap-args.c
index f03161571..ccd7083fe 100755
--- a/C/yap-args.c
+++ b/C/yap-args.c
@@ -175,7 +175,7 @@ static bool load_file(const char *b_file USES_REGS) {
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file);
if (c_stream < 0) {
- fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file);
+ fprintf(stderr, "[ FATAL ERROR: could not open file %s\n", b_file);
pop_text_stack(lvl);
exit(1);
}
@@ -185,7 +185,7 @@ static bool load_file(const char *b_file USES_REGS) {
}
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file);
-
+ t = 0;
while (t != TermEof) {
CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false);
diff --git a/H/TermExt.h b/H/TermExt.h
index fed59fcbd..ccd1eb827 100755
--- a/H/TermExt.h
+++ b/H/TermExt.h
@@ -111,10 +111,9 @@ typedef struct cp_frame {
CELL *start_cp;
CELL *end_cp;
CELL *to;
-#ifdef RATIONAL_TREES
+ CELL *curp;
CELL oldv;
int ground;
-#endif
} copy_frame;
#ifdef COROUTINING
diff --git a/H/Yapproto.h b/H/Yapproto.h
index 4171421b4..4750e4d5b 100755
--- a/H/Yapproto.h
+++ b/H/Yapproto.h
@@ -477,6 +477,9 @@ extern void Yap_InitUserCPreds(void);
extern void Yap_InitUserBacks(void);
/* utilpreds.c */
+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);
extern Term Yap_CopyTerm(Term);
extern bool Yap_Variant(Term, Term);
extern size_t Yap_ExportTerm(Term, char *, size_t, UInt);
diff --git a/H/amiops.h b/H/amiops.h
index 12514a8c9..44718dae2 100644
--- a/H/amiops.h
+++ b/H/amiops.h
@@ -418,6 +418,12 @@ extern void Yap_WakeUp(CELL *v);
*(VP) = (D); \
}
+#define TrailedMaBind(VP, D) \
+ { \
+ DO_MATRAIL((VP), *(VP), (D)); \
+ *(VP) = (D); \
+ }
+
/************************************************************
Unification Routines
diff --git a/packages/clpqr/clpq/itf_q.pl b/packages/clpqr/clpq/itf_q.pl
index 7add42fa7..0b6020e40 100644
--- a/packages/clpqr/clpq/itf_q.pl
+++ b/packages/clpqr/clpq/itf_q.pl
@@ -62,7 +62,7 @@
[
class_drop/2
]).
-
+
do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),
verify_nonzero(No,Y),
@@ -76,7 +76,7 @@ numbers_only(Y) :-
; throw(type_error(_X = Y,2,'a rational number',Y))
),
!.
-
+ΓΈ
% verify_nonzero(Nonzero,Y)
%
% if Nonzero = nonzero, then verify that Y is not zero
diff --git a/packages/clpqr/clpqr/geler.pl b/packages/clpqr/clpqr/geler.pl
index b3fd410bf..e04c3ce60 100644
--- a/packages/clpqr/clpqr/geler.pl
+++ b/packages/clpqr/clpqr/geler.pl
@@ -43,6 +43,10 @@
project_nonlin/3,
collect_nonlin/3
]).
+:- use_module(library(maplist),
+ [
+ maplist/2
+ ]).
% l2conj(List,Conj)
%
diff --git a/packages/clpqr/clpqr/itf.pl b/packages/clpqr/clpqr/itf.pl
index 427d13ea0..43907c049 100644
--- a/packages/clpqr/clpqr/itf.pl
+++ b/packages/clpqr/clpqr/itf.pl
@@ -47,6 +47,10 @@
dump_nonzero/3,
clp_type/2
]).
+:- use_module(library(maplist),
+ [
+ maplist/2
+ ]).
clp_type(Var,Type) :-
diff --git a/packages/clpqr/clpr/itf_r.pl b/packages/clpqr/clpr/itf_r.pl
index 753e2037b..ec1754311 100644
--- a/packages/clpqr/clpr/itf_r.pl
+++ b/packages/clpqr/clpr/itf_r.pl
@@ -63,6 +63,10 @@
[
class_drop/2
]).
+:- use_module(library(maplist),
+ [
+ maplist/2
+ ]).
do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),
diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt
index 9e7415b5e..2da29d17b 100644
--- a/packages/jpl/src/c/CMakeLists.txt
+++ b/packages/jpl/src/c/CMakeLists.txt
@@ -1,5 +1,6 @@
# set(CMAKE_MACOSX_RPATH 1)
+
add_library(jplYap jpl.c)
include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} )
diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c
index ae7d24eb0..af40c856d 100755
--- a/packages/jpl/src/c/jpl.c
+++ b/packages/jpl/src/c/jpl.c
@@ -48,12 +48,12 @@ refactoring (trivial):
#define JPL_C_LIB_VERSION_PATCH 4
#define JPL_C_LIB_VERSION_STATUS "alpha"
-#define JPL_DEBUG
+//#define JPL_DEBUG
#ifndef JPL_DEBUG
/*#define DEBUG(n, g) ((void)0) */
#define DEBUG_LEVEL 4
-#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 )
+#define JPL_DEBUG(n, g) ( false && n >= DEBUG_LEVEL ? g : (void)0 )
#endif
/* disable type-of-ref caching (at least until GC issues are resolved) */
@@ -642,7 +642,7 @@ static JNIEnv*
jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */
{ JNIEnv *env;
- switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_9) )
+ switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_2) )
{ case JNI_OK:
return env;
case JNI_EDETACHED:
@@ -1826,7 +1826,7 @@ jni_create_jvm_c(
JNIEnv *env;
JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath));
- vm_args.version = JNI_VERSION_1_6zzzz; /* "Java 1.2 please" */
+ vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */
if ( classpath )
{
cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1);
diff --git a/packages/python/pybips.c b/packages/python/pybips.c
index 7a7c30e35..18a26bea8 100644
--- a/packages/python/pybips.c
+++ b/packages/python/pybips.c
@@ -635,8 +635,9 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) {
typp = (PyTypeObject *)d;
} else {
PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1);
- desc->name = PyMem_Malloc(strlen(s) + 1);
- strcpy((char *)desc->name, s);
+ char *tnp;
+ desc->name = tnp = PyMem_Malloc(strlen(s) + 1);
+ strcpy(tnp, s);
desc->doc = "YAPTerm";
desc->fields = pnull;
desc->n_in_sequence = arity;
diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c
index 9b357ea6a..c51fe48a7 100644
--- a/packages/python/pypreds.c
+++ b/packages/python/pypreds.c
@@ -1,4 +1,15 @@
+
+
+
+
+
+
+
+
+
+
+
#include "Yap.h"
#include "py4yap.h"
diff --git a/pl/android.yap b/pl/android.yap
index 488204c7c..6de2bfcfd 100644
--- a/pl/android.yap
+++ b/pl/android.yap
@@ -1,8 +1,6 @@
-%:- start_low_level_trace.
-
-%:- module(android,
-% [text_to_query/2]).
+:- module(android,
+ [text_to_query/2]).
:- initialization(yap_flag(verbose,_,normal)).
diff --git a/pl/undefined.yap b/pl/undefined.yap
index 016ca7cf3..0041a7811 100644
--- a/pl/undefined.yap
+++ b/pl/undefined.yap
@@ -67,21 +67,9 @@ followed by the failure of that call.
:- multifile user:unknown_predicate_handler/3.
undefined_query(G0, M0, Cut) :-
- recorded('$import','$import'(M,M0,G,G0,_,_),_),
- '$call'(G, Cut, G, M).
+ recorded('$import','$import'(M,M0,G,G0,_,_),_),
+ '$call'(G, Cut, G, M).
-'$handle_error'(error,Goal,Mod) :-
- functor(Goal,Name,Arity),
- '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal).
-'$handle_error'(warning,Goal,Mod) :-
- functor(Goal,Name,Arity),
- 'program_continuation'(PMod,PName,PAr),
- print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
- fail.
-'$handle_error'(fail,_Goal,_Mod) :-
- fail.
-
-:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
/**
* @pred '$undefp_search'(+ M0:G0, -MG)
@@ -103,43 +91,48 @@ undefined_query(G0, M0, Cut) :-
user:unknown_predicate_handler(GM0,EM0,MG),
!.
'$undefp_search'(M0:G0, MG) :-
-'$get_undefined_predicates'(M0:G0, MG), !.
+ '$get_undefined_predicates'(M0:G0, MG), !.
% undef handler
'$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates
- '$undef_set'(Action,Debug,Current),
- '$search_def'(M0:G0,MG,Action,Debug,Current).
+ '$undef_setup'(Action,Debug,Current),
+ ('$get_undefined_predicates'(M0:G0, MG)
+ ->
+ true
+ ;
+ '$undef_error'(M0:G0, MG)
+ ),
+ '$undef_cleanup'(Action,Debug,Current).
-'$undef_set'(Action,Debug,Current) :-
- yap_flag( unknown, Action, fail),
+'$undef_error'(M0:G0, MG) :-
+ '$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
+ '$yap_strip_module'(M0:G0, EM0, GM0),
+ user:unknown_predicate_handler(GM0,EM0,MG),
+ !.
+'$handle_error'(Mod:Goal,_) :-
+ functor(Goal,Name,Arity),
+ '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal).
+'$handle_error'(warning,Goal,Mod) :-
+ functor(Goal,Name,Arity),
+ 'program_continuation'(PMod,PName,PAr),
+ print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
+ fail.
+'$handle_error'(fail,_Goal,_Mod) :-
+ fail.
+
+'$undef_setup'(Action,Debug,Current) :-
+ yap_flag( unknown, Action, fail),
yap_flag( debug, Debug, false),
'$stop_creeping'(Current).
-'$search_def'(M0:G0,NM:NG,Action,Debug,Current) :-
- '$undefp_search'(M0:G0, NM:NG),
- '$pred_exists'(NG,NM),
- !,
+'$undef_cleanup'(Action,Debug,_Current) :-
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug),
- nonvar(NG),
- nonvar(NM),
- (
- Current == true
- ->
- % carry on signal processing
- '$start_creep'([NM|NG], creep)
- ;
- '$execute0'(NG, NM)
- ).
-'$search_def'(M0:G0,_,Action,Debug,_Current) :-
- yap_flag( unknown, _, Action),
- yap_flag( debug, _, Debug),
-'$start_creep'([prolog|true], creep),
-'$handle_error'(Action,G0,M0).
+ '$start_creep'([prolog|true], creep).
-:- '$undefp_handler'('$undefp'(_,_), prolog).
+ :- '$undefp_handler'('$undefp'(_,_), prolog).
/** @pred unknown(- _O_,+ _N_)