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

copy_term

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-01-22 19:32:19 +00:00
parent 8ce648422a
commit a6d709dabf
6 changed files with 372 additions and 632 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

263
C/globals.c
View File

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

510
C/utilpreds.c
View File

@ -46,90 +46,90 @@ typedef struct non_single_struct_t {
} non_singletons_t; } non_singletons_t;
#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ #define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \
if (IsPairTerm(d0)) {\ if (IsPairTerm(d0)) { \
if (to_visit + 32 >= to_visit_max) {\ if (to_visit + 32 >= to_visit_max) { \
goto aux_overflow;\ goto aux_overflow; \
}\ } \
LIST0;\ LIST0; \
ptd0 = RepPair(d0);\ ptd0 = RepPair(d0); \
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; }
@ -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 {
LOCK(entryref->lock);
TRAIL_REF(entryref); /* So that fail will erase it */
INC_DBREF_COUNT(entryref);
UNLOCK(entryref->lock);
}
*ptf++ = d0; /* you can just copy other extensions. */
} else
#endif
if (!share) {
UInt sz;
*ptf++ = AbsAppl(HR); /* you can just copy other extensions. */
/* make sure to copy floats */
if (f== FunctorDouble) {
sz = sizeof(Float)/sizeof(CELL)+2;
} else if (f== FunctorLongInt) {
sz = 3;
} else if (f== FunctorString) {
sz = 3+ap2[1];
} else {
CELL *pt = ap2+1;
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
}
if (HR+sz > ASP - 2048) {
goto overflow; goto overflow;
} }
memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); *ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
HR[1] = headp[1];
HR[2] = EndSpecials;
HR += 3;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
break;
case (CELL) FunctorDouble:
if (HR >
ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) {
goto overflow;
}
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
HR[1] = headp[1];
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
HR[2] = headp[2];
HR[3] = EndSpecials;
HR += 4;
#else
HR[2] = EndSpecials;
HR += 3;
#endif
break;
case (CELL) FunctorString:
if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) {
goto overflow;
}
*ptf++ = AbsAppl(HR);
memmove(HR, headp, sizeof(CELL) * (3 + headp[1]));
HR += headp[1] + 3;
break;
default: {
/* big int */
size_t sz = (sizeof(MP_INT) + 3 * CellSize +
((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize,
i;
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
goto overflow;
}
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
for (i = 1; i < sz; i++) {
HR[i] = headp[i];
}
HR += sz; HR += sz;
} else { }
*ptf++ = d0; /* you can just copy other extensions. */
} }
continue; continue;
} }
*ptf = AbsAppl(HR); *ptf = AbsAppl(HR);
ptf++; ptf++;
/* store the terms to visit */ /* store the terms to visit */
if (to_visit+1 >= (struct cp_frame *)AuxSp) {
goto heap_overflow;
}
to_visit->start_cp = pt0; to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end; to_visit->end_cp = pt0_end;
to_visit->to = ptf; to_visit->to = ptf;
to_visit->oldv = *pt0;
to_visit->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; bp = to_visit;
if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp,
ptf PASS_REGS)) {
goto overflow; goto overflow;
} }
to_visit = bp; to_visit = bp;
new = *ptf; new = *ptf;
Bind_NonAtt(ptd0, new);
ptf++;
} else {
#endif
/* first time we met this term */
RESET_VARIABLE(ptf);
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */ /* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow; goto trail_overflow;
} }
} }
Bind_NonAtt(ptd0, (CELL)ptf); TrailedMaBind(ptd0, new);
ptf++;
} else {
/* first time we met this term */
RESET_VARIABLE(ptf);
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
goto trail_overflow;
TrailedMaBind(ptd0, (CELL)ptf);
ptf++; ptf++;
} }
} }
}
/* Do we still have compound terms to visit */ /* 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); reset_trail(TR0);
if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { pop_text_stack(lvl);
return -4; 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;
} }
@ -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);
@ -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,10 +4338,10 @@ extern int vsc;
int vsc; int vsc;
#define RENUMBER_SINGLES\ #define RENUMBER_SINGLES \
if (singles && ap2 >= InitialH && ap2 < HR) {\ if (singles && ap2 >= InitialH && ap2 < HR) { \
renumbervar(d0, numbv++ PASS_REGS);\ renumbervar(d0, numbv++ PASS_REGS); \
continue;\ continue; \
} }

3
H/Yapproto.h
View File

@ -477,6 +477,9 @@ extern void Yap_InitUserCPreds(void);
extern void Yap_InitUserBacks(void); extern void Yap_InitUserBacks(void);
/* utilpreds.c */ /* utilpreds.c */
int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
bool share, bool copy_att_vars, CELL *ptf,
CELL *HLow USES_REGS);
extern Term Yap_CopyTerm(Term); extern Term Yap_CopyTerm(Term);
extern bool Yap_Variant(Term, Term); extern bool Yap_Variant(Term, Term);
extern size_t Yap_ExportTerm(Term, char *, size_t, UInt); extern size_t Yap_ExportTerm(Term, char *, size_t, UInt);

6
H/amiops.h
View File

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

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

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

35
pl/undefined.yap
View File

@ -71,8 +71,6 @@ undefined_query(G0, M0, Cut) :-
'$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,7 +95,7 @@ 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)
-> ->
@ -105,15 +103,14 @@ x % make sure we do not loop on undefined predicates
; ;
'$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_)