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 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
@ -31,81 +31,81 @@ static char SccsId[] = "%W% %G%";
/**
@defgroup Global_Variables Global Variables
@ingroup builtins
@{
@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
@ -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) {
CACHE_REGS
restart : {
restart : {
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
@ -315,7 +315,7 @@ restart : {
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;
@ -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) {
@ -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;
@ -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 "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);

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) {
/* try to dump active goals */
void *ep = YENV; /* and current environment */
void *cp;
void *cp ;
PredEntry *pe;
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;
#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;\
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;\
}
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;\
size_t d1 = to_visit-to_visit0; \
size_t d2 = to_visit_max-to_visit0; \
to_visit0 = Realloc(to_visit0,(d2+128)*sizeof(struct non_single_struct_t)); \
to_visit = to_visit0+d1; \
to_visit_max = to_visit0+(d2+128); \
pt0--; \
goto restart; \
}
#define def_global_overflow() \
global_overflow:{ \
while (to_visit > to_visit0) { \
to_visit --;\
CELL *ptd0 = to_visit->ptd0;\
*ptd0 = to_visit->d0;\
}\
pop_text_stack(lvl);\
clean_tr(TR0 PASS_REGS);\
HR = InitialH;\
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;\
LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);\
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; }
@ -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,145 +158,224 @@ 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) {
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++ = d0;
*ptf++ = (CELL)RepAppl(*headp);
}
}
else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) {
*ptf++ = AbsPair(RepAppl(*headp));
continue;
}
if (to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
*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->curp = headp;
d0 = *headp;
to_visit->oldv = d0;
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;
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 - 2048) {
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
register CELL *headp;
/* store the terms to visit */
ap2 = RepAppl(d0);
if (ap2 >= HB && ap2 <= HR) {
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);
if (IsExtensionFunctor(f)) {
if (share) {
*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) {
switch ((CELL)f) {
case (CELL) FunctorDBRef:
case (CELL) FunctorAttVar:
*ptf++ = d0;
break;
case (CELL) FunctorLongInt:
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
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;
} 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->curp = headp;
d0 = *headp;
to_visit->oldv = d0;
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) {
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;
@ -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);
ground = FALSE;
if (ptd0 >= HLow && ptd0 < HR) {
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 (newattvs && IsAttachedTerm((CELL)ptd0)) {
*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;
bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
ptf PASS_REGS)) {
goto overflow;
}
to_visit = bp;
new = *ptf;
Bind_NonAtt(ptd0, new);
ptf++;
} else {
#endif
/* first time we met this term */
RESET_VARIABLE(ptf);
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
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++;
}
}
/* 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;
if (IsApplTerm(new))
HR = RepAppl(new);
else
HR = RepPair(new);
}
/* 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;
*pt0 = to_visit->oldv;
ground = (ground && to_visit->ground);
goto loop;
}
/* restore our nice, friendly, term to its original state */
clean_dirty_tr(TR0 PASS_REGS);
HB = HB0;
return ground;
/* 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 --;
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;
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 --;
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;
}
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;
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);
@ -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,7 +2329,7 @@ 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()
WALK_COMPLEX_TERM();
continue;
}
@ -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();
@ -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,10 +4373,10 @@ 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; \
}

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_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);

3
H/TermExt.h
View File

@ -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

3
H/Yapproto.h
View File

@ -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);

6
H/amiops.h
View File

@ -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

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

@ -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

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

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

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

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

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

@ -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),

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

@ -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} )

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_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);

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;
} 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;

11
packages/python/pypreds.c
View File

@ -1,4 +1,15 @@
#include "Yap.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)).

65
pl/undefined.yap
View File

@ -70,18 +70,6 @@ undefined_query(G0, M0, Cut) :-
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) :-
'$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_)