copy_term
This commit is contained in:
parent
8ce648422a
commit
a6d709dabf
263
C/globals.c
263
C/globals.c
@ -352,263 +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;
|
|
||||||
|
|
||||||
ptd0 = ++pt0;
|
|
||||||
d0 = *pt0;
|
|
||||||
if (d0 != TermNil)
|
|
||||||
Yap_DebugPlWriteln(d0);
|
|
||||||
deref:
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
if (to_visit >= to_visit_max-32) {
|
|
||||||
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
|
|
||||||
}
|
|
||||||
pt0 = ap2;
|
|
||||||
to_visit->start_cp = pt0;
|
|
||||||
to_visit->end_cp = pt0_end = pt0+2;
|
|
||||||
to_visit->to = ptf;
|
|
||||||
d0 = *pt0;
|
|
||||||
to_visit->ground = ground;
|
|
||||||
/* fool the system into thinking we had a variable there */
|
|
||||||
MaBind(pt0,AbsPair(HR));
|
|
||||||
to_visit++;
|
|
||||||
ground = true;
|
|
||||||
HR += 2;
|
|
||||||
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
ptd0 = pt0;
|
|
||||||
goto deref;
|
|
||||||
} else if (IsApplTerm(d0)) {
|
|
||||||
register Functor f;
|
|
||||||
register CELL *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;
|
|
||||||
}
|
|
||||||
/* store the terms to visit */
|
|
||||||
to_visit->start_cp = pt0;
|
|
||||||
to_visit->end_cp = pt0_end;
|
|
||||||
to_visit->to = ptf;
|
|
||||||
to_visit->ground = ground;
|
|
||||||
if (++to_visit >= to_visit_max-32) {
|
|
||||||
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
|
|
||||||
}
|
|
||||||
/* fool the system into thinking we had a variable there */
|
|
||||||
ptf = HR;
|
|
||||||
*ptf++ = d0 = *ap2;
|
|
||||||
MaBind(ap2++,AbsAppl(HR));
|
|
||||||
to_visit++;
|
|
||||||
ground = true;
|
|
||||||
arity_t a = ArityOfFunctor((Functor)d0);
|
|
||||||
HR = ptf+a;
|
|
||||||
if (HR > ASP - MIN_ARENA_SIZE) {
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
pt0 = ap2;
|
|
||||||
pt0_end = ap2+a;
|
|
||||||
ground = (f != FunctorMutable);
|
|
||||||
} 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 (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 {
|
|
||||||
/* first time we met this term */
|
|
||||||
RESET_VARIABLE(ptf);
|
|
||||||
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
|
|
||||||
goto trail_overflow;
|
|
||||||
MaBind(ptd0, (CELL)ptf);
|
|
||||||
ptf++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* 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;
|
|
||||||
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;
|
|
||||||
while (to_visit > to_visit0) {
|
|
||||||
to_visit--;
|
|
||||||
pt0 = to_visit->start_cp;
|
|
||||||
pt0_end = to_visit->end_cp;
|
|
||||||
ptf = to_visit->to;
|
|
||||||
*pt0 = to_visit->oldv;
|
|
||||||
}
|
|
||||||
reset_trail(TR0);
|
|
||||||
pop_text_stack(lvl);
|
|
||||||
return -1;
|
|
||||||
|
|
||||||
trail_overflow:
|
|
||||||
/* oops, we're in trouble */
|
|
||||||
HR = HLow;
|
|
||||||
/* we've done it */
|
|
||||||
/* restore our nice, friendly, term to its original state */
|
|
||||||
HB = HB0;
|
|
||||||
while (to_visit > to_visit0) {
|
|
||||||
to_visit--;
|
|
||||||
pt0 = to_visit->start_cp;
|
|
||||||
pt0_end = to_visit->end_cp;
|
|
||||||
ptf = to_visit->to;
|
|
||||||
*pt0 = to_visit->oldv;
|
|
||||||
}
|
|
||||||
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) {
|
||||||
@ -631,7 +374,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
|
|||||||
*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, 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);
|
||||||
@ -665,7 +408,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
|
|||||||
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, copy_att_vars, Hi,
|
||||||
Hi PASS_REGS)) < 0) {
|
Hi PASS_REGS)) < 0) {
|
||||||
goto error_handler;
|
goto error_handler;
|
||||||
}
|
}
|
||||||
@ -743,7 +486,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
|
|||||||
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)) <
|
copy_att_vars, HB0 + 1, HB0 PASS_REGS)) <
|
||||||
0) {
|
0) {
|
||||||
goto error_handler;
|
goto error_handler;
|
||||||
|
678
C/utilpreds.c
678
C/utilpreds.c
@ -45,92 +45,92 @@ typedef struct non_single_struct_t {
|
|||||||
CELL *pt0, *pt0_end;
|
CELL *pt0, *pt0_end;
|
||||||
} 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); \
|
||||||
if (*ptd0 == TermFreeTerm) continue;\
|
if (*ptd0 == TermFreeTerm) continue; \
|
||||||
to_visit->pt0 = pt0;\
|
to_visit->pt0 = pt0; \
|
||||||
to_visit->pt0_end = pt0_end;\
|
to_visit->pt0_end = pt0_end; \
|
||||||
to_visit->ptd0 = ptd0;\
|
to_visit->ptd0 = ptd0; \
|
||||||
to_visit->d0 = *ptd0;\
|
to_visit->d0 = *ptd0; \
|
||||||
to_visit ++;\
|
to_visit ++; \
|
||||||
d0 = ptd0[0];\
|
d0 = ptd0[0]; \
|
||||||
pt0 = ptd0;\
|
pt0 = ptd0; \
|
||||||
*ptd0 = TermFreeTerm;\
|
*ptd0 = TermFreeTerm; \
|
||||||
pt0_end = pt0 + 1;\
|
pt0_end = pt0 + 1; \
|
||||||
goto list_loop;\
|
goto list_loop; \
|
||||||
} else if (IsApplTerm(d0)) {\
|
} else if (IsApplTerm(d0)) { \
|
||||||
register Functor f;\
|
register Functor f; \
|
||||||
register CELL *ap2;\
|
register CELL *ap2; \
|
||||||
/* store the terms to visit */\
|
/* store the terms to visit */ \
|
||||||
ap2 = RepAppl(d0);\
|
ap2 = RepAppl(d0); \
|
||||||
f = (Functor)(*ap2);\
|
f = (Functor)(*ap2); \
|
||||||
\
|
\
|
||||||
if (IsExtensionFunctor(f)) {\
|
if (IsExtensionFunctor(f)) { \
|
||||||
\
|
\
|
||||||
continue;\
|
continue; \
|
||||||
}\
|
} \
|
||||||
STRUCT0;\
|
STRUCT0; \
|
||||||
if (to_visit + 32 >= to_visit_max) {\
|
if (to_visit + 32 >= to_visit_max) { \
|
||||||
goto aux_overflow;\
|
goto aux_overflow; \
|
||||||
}\
|
} \
|
||||||
to_visit->pt0 = pt0;\
|
to_visit->pt0 = pt0; \
|
||||||
to_visit->pt0_end = pt0_end;\
|
to_visit->pt0_end = pt0_end; \
|
||||||
to_visit->ptd0 = ap2;\
|
to_visit->ptd0 = ap2; \
|
||||||
to_visit->d0 = *ap2;\
|
to_visit->d0 = *ap2; \
|
||||||
to_visit ++;\
|
to_visit ++; \
|
||||||
\
|
\
|
||||||
*ap2 = TermNil;\
|
*ap2 = TermNil; \
|
||||||
d0 = ArityOfFunctor(f);\
|
d0 = ArityOfFunctor(f); \
|
||||||
pt0 = ap2;\
|
pt0 = ap2; \
|
||||||
pt0_end = ap2 + d0;\
|
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; }
|
||||||
|
|
||||||
|
|
||||||
static Int p_non_singletons_in_term( USES_REGS1);
|
static Int p_non_singletons_in_term( USES_REGS1);
|
||||||
@ -140,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
|
||||||
@ -159,145 +158,191 @@ 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, 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();
|
||||||
|
|
||||||
|
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 (//(share && headp < HB) ||
|
||||||
|
(IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) {
|
||||||
/* If this is newer than the current term, just reuse */
|
/* If this is newer than the current term, just reuse */
|
||||||
*ptf++ = d0;
|
*ptf++ = *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->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 ++;
|
d0 = *headp;
|
||||||
ground = true;
|
TrailedMaBind(headp, AbsPair(HR));
|
||||||
pt0 = ap2 - 1;
|
pt0 = headp;
|
||||||
pt0_end = ap2 + 1;
|
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 (IsApplTerm(*headp)//(share && headp < HB) ||
|
||||||
|
) {
|
||||||
/* If this is newer than the current term, just reuse */
|
/* If this is newer than the current term, just reuse */
|
||||||
*ptf++ = d0;
|
*ptf++ = *headp;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
f = (Functor)(*ap2);
|
f = (Functor)(*headp);
|
||||||
|
|
||||||
if (IsExtensionFunctor(f)) {
|
if (IsExtensionFunctor(f)) {
|
||||||
#if MULTIPLE_STACKS
|
switch ((CELL)f) {
|
||||||
if (f == FunctorDBRef) {
|
case (CELL) FunctorDBRef:
|
||||||
DBRef entryref = DBRefOfTerm(d0);
|
case (CELL) FunctorAttVar:
|
||||||
if (entryref->Flags & LogUpdMask) {
|
*ptf++ = d0;
|
||||||
LogUpdClause *luclause = (LogUpdClause *)entryref;
|
break;
|
||||||
PELOCK(100,luclause->ClPred);
|
case (CELL) FunctorLongInt:
|
||||||
UNLOCK(luclause->ClPred->PELock);
|
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
|
||||||
} else {
|
goto overflow;
|
||||||
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. */
|
*ptf++ = AbsAppl(HR);
|
||||||
} else
|
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
|
#endif
|
||||||
if (!share) {
|
break;
|
||||||
UInt sz;
|
case (CELL) FunctorString:
|
||||||
|
if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) {
|
||||||
*ptf++ = AbsAppl(HR); /* you can just copy other extensions. */
|
goto overflow;
|
||||||
/* make sure to copy floats */
|
|
||||||
if (f== FunctorDouble) {
|
|
||||||
sz = sizeof(Float)/sizeof(CELL)+2;
|
|
||||||
} else if (f== FunctorLongInt) {
|
|
||||||
sz = 3;
|
|
||||||
} else if (f== FunctorString) {
|
|
||||||
sz = 3+ap2[1];
|
|
||||||
} else {
|
|
||||||
CELL *pt = ap2+1;
|
|
||||||
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
|
|
||||||
}
|
|
||||||
if (HR+sz > ASP - 2048) {
|
|
||||||
goto overflow;
|
|
||||||
}
|
|
||||||
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL));
|
|
||||||
HR += sz;
|
|
||||||
} else {
|
|
||||||
*ptf++ = d0; /* you can just copy other extensions. */
|
|
||||||
}
|
}
|
||||||
|
*ptf++ = AbsAppl(HR);
|
||||||
|
memmove(HR, headp, sizeof(CELL) * (3 + headp[1]));
|
||||||
|
HR += headp[1] + 3;
|
||||||
|
break;
|
||||||
|
default: {
|
||||||
|
/* big int */
|
||||||
|
size_t sz = (sizeof(MP_INT) + 3 * CellSize +
|
||||||
|
((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) /
|
||||||
|
CellSize,
|
||||||
|
i;
|
||||||
|
|
||||||
|
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
|
||||||
|
goto overflow;
|
||||||
|
}
|
||||||
|
*ptf++ = AbsAppl(HR);
|
||||||
|
HR[0] = (CELL)f;
|
||||||
|
for (i = 1; i < sz; i++) {
|
||||||
|
HR[i] = headp[i];
|
||||||
|
|
||||||
|
}
|
||||||
|
HR += sz;
|
||||||
|
}
|
||||||
|
}
|
||||||
continue;
|
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->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);
|
TrailedMaBind(headp,AbsAppl(HR));
|
||||||
d0 = ArityOfFunctor(f);
|
ptf = HR;
|
||||||
pt0 = ap2;
|
*ptf++ = (CELL)f;
|
||||||
pt0_end = ap2 + d0;
|
ground = true;
|
||||||
/* store the functor for the new term */
|
arity_t a = ArityOfFunctor(f);
|
||||||
HR[0] = (CELL)f;
|
HR = ptf+a;
|
||||||
ptf = HR+1;
|
if (HR > ASP - MIN_ARENA_SIZE) {
|
||||||
HR += 1+d0;
|
|
||||||
if (HR > ASP - 2048) {
|
|
||||||
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;
|
||||||
@ -306,66 +351,60 @@ 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;
|
||||||
|
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
|
||||||
bp = to_visit;
|
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;
|
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
||||||
Bind_NonAtt(ptd0, new);
|
/* Trail overflow */
|
||||||
ptf++;
|
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
|
||||||
|
goto trail_overflow;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
TrailedMaBind(ptd0, new);
|
||||||
|
ptf++;
|
||||||
} else {
|
} else {
|
||||||
#endif
|
/* first time we met this term */
|
||||||
/* first time we met this term */
|
RESET_VARIABLE(ptf);
|
||||||
RESET_VARIABLE(ptf);
|
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
|
||||||
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
goto trail_overflow;
|
||||||
/* Trail overflow */
|
TrailedMaBind(ptd0, (CELL)ptf);
|
||||||
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
|
ptf++;
|
||||||
goto trail_overflow;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
Bind_NonAtt(ptd0, (CELL)ptf);
|
|
||||||
ptf++;
|
|
||||||
}
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Do we still have compound terms to visit */
|
/* Do we still have compound terms to visit */
|
||||||
if (to_visit > to_visit0) {
|
if (to_visit > to_visit0) {
|
||||||
to_visit --;
|
to_visit--;
|
||||||
if (ground && share) {
|
|
||||||
CELL old = to_visit->oldv;
|
|
||||||
CELL *newp = to_visit->to-1;
|
|
||||||
CELL new = *newp;
|
|
||||||
|
|
||||||
*newp = old;
|
|
||||||
if (IsApplTerm(new))
|
|
||||||
HR = RepAppl(new);
|
|
||||||
else
|
|
||||||
HR = RepPair(new);
|
|
||||||
}
|
|
||||||
pt0 = to_visit->start_cp;
|
pt0 = 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:
|
overflow:
|
||||||
/* oops, we're in trouble */
|
/* oops, we're in trouble */
|
||||||
@ -374,14 +413,13 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
|
|||||||
/* 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);
|
reset_trail(TR0);
|
||||||
/* follow chain of multi-assigned variables */
|
pop_text_stack(lvl);
|
||||||
return -1;
|
return -1;
|
||||||
|
|
||||||
trail_overflow:
|
trail_overflow:
|
||||||
@ -391,37 +429,14 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
|
|||||||
/* 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;
|
|
||||||
}
|
|
||||||
{
|
|
||||||
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);
|
reset_trail(TR0);
|
||||||
LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
|
pop_text_stack(lvl);
|
||||||
return -3;
|
return -4;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -477,7 +492,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, 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;
|
||||||
@ -501,7 +516,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, 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;
|
||||||
@ -533,7 +548,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, 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;
|
||||||
@ -640,9 +655,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) );
|
||||||
@ -656,19 +671,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;
|
||||||
@ -682,17 +697,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;
|
||||||
}
|
}
|
||||||
@ -705,24 +720,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;
|
||||||
@ -884,7 +894,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);
|
||||||
@ -1642,7 +1652,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
|
|||||||
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
*to_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;
|
||||||
register tr_fr_ptr TR0 = TR;
|
register tr_fr_ptr TR0 = TR;
|
||||||
CELL *InitialH = HR;
|
CELL *InitialH = HR;
|
||||||
CELL output = AbsPair(HR);
|
CELL output = AbsPair(HR);
|
||||||
|
|
||||||
@ -1657,8 +1667,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
|
|||||||
list_loop:
|
list_loop:
|
||||||
deref_head(d0, vars_in_term_unk);
|
deref_head(d0, vars_in_term_unk);
|
||||||
vars_in_term_nvar:
|
vars_in_term_nvar:
|
||||||
WALK_COMPLEX_TERM();
|
WALK_COMPLEX_TERM();
|
||||||
continue ;
|
continue ;
|
||||||
|
|
||||||
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
|
||||||
/* do or pt2 are unbound */
|
/* do or pt2 are unbound */
|
||||||
@ -1681,14 +1691,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
|
|||||||
}
|
}
|
||||||
/* Do we still have compound terms to visit */
|
/* Do we still have compound terms to visit */
|
||||||
if (to_visit > to_visit0) {
|
if (to_visit > to_visit0) {
|
||||||
to_visit--;
|
to_visit--;
|
||||||
|
|
||||||
pt0 = to_visit->pt0;
|
pt0 = to_visit->pt0;
|
||||||
pt0_end = to_visit->pt0_end;
|
pt0_end = to_visit->pt0_end;
|
||||||
CELL *ptd0 = to_visit->ptd0;
|
CELL *ptd0 = to_visit->ptd0;
|
||||||
*ptd0 = to_visit->d0;
|
*ptd0 = to_visit->d0;
|
||||||
goto loop;
|
goto loop;
|
||||||
}
|
}
|
||||||
|
|
||||||
clean_tr(TR0 PASS_REGS);
|
clean_tr(TR0 PASS_REGS);
|
||||||
pop_text_stack(lvl);
|
pop_text_stack(lvl);
|
||||||
@ -1885,63 +1895,63 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|||||||
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
|
*to_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;
|
||||||
register tr_fr_ptr TR0 = TR;
|
register tr_fr_ptr TR0 = TR;
|
||||||
CELL *InitialH = HR;
|
CELL *InitialH = HR;
|
||||||
CELL output = AbsPair(HR);
|
CELL output = AbsPair(HR);
|
||||||
|
|
||||||
restart:
|
restart:
|
||||||
while (pt0 < pt0_end) {
|
while (pt0 < pt0_end) {
|
||||||
register CELL d0;
|
register CELL d0;
|
||||||
register CELL *ptd0;
|
register CELL *ptd0;
|
||||||
++ pt0;
|
++ pt0;
|
||||||
ptd0 = pt0;
|
ptd0 = pt0;
|
||||||
d0 = *ptd0;
|
d0 = *ptd0;
|
||||||
list_loop:
|
list_loop:
|
||||||
deref_head(d0, attvars_in_term_unk);
|
deref_head(d0, attvars_in_term_unk);
|
||||||
attvars_in_term_nvar:
|
attvars_in_term_nvar:
|
||||||
{
|
{
|
||||||
WALK_COMPLEX_TERM();
|
WALK_COMPLEX_TERM();
|
||||||
continue;
|
continue;
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
|
|
||||||
if (IsAttVar(ptd0)) {
|
|
||||||
/* do or pt2 are unbound */
|
|
||||||
attvar_record *a0 = RepAttVar(ptd0);
|
|
||||||
if (a0->AttFunc ==(Functor) TermNil) continue;
|
|
||||||
/* leave an empty slot to fill in later */
|
|
||||||
if (HR+1024 > ASP) {
|
|
||||||
goto global_overflow;
|
|
||||||
}
|
|
||||||
HR[1] = AbsPair(HR+2);
|
|
||||||
HR += 2;
|
|
||||||
HR[-2] = (CELL)&(a0->Done);
|
|
||||||
/* store the terms to visit */
|
|
||||||
if (to_visit + 32 >= to_visit_max) {
|
|
||||||
goto aux_overflow;
|
|
||||||
}
|
|
||||||
ptd0 = (CELL*)a0;
|
|
||||||
to_visit->pt0 = pt0;
|
|
||||||
to_visit->pt0_end = pt0_end;
|
|
||||||
to_visit->d0 = *ptd0;
|
|
||||||
to_visit->ptd0 = ptd0;
|
|
||||||
to_visit ++;
|
|
||||||
*ptd0 = TermNil;
|
|
||||||
pt0 = ptd0;
|
|
||||||
pt0_end = &RepAttVar(ptd0)->Atts;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
/* Do we still have compound terms to visit */
|
|
||||||
if (to_visit > to_visit0) {
|
|
||||||
to_visit--;
|
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
|
||||||
|
if (IsAttVar(ptd0)) {
|
||||||
|
/* do or pt2 are unbound */
|
||||||
|
attvar_record *a0 = RepAttVar(ptd0);
|
||||||
|
if (a0->AttFunc ==(Functor) TermNil) continue;
|
||||||
|
/* leave an empty slot to fill in later */
|
||||||
|
if (HR+1024 > ASP) {
|
||||||
|
goto global_overflow;
|
||||||
|
}
|
||||||
|
HR[1] = AbsPair(HR+2);
|
||||||
|
HR += 2;
|
||||||
|
HR[-2] = (CELL)&(a0->Done);
|
||||||
|
/* store the terms to visit */
|
||||||
|
if (to_visit + 32 >= to_visit_max) {
|
||||||
|
goto aux_overflow;
|
||||||
|
}
|
||||||
|
ptd0 = (CELL*)a0;
|
||||||
|
to_visit->pt0 = pt0;
|
||||||
|
to_visit->pt0_end = pt0_end;
|
||||||
|
to_visit->d0 = *ptd0;
|
||||||
|
to_visit->ptd0 = ptd0;
|
||||||
|
to_visit ++;
|
||||||
|
*ptd0 = TermNil;
|
||||||
|
pt0 = ptd0;
|
||||||
|
pt0_end = &RepAttVar(ptd0)->Atts;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Do we still have compound terms to visit */
|
||||||
|
if (to_visit > to_visit0) {
|
||||||
|
to_visit--;
|
||||||
|
|
||||||
pt0 = to_visit->pt0;
|
pt0 = to_visit->pt0;
|
||||||
pt0_end = to_visit->pt0_end;
|
pt0_end = to_visit->pt0_end;
|
||||||
CELL *ptd0 = to_visit->ptd0;
|
CELL *ptd0 = to_visit->ptd0;
|
||||||
*ptd0 = to_visit->d0;
|
*ptd0 = to_visit->d0;
|
||||||
goto restart;
|
goto restart;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
clean_tr(TR0 PASS_REGS);
|
clean_tr(TR0 PASS_REGS);
|
||||||
@ -2089,7 +2099,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|||||||
}
|
}
|
||||||
/* Do we still have compound terms to visit */
|
/* Do we still have compound terms to visit */
|
||||||
if (to_visit > to_visit0) {
|
if (to_visit > to_visit0) {
|
||||||
to_visit--;
|
to_visit--;
|
||||||
|
|
||||||
pt0 = to_visit->pt0;
|
pt0 = to_visit->pt0;
|
||||||
pt0_end = to_visit->pt0_end;
|
pt0_end = to_visit->pt0_end;
|
||||||
@ -2182,7 +2192,7 @@ static Term new_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;
|
||||||
}
|
}
|
||||||
@ -2208,7 +2218,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
|
|||||||
}
|
}
|
||||||
/* Do we still have compound terms to visit */
|
/* Do we still have compound terms to visit */
|
||||||
if (to_visit > to_visit0) {
|
if (to_visit > to_visit0) {
|
||||||
to_visit--;
|
to_visit--;
|
||||||
|
|
||||||
pt0 = to_visit->pt0;
|
pt0 = to_visit->pt0;
|
||||||
pt0_end = to_visit->pt0_end;
|
pt0_end = to_visit->pt0_end;
|
||||||
@ -2285,7 +2295,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
|
|||||||
vars_within_term_nvar:
|
vars_within_term_nvar:
|
||||||
{
|
{
|
||||||
WALK_COMPLEX_TERM();
|
WALK_COMPLEX_TERM();
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
|
|
||||||
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
|
derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
|
||||||
@ -2334,7 +2344,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
|
|||||||
static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
|
static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
|
||||||
{
|
{
|
||||||
register CELL **to_visit0,
|
register CELL **to_visit0,
|
||||||
**to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
**to_visit = (CELL **)Yap_PreAllocCodeSpace();
|
||||||
CELL *InitialH = HR;
|
CELL *InitialH = HR;
|
||||||
|
|
||||||
to_visit0 = to_visit;
|
to_visit0 = to_visit;
|
||||||
@ -2676,7 +2686,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)
|
||||||
{
|
{
|
||||||
@ -4328,11 +4338,11 @@ 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; \
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
|
static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS)
|
||||||
|
@ -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, 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);
|
||||||
|
@ -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
|
||||||
|
@ -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} )
|
||||||
|
@ -67,12 +67,10 @@ followed by the failure of that call.
|
|||||||
:- multifile user:unknown_predicate_handler/3.
|
:- multifile user:unknown_predicate_handler/3.
|
||||||
|
|
||||||
undefined_query(G0, M0, Cut) :-
|
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).
|
||||||
|
|
||||||
|
|
||||||
:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @pred '$undefp_search'(+ M0:G0, -MG)
|
* @pred '$undefp_search'(+ M0:G0, -MG)
|
||||||
*
|
*
|
||||||
@ -97,23 +95,22 @@ undefined_query(G0, M0, Cut) :-
|
|||||||
|
|
||||||
% undef handler
|
% undef handler
|
||||||
'$undefp'([M0|G0],MG) :-
|
'$undefp'([M0|G0],MG) :-
|
||||||
x % make sure we do not loop on undefined predicates
|
% make sure we do not loop on undefined predicates
|
||||||
'$undef_setup'(Action,Debug,Current),
|
'$undef_setup'(Action,Debug,Current),
|
||||||
('$get_undefined_predicates'(M0:G0, MG)
|
('$get_undefined_predicates'(M0:G0, MG)
|
||||||
->
|
->
|
||||||
true
|
true
|
||||||
;
|
;
|
||||||
'$undef_error'(M0:G0, MG)
|
'$undef_error'(M0:G0, MG)
|
||||||
),
|
),
|
||||||
'$undef_cleanup'(Action,Debug,Current)
|
'$undef_cleanup'(Action,Debug,Current).
|
||||||
).
|
|
||||||
|
|
||||||
'$undef_error'(M0:G0, MG) :-
|
'$undef_error'(M0:G0, MG) :-
|
||||||
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
|
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
|
||||||
'$yap_strip_module'(M0:G0, EM0, GM0),
|
'$yap_strip_module'(M0:G0, EM0, GM0),
|
||||||
user:unknown_predicate_handler(GM0,EM0,MG),
|
user:unknown_predicate_handler(GM0,EM0,MG),
|
||||||
!.
|
!.
|
||||||
'$handle_error'(Mod:Goal,_) :-
|
'$handle_error'(Mod:Goal,_) :-
|
||||||
functor(Goal,Name,Arity),
|
functor(Goal,Name,Arity),
|
||||||
'$do_error'(existence_error(procedure,Name/Arity), Mod:Goal).
|
'$do_error'(existence_error(procedure,Name/Arity), Mod:Goal).
|
||||||
'$handle_error'(warning,Goal,Mod) :-
|
'$handle_error'(warning,Goal,Mod) :-
|
||||||
@ -124,38 +121,18 @@ x % make sure we do not loop on undefined predicates
|
|||||||
'$handle_error'(fail,_Goal,_Mod) :-
|
'$handle_error'(fail,_Goal,_Mod) :-
|
||||||
fail.
|
fail.
|
||||||
|
|
||||||
|
|
||||||
'$undefp'([M0|G0],MG)
|
|
||||||
|
|
||||||
'$undef_setup'(Action,Debug,Current) :-
|
'$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).
|
||||||
|
|
||||||
|
|
||||||
'$undef_cleanup'(fail,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_)
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user