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

merge

Browse Source
This commit is contained in:
Vítor Santos Costa 2019-01-23 18:16:13 +00:00
commit e0467d95d4
18 changed files with 784 additions and 1009 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

466
C/globals.c
View File

@ -1,19 +1,19 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: non backtrackable term support * * File: non backtrackable term support *
* Last rev: 2/8/06 * * Last rev: 2/8/06 *
* mods: * * mods: *
* comments: non-backtrackable term support * * comments: non-backtrackable term support *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
@ -31,81 +31,81 @@ static char SccsId[] = "%W% %G%";
/** /**
@defgroup Global_Variables Global Variables @defgroup Global_Variables Global Variables
@ingroup builtins @ingroup builtins
@{ @{
Global variables are associations between names (atoms) and Global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using terms. They differ in various ways from storing information using
assert/1 or recorda/3. assert/1 or recorda/3.
+ The value lives on the Prolog (global) stack. This implies that + The value lives on the Prolog (global) stack. This implies that
lookup time is independent from the size of the term. This is lookup time is independent from the size of the term. This is
particularly interesting for large data structures such as parsed XML particularly interesting for large data structures such as parsed XML
documents or the CHR global constraint store. documents or the CHR global constraint store.
+ They support both global assignment using nb_setval/2 and + They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2. backtrackable assignment using b_setval/2.
+ Only one value (which can be an arbitrary complex Prolog term) + Only one value (which can be an arbitrary complex Prolog term)
can be associated to a variable at a time. can be associated to a variable at a time.
+ Their value cannot be shared among threads. Each thread has its own + Their value cannot be shared among threads. Each thread has its own
namespace and values for global variables. namespace and values for global variables.
Currently global variables are scoped globally. We may consider module Currently global variables are scoped globally. We may consider module
scoping in future versions. Both b_setval/2 and scoping in future versions. Both b_setval/2 and
nb_setval/2 implicitly create a variable if the referenced name nb_setval/2 implicitly create a variable if the referenced name
does not already refer to a variable. does not already refer to a variable.
Global variables may be initialized from directives to make them Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store necessary for saved-states and threads. Saved-states to not store
global variables, which implies they have to be declared with global variables, which implies they have to be declared with
initialization/1 to recreate them after loading the saved initialization/1 to recreate them after loading the saved
state. Each thread has its own set of global variables, starting with state. Each thread has its own set of global variables, starting with
an empty set. Using `thread_initialization/1` to define a global an empty set. Using `thread_initialization/1` to define a global
variable it will be defined, restored after reloading a saved state variable it will be defined, restored after reloading a saved state
and created in all threads that are created after the and created in all threads that are created after the
registration. Finally, global variables can be initialized using the registration. Finally, global variables can be initialized using the
exception hook called exception/3. The latter technique is used exception hook called exception/3. The latter technique is used
by CHR. by CHR.
SWI-Prolog global variables are associations between names (atoms) and SWI-Prolog global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using terms. They differ in various ways from storing information using
assert/1 or recorda/3. assert/1 or recorda/3.
+ The value lives on the Prolog (global) stack. This implies + The value lives on the Prolog (global) stack. This implies
that lookup time is independent from the size of the term. that lookup time is independent from the size of the term.
This is particulary interesting for large data structures This is particulary interesting for large data structures
such as parsed XML documents or the CHR global constraint such as parsed XML documents or the CHR global constraint
store. store.
They support both global assignment using nb_setval/2 and They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2. backtrackable assignment using b_setval/2.
+ Only one value (which can be an arbitrary complex Prolog + Only one value (which can be an arbitrary complex Prolog
term) can be associated to a variable at a time. term) can be associated to a variable at a time.
+ Their value cannot be shared among threads. Each thread + Their value cannot be shared among threads. Each thread
has its own namespace and values for global variables. has its own namespace and values for global variables.
+ Currently global variables are scoped globally. We may + Currently global variables are scoped globally. We may
consider module scoping in future versions. consider module scoping in future versions.
Both b_setval/2 and nb_setval/2 implicitly create a variable if the Both b_setval/2 and nb_setval/2 implicitly create a variable if the
referenced name does not already refer to a variable. referenced name does not already refer to a variable.
Global variables may be initialized from directives to make them Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store global necessary for saved-states and threads. Saved-states to not store global
variables, which implies they have to be declared with initialization/1 variables, which implies they have to be declared with initialization/1
to recreate them after loading the saved state. Each thread has to recreate them after loading the saved state. Each thread has
its own set of global variables, starting with an empty set. Using its own set of global variables, starting with an empty set. Using
`thread_inititialization/1` to define a global variable it will be `thread_inititialization/1` to define a global variable it will be
defined, restored after reloading a saved state and created in all defined, restored after reloading a saved state and created in all
threads that are created <em>after</em> the registration. 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 special term on the heap. Arenas automatically contract as we add terms to
the front. the front.
*/ */
#define QUEUE_FUNCTOR_ARITY 4 #define QUEUE_FUNCTOR_ARITY 4
@ -292,7 +292,7 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) {
CACHE_REGS CACHE_REGS
restart : { restart : {
Term arena = *arenap; Term arena = *arenap;
CELL *max = ArenaLimit(arena); CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena); CELL *base = ArenaPt(arena);
@ -315,7 +315,7 @@ restart : {
new_size = old_sz - cells; new_size = old_sz - cells;
*arenap = CreateNewArena(newH, new_size); *arenap = CreateNewArena(newH, new_size);
return base; return base;
} }
} }
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, 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)) { if (IsVarTerm(p)) {
RESET_VARIABLE(p); RESET_VARIABLE(p);
} else { } else {
/* copy downwards */ /* copy downwards */
TrailTerm(TR0 + 1) = TrailTerm(pt); TrailTerm(TR0 + 1) = TrailTerm(pt);
TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; 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, static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
UInt arity, Term *newarena, UInt arity, Term *newarena,
size_t min_grow USES_REGS) { 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; int res = 0;
Term tn; Term tn;
restart: restart:
t = Deref(t); t = Deref(t);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
@ -666,7 +374,7 @@ restart:
*HR = t; *HR = t;
Hi = HR + 1; Hi = HR + 1;
HR += 2; 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) Hi PASS_REGS)) < 0)
goto error_handler; goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
@ -700,7 +408,7 @@ restart:
Hi = HR; Hi = HR;
tf = AbsPair(HR); tf = AbsPair(HR);
HR += 2; 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) { Hi PASS_REGS)) < 0) {
goto error_handler; goto error_handler;
} }
@ -778,8 +486,8 @@ restart:
res = -1; res = -1;
goto error_handler; goto error_handler;
} }
if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share,
copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < NULL, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) <
0) { 0) {
goto error_handler; goto error_handler;
} }
@ -787,7 +495,7 @@ restart:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return tf; return tf;
} }
error_handler: error_handler:
HR = HB; HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity + 1] = t; 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); Functor f = Yap_MkFunctor(Na, Nar);
UInt i; UInt i;
restart: restart:
HR = HB = ArenaPt(arena); HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena); ASP = ArenaLimit(arena);
HB0 = HR; HB0 = HR;
@ -1959,7 +1667,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) {
if (!qd) if (!qd)
return FALSE; return FALSE;
restart: restart:
hsize = IntegerOfTerm(qd[HEAP_SIZE]); hsize = IntegerOfTerm(qd[HEAP_SIZE]);
hmsize = IntegerOfTerm(qd[HEAP_MAX]); hmsize = IntegerOfTerm(qd[HEAP_MAX]);
if (hsize == hmsize) { if (hsize == hmsize) {
@ -2497,7 +2205,7 @@ static Int p_nb_beam_keys(USES_REGS1) {
CELL *pt, *ho; CELL *pt, *ho;
UInt i; UInt i;
restart: restart:
qd = GetHeap(ARG1, "beam_keys"); qd = GetHeap(ARG1, "beam_keys");
if (!qd) if (!qd)
return FALSE; return FALSE;
@ -2817,5 +2525,5 @@ void Yap_InitGlobals(void) {
} }
/** /**
@} @}
*/ */

2
C/modules.c
View File

@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h" #include "YapHeap.h"
#include "Yatom.h" #include "Yatom.h"
static Int currgent_module(USES_REGS1); static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1); static Int current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a); static ModEntry *LookupModule(Term a);
static ModEntry *LookupSystemModule(Term a); static ModEntry *LookupSystemModule(Term a);

2
C/stack.c
View File

@ -2134,7 +2134,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) {
void DumpActiveGoals(USES_REGS1) { void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */ /* try to dump active goals */
void *ep = YENV; /* and current environment */ void *ep = YENV; /* and current environment */
void *cp; void *cp ;
PredEntry *pe; PredEntry *pe;
struct buf_struct_t buf0, *bufp = &buf0; struct buf_struct_t buf0, *bufp = &buf0;

607
C/utilpreds.c
View File

@ -46,89 +46,90 @@ typedef struct non_single_struct_t {
} non_singletons_t; } non_singletons_t;
#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ #define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \
if (IsPairTerm(d0)) {\ if (IsPairTerm(d0)) { \
if (to_visit + 32 >= to_visit_max) {\ if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow;\ goto aux_overflow; \
}\ } \
LIST0;\ LIST0; \
ptd0 = RepPair(d0);\ ptd0 = RepPair(d0); \
to_visit->pt0 = pt0;\ if (*ptd0 == TermFreeTerm) continue; \
to_visit->pt0_end = pt0_end;\ to_visit->pt0 = pt0; \
to_visit->ptd0 = ptd0;\ to_visit->pt0_end = pt0_end; \
to_visit->d0 = *ptd0;\ to_visit->ptd0 = ptd0; \
to_visit ++;\ to_visit->d0 = *ptd0; \
d0 = ptd0[0];\ to_visit ++; \
pt0 = ptd0;\ d0 = ptd0[0]; \
*ptd0 = TermNil;\ pt0 = ptd0; \
pt0_end = pt0 + 1;\ *ptd0 = TermFreeTerm; \
goto list_loop;\ pt0_end = pt0 + 1; \
} else if (IsApplTerm(d0)) {\ goto list_loop; \
register Functor f;\ } else if (IsApplTerm(d0)) { \
register CELL *ap2;\ register Functor f; \
/* store the terms to visit */\ register CELL *ap2; \
ap2 = RepAppl(d0);\ /* store the terms to visit */ \
f = (Functor)(*ap2);\ ap2 = RepAppl(d0); \
\ f = (Functor)(*ap2); \
if (IsExtensionFunctor(f)) {\ \
\ if (IsExtensionFunctor(f)) { \
continue;\ \
}\ continue; \
STRUCT0;\ } \
if (to_visit + 32 >= to_visit_max) {\ STRUCT0; \
goto aux_overflow;\ if (to_visit + 32 >= to_visit_max) { \
}\ goto aux_overflow; \
to_visit->pt0 = pt0;\ } \
to_visit->pt0_end = pt0_end;\ to_visit->pt0 = pt0; \
to_visit->ptd0 = ap2;\ to_visit->pt0_end = pt0_end; \
to_visit->d0 = *ap2;\ to_visit->ptd0 = ap2; \
to_visit ++;\ to_visit->d0 = *ap2; \
\ to_visit ++; \
*ap2 = TermNil;\ \
d0 = ArityOfFunctor(f);\ *ap2 = TermNil; \
pt0 = ap2;\ d0 = ArityOfFunctor(f); \
pt0_end = ap2 + d0;\ pt0 = ap2; \
pt0_end = ap2 + d0; \
} }
#define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {})
#define def_trail_overflow() \ #define def_trail_overflow() \
trail_overflow:{ \ trail_overflow:{ \
while (to_visit > to_visit0) {\ while (to_visit > to_visit0) { \
to_visit --;\ to_visit --; \
CELL *ptd0 = to_visit->ptd0;\ CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0;\ *ptd0 = to_visit->d0; \
}\ } \
pop_text_stack(lvl);\ pop_text_stack(lvl); \
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS);\ clean_tr(TR0 PASS_REGS); \
HR = InitialH;\ HR = InitialH; \
return 0L;\ return 0L; \
} }
#define def_aux_overflow() \ #define def_aux_overflow() \
aux_overflow:{ \ aux_overflow:{ \
size_t d1 = to_visit-to_visit0;\ size_t d1 = to_visit-to_visit0; \
size_t d2 = to_visit_max-to_visit0;\ size_t d2 = to_visit_max-to_visit0; \
to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \ to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \
to_visit = to_visit0+d1;\ to_visit = to_visit0+d1; \
to_visit_max = to_visit0+(d2+128); \ to_visit_max = to_visit0+(d2+128); \
pt0--;\ pt0--; \
goto restart;\ goto restart; \
} }
#define def_global_overflow() \ #define def_global_overflow() \
global_overflow:{ \ global_overflow:{ \
while (to_visit > to_visit0) { \ while (to_visit > to_visit0) { \
to_visit --;\ to_visit --; \
CELL *ptd0 = to_visit->ptd0;\ CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0;\ *ptd0 = to_visit->d0; \
}\ } \
pop_text_stack(lvl);\ pop_text_stack(lvl); \
clean_tr(TR0 PASS_REGS);\ clean_tr(TR0 PASS_REGS); \
HR = InitialH;\ HR = InitialH; \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;\ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);\ LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); \
return false; } return false; }
@ -139,7 +140,6 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE);
static Int p_ground( USES_REGS1 ); static Int p_ground( USES_REGS1 );
static Int p_copy_term( USES_REGS1 ); static Int p_copy_term( USES_REGS1 );
static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); 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); static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
#ifdef DEBUG #ifdef DEBUG
@ -158,145 +158,224 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) {
static inline void static inline void
clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
if (TR != TR0) { tr_fr_ptr pt0 = TR;
tr_fr_ptr pt = TR0; while (pt0 != TR0) {
Term p = TrailTerm(--pt0);
do { if (IsApplTerm(p)) {
Term p = TrailTerm(pt++); 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); RESET_VARIABLE(p);
} while (pt != TR);
TR = TR0;
} }
}
TR = TR0;
} }
static int #define expand_stack(S0,SP,SF,TYPE) \
copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) { 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; CELL *HB0 = HB;
tr_fr_ptr TR0 = TR; tr_fr_ptr TR0 = TR;
int ground = TRUE; int ground = true;
HB = HR; HB = HLow;
to_visit0 = to_visit; to_visit0 = to_visit;
to_visit_max = to_visit+1024;
loop: loop:
while (pt0 < pt0_end) { while (pt0 < pt0_end) {
register CELL d0; register CELL d0;
register CELL *ptd0; register CELL *ptd0;
++ pt0;
ptd0 = pt0; ptd0 = ++pt0;
d0 = *ptd0; d0 = *ptd0;
deref:
deref_head(d0, copy_term_unk); deref_head(d0, copy_term_unk);
copy_term_nvar: copy_term_nvar : {
{
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0); CELL *headp = RepPair(d0);
if (ap2 >= HB && ap2 < HR) { 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 */ /* If this is newer than the current term, just reuse */
*ptf++ = d0; *ptf++ = (CELL)RepAppl(*headp);
}
}
else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
*ptf++ = AbsPair(RepAppl(*headp));
continue; continue;
} }
if (to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
*ptf = AbsPair(HR); *ptf = AbsPair(HR);
ptf++; ptf++;
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0; to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
to_visit->oldv = *pt0; to_visit->curp = headp;
d0 = *headp;
to_visit->oldv = d0;
to_visit->ground = ground; to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ to_visit++;
*pt0 = AbsPair(HR); // move to new list
to_visit ++; if (share) {
ground = true; TrailedMaBind(headp,AbsPair(HR));
pt0 = ap2 - 1; } else {
pt0_end = ap2 + 1; *headp = AbsPair(HR);
}
pt0 = headp;
pt0_end = headp + 1;
ptf = HR; ptf = HR;
ground = true;
HR += 2; HR += 2;
if (HR > ASP - 2048) { if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow; goto overflow;
} }
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) { } else if (IsApplTerm(d0)) {
register Functor f; register Functor f;
register CELL *ap2; register CELL *headp;
/* store the terms to visit */ /* store the terms to visit */
ap2 = RepAppl(d0); headp = RepAppl(d0);
if (ap2 >= HB && ap2 <= HR) { 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 */ /* If this is newer than the current term, just reuse */
*ptf++ = AbsPair(RepAppl(*headp));
}
continue;
}
f = (Functor)(*headp);
if (IsExtensionFunctor(f)) {
if (share) {
*ptf++ = d0; *ptf++ = d0;
continue; continue;
} }
f = (Functor)(*ap2); switch ((CELL)f) {
case (CELL) FunctorDBRef:
if (IsExtensionFunctor(f)) { case (CELL) FunctorAttVar:
#if MULTIPLE_STACKS *ptf++ = d0;
if (f == FunctorDBRef) { break;
DBRef entryref = DBRefOfTerm(d0); case (CELL) FunctorLongInt:
if (entryref->Flags & LogUpdMask) { if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
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; goto overflow;
} }
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); *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; HR += sz;
} else { }
*ptf++ = d0; /* you can just copy other extensions. */
} }
continue; continue;
} }
*ptf = AbsAppl(HR); *ptf = AbsAppl(HR);
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0; to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
to_visit->oldv = *pt0; to_visit->curp = headp;
d0 = *headp;
to_visit->oldv = d0;
to_visit->ground = ground; to_visit->ground = ground;
/* fool the system into thinking we had a variable there */ if (++to_visit >= to_visit_max-32) {
*pt0 = AbsAppl(HR); expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
to_visit ++; }
ground = (f != FunctorMutable); if (share) {
d0 = ArityOfFunctor(f); TrailedMaBind(headp,AbsPair(HR));
pt0 = ap2; } else {
pt0_end = ap2 + d0; *headp = AbsPair(HR);
/* store the functor for the new term */ }
HR[0] = (CELL)f; ptf = HR;
ptf = HR+1; ptf[-1] = (CELL)f;
HR += 1+d0; ground = true;
if (HR > ASP - 2048) { arity_t a = ArityOfFunctor(f);
HR = ptf+a;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow; goto overflow;
} }
pt0 = headp;
pt0_end = headp+a;
ground = (f != FunctorMutable);
} else { } else {
/* just copy atoms or integers */ /* just copy atoms or integers */
*ptf++ = d0; *ptf++ = d0;
@ -305,122 +384,94 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
} }
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
ground = FALSE; ground = false;
if (ptd0 >= HLow && ptd0 < HR) { /* 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 */ /* we have already found this cell */
*ptf++ = (CELL) ptd0; *ptf++ = (CELL)ptd0;
} else } else {
#if COROUTINING if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
if (newattvs && IsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */ /* if unbound, call the standard copy term routine */
struct cp_frame *bp; struct cp_frame *bp;
CELL new; CELL new;
bp = to_visit; 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; goto overflow;
} }
to_visit = bp; to_visit = bp;
new = *ptf; 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) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* 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; goto trail_overflow;
} }
} }
Bind_NonAtt(ptd0, (CELL)ptf); 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++; ptf++;
} }
} }
/* 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;
*newp = old; /* Do we still have compound terms to visit */
if (IsApplTerm(new)) if (to_visit > to_visit0) {
HR = RepAppl(new); to_visit--;
else if (!share)
HR = RepPair(new); *to_visit->curp = to_visit->oldv;
}
pt0 = to_visit->start_cp; pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp; pt0_end = to_visit->end_cp;
ptf = to_visit->to; ptf = to_visit->to;
*pt0 = to_visit->oldv;
ground = (ground && to_visit->ground); ground = (ground && to_visit->ground);
goto loop; goto loop;
} }
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS); clean_dirty_tr(TR0 PASS_REGS);
HB = HB0; /* follow chain of multi-assigned variables */
return ground; pop_text_stack(lvl);
return 0;
overflow:
/* oops, we're in trouble */ overflow:
HR = HLow; /* oops, we're in trouble */
/* we've done it */ HR = HLow;
/* restore our nice, friendly, term to its original state */ /* we've done it */
HB = HB0; /* restore our nice, friendly, term to its original state */
while (to_visit > to_visit0) { HB = HB0;
to_visit --; while (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->start_cp; pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp; pt0_end = to_visit->end_cp;
ptf = to_visit->to; ptf = to_visit->to;
*pt0 = to_visit->oldv;
} }
reset_trail(TR0); reset_trail(TR0);
/* follow chain of multi-assigned variables */ pop_text_stack(lvl);
return -1; return -1;
trail_overflow: trail_overflow:
/* oops, we're in trouble */ /* oops, we're in trouble */
HR = HLow; HR = HLow;
/* we've done it */ /* we've done it */
/* restore our nice, friendly, term to its original state */ /* restore our nice, friendly, term to its original state */
HB = HB0; HB = HB0;
while (to_visit > to_visit0) { while (to_visit > to_visit0) {
to_visit --; to_visit--;
pt0 = to_visit->start_cp; pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp; pt0_end = to_visit->end_cp;
ptf = to_visit->to; ptf = to_visit->to;
*pt0 = to_visit->oldv;
} }
{ reset_trail(TR0);
tr_fr_ptr oTR = TR; pop_text_stack(lvl);
reset_trail(TR0); return -4;
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);
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
} }
@ -476,7 +527,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
*HR = t; *HR = t;
Hi = HR+1; Hi = HR+1;
HR += 2; 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; HR = Hi-1;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE; return FALSE;
@ -500,7 +551,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
HR += 2; HR += 2;
{ {
int res; 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; HR = Hi;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE; return FALSE;
@ -532,7 +583,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
} else { } else {
int res; 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; HR = HB0;
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE; return FALSE;
@ -639,9 +690,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te
copy_term_nvar: copy_term_nvar:
{ {
if (IsPairTerm(d0)) { if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0); CELL *headp = RepPair(d0);
//fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf);
if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) {
Term v = MkVarTerm(); Term v = MkVarTerm();
*ptf = v; *ptf = v;
vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); 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->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
to_visit->oldp = ap2; to_visit->oldp = headp;
d0 = to_visit->oldv = ap2[0]; d0 = to_visit->oldv = headp[0];
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
to_visit ++; to_visit ++;
pt0 = ap2; pt0 = headp;
pt0_end = ap2 + 1; pt0_end = headp + 1;
ptf = HR; ptf = HR;
*ap2 = AbsPair(HR); *headp = AbsPair(HR);
HR += 2; HR += 2;
if (HR > ASP - 2048) { if (HR > ASP - 2048) {
goto overflow; goto overflow;
} }
if (IsVarTerm(d0) && d0 == (CELL)ap2) { if (IsVarTerm(d0) && d0 == (CELL)headp) {
RESET_VARIABLE(ptf); RESET_VARIABLE(ptf);
ptf++; ptf++;
continue; continue;
@ -681,17 +732,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te
continue; continue;
} else if (IsApplTerm(d0)) { } else if (IsApplTerm(d0)) {
register Functor f; register Functor f;
register CELL *ap2; register CELL *headp;
/* store the terms to visit */ /* store the terms to visit */
ap2 = RepAppl(d0)+1; headp = RepAppl(d0)+1;
f = (Functor)(ap2[-1]); f = (Functor)(headp[-1]);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
*ptf++ = d0; /* you can just copy other extensions. */ *ptf++ = d0; /* you can just copy other extensions. */
continue; 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); RESET_VARIABLE(ptf);
vin = add_to_list(vin, (CELL)ptf, ap2[0] ); vin = add_to_list(vin, (CELL)ptf, headp[0] );
ptf++; ptf++;
continue; 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->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
to_visit->oldp = ap2; to_visit->oldp = headp;
d0 = to_visit->oldv = ap2[0]; d0 = to_visit->oldv = headp[0];
/* fool the system into thinking we had a variable there */ /* fool the system into thinking we had a variable there */
to_visit ++; to_visit ++;
pt0 = ap2; pt0 = headp;
pt0_end = ap2 + (arity-1); pt0_end = headp + (arity-1);
ptf = HR; ptf = HR;
if (HR > ASP - 2048) { if (HR > ASP - 2048) {
goto overflow; goto overflow;
} }
*ptf++ =(CELL)f; *ptf++ =(CELL)f;
*ap2 = AbsAppl(HR); *headp = AbsAppl(HR);
HR += (arity+1); HR += (arity+1);
if (IsVarTerm(d0) && d0 == (CELL)(ap2)) {
RESET_VARIABLE(ptf);
ptf++;
continue;
}
d0 = Deref(d0); d0 = Deref(d0);
if (!IsVarTerm(d0)) { if (!IsVarTerm(d0)) {
goto copy_term_nvar; 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) { if (new) {
/* mark cell as pointing to new copy */ /* mark cell as pointing to new copy */
/* we can only mark after reading the value of the first argument */ /* we can only mark after reading the value of the first argument */
MaBind(pt0, new); TrailedMaBind(pt0, new);
new = 0L; new = 0L;
} }
deref_head(d0, break_rationals_unk); deref_head(d0, break_rationals_unk);
@ -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_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
*to_visit0 = to_visit, *to_visit0 = to_visit,
*to_visit_max = to_visit+1024; *to_visit_max = to_visit+1024;
Term o = TermNil;
CELL *InitialH = HR; CELL *InitialH = HR;
*HR++ = MkAtomTerm(AtomDollar);
to_visit0 = to_visit; to_visit0 = to_visit;
restart: restart:
while (pt0 < pt0_end) { while (pt0 < pt0_end) {
@ -2284,7 +2329,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
deref_head(d0, vars_within_term_unk); deref_head(d0, vars_within_term_unk);
vars_within_term_nvar: vars_within_term_nvar:
{ {
WALK_COMPLEX_TERM() WALK_COMPLEX_TERM();
continue; continue;
} }
@ -2293,10 +2338,13 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
*ptd0 = TermNil; *ptd0 = TermNil;
/* leave an empty slot to fill in later */ /* leave an empty slot to fill in later */
if (HR+1024 > ASP) { if (HR+1024 > ASP) {
o = TermNil;
goto global_overflow; goto global_overflow;
} }
HR[0] = (CELL)ptd0; HR[0] = (CELL)ptd0;
HR ++; HR[1] = o;
o = AbsPair(HR);
HR += 2;
/* next make sure noone will see this as a variable again */ /* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* 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); clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl); pop_text_stack(lvl);
if (HR > InitialH+1) { return o;
InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
return AbsAppl(InitialH);
} else {
return MkAtomTerm(AtomDollar);
}
def_trail_overflow(); def_trail_overflow();
@ -2678,7 +2721,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R
return true; return true;
def_aux_overflow(); def_aux_overflow();
} }
bool Yap_IsGroundTerm(Term t) bool Yap_IsGroundTerm(Term t)
{ {
@ -4330,10 +4373,10 @@ extern int vsc;
int vsc; int vsc;
#define RENUMBER_SINGLES\ #define RENUMBER_SINGLES \
if (singles && ap2 >= InitialH && ap2 < HR) {\ if (singles && ap2 >= InitialH && ap2 < HR) { \
renumbervar(d0, numbv++ PASS_REGS);\ renumbervar(d0, numbv++ PASS_REGS); \
continue;\ continue; \
} }

4
C/yap-args.c
View File

@ -175,7 +175,7 @@ static bool load_file(const char *b_file USES_REGS) {
__android_log_print( __android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file);
if (c_stream < 0) { 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); pop_text_stack(lvl);
exit(1); exit(1);
} }
@ -185,7 +185,7 @@ static bool load_file(const char *b_file USES_REGS) {
} }
__android_log_print( __android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file);
t = 0;
while (t != TermEof) { while (t != TermEof) {
CACHE_REGS CACHE_REGS
YAP_Reset(YAP_FULL_RESET, false); YAP_Reset(YAP_FULL_RESET, false);

3
H/TermExt.h
View File

@ -111,10 +111,9 @@ typedef struct cp_frame {
CELL *start_cp; CELL *start_cp;
CELL *end_cp; CELL *end_cp;
CELL *to; CELL *to;
#ifdef RATIONAL_TREES CELL *curp;
CELL oldv; CELL oldv;
int ground; int ground;
#endif
} copy_frame; } copy_frame;
#ifdef COROUTINING #ifdef COROUTINING

3
H/Yapproto.h
View File

@ -477,6 +477,9 @@ extern void Yap_InitUserCPreds(void);
extern void Yap_InitUserBacks(void); extern void Yap_InitUserBacks(void);
/* utilpreds.c */ /* 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 Term Yap_CopyTerm(Term);
extern bool Yap_Variant(Term, Term); extern bool Yap_Variant(Term, Term);
extern size_t Yap_ExportTerm(Term, char *, size_t, UInt); extern size_t Yap_ExportTerm(Term, char *, size_t, UInt);

6
H/amiops.h
View File

@ -418,6 +418,12 @@ extern void Yap_WakeUp(CELL *v);
*(VP) = (D); \ *(VP) = (D); \
} }
#define TrailedMaBind(VP, D) \
{ \
DO_MATRAIL((VP), *(VP), (D)); \
*(VP) = (D); \
}
/************************************************************ /************************************************************
Unification Routines Unification Routines

4
packages/clpqr/clpq/itf_q.pl
View File

@ -62,7 +62,7 @@
[ [
class_drop/2 class_drop/2
]). ]).

do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y), numbers_only(Y),
verify_nonzero(No,Y), verify_nonzero(No,Y),
@ -76,7 +76,7 @@ numbers_only(Y) :-
; throw(type_error(_X = Y,2,'a rational number',Y)) ; throw(type_error(_X = Y,2,'a rational number',Y))
), ),
!. !.
ø
% verify_nonzero(Nonzero,Y) % verify_nonzero(Nonzero,Y)
% %
% if Nonzero = nonzero, then verify that Y is not zero % if Nonzero = nonzero, then verify that Y is not zero

4
packages/clpqr/clpqr/geler.pl
View File

@ -43,6 +43,10 @@
project_nonlin/3, project_nonlin/3,
collect_nonlin/3 collect_nonlin/3
]). ]).
:- use_module(library(maplist),
[
maplist/2
]).
% l2conj(List,Conj) % l2conj(List,Conj)
% %

4
packages/clpqr/clpqr/itf.pl
View File

@ -47,6 +47,10 @@
dump_nonzero/3, dump_nonzero/3,
clp_type/2 clp_type/2
]). ]).
:- use_module(library(maplist),
[
maplist/2
]).
clp_type(Var,Type) :- clp_type(Var,Type) :-

4
packages/clpqr/clpr/itf_r.pl
View File

@ -63,6 +63,10 @@
[ [
class_drop/2 class_drop/2
]). ]).
:- use_module(library(maplist),
[
maplist/2
]).
do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y), numbers_only(Y),

1
packages/jpl/src/c/CMakeLists.txt
View File

@ -1,5 +1,6 @@
# set(CMAKE_MACOSX_RPATH 1) # set(CMAKE_MACOSX_RPATH 1)
add_library(jplYap jpl.c) add_library(jplYap jpl.c)
include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} )

8
packages/jpl/src/c/jpl.c
View File

@ -48,12 +48,12 @@ refactoring (trivial):
#define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_PATCH 4
#define JPL_C_LIB_VERSION_STATUS "alpha" #define JPL_C_LIB_VERSION_STATUS "alpha"
#define JPL_DEBUG //#define JPL_DEBUG
#ifndef JPL_DEBUG #ifndef JPL_DEBUG
/*#define DEBUG(n, g) ((void)0) */ /*#define DEBUG(n, g) ((void)0) */
#define DEBUG_LEVEL 4 #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 #endif
/* disable type-of-ref caching (at least until GC issues are resolved) */ /* 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 */ jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */
{ JNIEnv *env; { JNIEnv *env;
switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_9) ) switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_2) )
{ case JNI_OK: { case JNI_OK:
return env; return env;
case JNI_EDETACHED: case JNI_EDETACHED:
@ -1826,7 +1826,7 @@ jni_create_jvm_c(
JNIEnv *env; JNIEnv *env;
JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); 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 ) if ( classpath )
{ {
cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1); cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1);

5
packages/python/pybips.c
View File

@ -635,8 +635,9 @@ PyObject *term_to_nametuple(const char *s, arity_t arity, PyObject *tuple) {
typp = (PyTypeObject *)d; typp = (PyTypeObject *)d;
} else { } else {
PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1); PyStructSequence_Desc *desc = PyMem_Calloc(sizeof(PyStructSequence_Desc), 1);
desc->name = PyMem_Malloc(strlen(s) + 1); char *tnp;
strcpy((char *)desc->name, s); desc->name = tnp = PyMem_Malloc(strlen(s) + 1);
strcpy(tnp, s);
desc->doc = "YAPTerm"; desc->doc = "YAPTerm";
desc->fields = pnull; desc->fields = pnull;
desc->n_in_sequence = arity; desc->n_in_sequence = arity;

11
packages/python/pypreds.c
View File

@ -1,4 +1,15 @@
#include "Yap.h" #include "Yap.h"
#include "py4yap.h" #include "py4yap.h"

6
pl/android.yap
View File

@ -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)). :- initialization(yap_flag(verbose,_,normal)).

65
pl/undefined.yap
View File

@ -70,18 +70,6 @@ undefined_query(G0, M0, Cut) :-
recorded('$import','$import'(M,M0,G,G0,_,_),_), recorded('$import','$import'(M,M0,G,G0,_,_),_),
'$call'(G, Cut, G, M). '$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) * @pred '$undefp_search'(+ M0:G0, -MG)
@ -103,43 +91,48 @@ undefined_query(G0, M0, Cut) :-
user:unknown_predicate_handler(GM0,EM0,MG), user:unknown_predicate_handler(GM0,EM0,MG),
!. !.
'$undefp_search'(M0:G0, MG) :- '$undefp_search'(M0:G0, MG) :-
'$get_undefined_predicates'(M0:G0, MG), !. '$get_undefined_predicates'(M0:G0, MG), !.
% undef handler % undef handler
'$undefp'([M0|G0],MG) :- '$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates % make sure we do not loop on undefined predicates
'$undef_set'(Action,Debug,Current), '$undef_setup'(Action,Debug,Current),
'$search_def'(M0:G0,MG,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) :- '$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( unknown, Action, fail),
yap_flag( debug, Debug, false), yap_flag( debug, Debug, false),
'$stop_creeping'(Current). '$stop_creeping'(Current).
'$search_def'(M0:G0,NM:NG,Action,Debug,Current) :- '$undef_cleanup'(Action,Debug,_Current) :-
'$undefp_search'(M0:G0, NM:NG),
'$pred_exists'(NG,NM),
!,
yap_flag( unknown, _, Action), yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug), yap_flag( debug, _, Debug),
nonvar(NG), '$start_creep'([prolog|true], creep).
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).
:- '$undefp_handler'('$undefp'(_,_), prolog). :- '$undefp_handler'('$undefp'(_,_), prolog).
/** @pred unknown(- _O_,+ _N_) /** @pred unknown(- _O_,+ _N_)