Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3
This commit is contained in:
Vítor Santos Costa
@@ -4130,9 +4130,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
|
||||
if (ASP - H < gc_margin/sizeof(CELL) ||
|
||||
effectiveness < 20) {
|
||||
LeaveGCMode( PASS_REGS1 );
|
||||
#ifndef YAPOR
|
||||
if (gc_margin < 2*CalculateStackGap())
|
||||
gc_margin = 2*CalculateStackGap();
|
||||
return Yap_growstack(gc_margin);
|
||||
#endif
|
||||
}
|
||||
/*
|
||||
* debug for(save_total=1; save_total<=N; ++save_total)
|
||||
|
||||
324
C/utilpreds.c
324
C/utilpreds.c
@@ -1166,8 +1166,16 @@ CELL *CellDifH(CELL *hptr, CELL *hlow)
|
||||
return (CELL *)((char *)hptr-(char *)hlow);
|
||||
}
|
||||
|
||||
#define AdjustSizeAtom(X) ((char *)(((CELL)(X)+(8-1)) & ~(8-1)))
|
||||
#define AdjustSizeAtom(X) (((CELL)(X)+(8-1)) & ~(8-1))
|
||||
|
||||
static inline
|
||||
CELL *AdjustSize(CELL *x, char *buf)
|
||||
{
|
||||
UInt offset = (char *)x-buf;
|
||||
return (CELL*)(buf+AdjustSizeAtom(offset));
|
||||
}
|
||||
|
||||
/* export an atom from the symbol table to a buffer */
|
||||
static inline
|
||||
Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
||||
{
|
||||
@@ -1175,7 +1183,7 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
||||
size_t sz;
|
||||
|
||||
ptr = *hpp;
|
||||
ptr = AdjustSizeAtom(ptr);
|
||||
ptr = (char *)AdjustSize((CELL*)ptr, buf);
|
||||
|
||||
p0 = ptr;
|
||||
if (IsWideAtom(at)) {
|
||||
@@ -1189,7 +1197,7 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
||||
} else {
|
||||
*ptr++ = 0;
|
||||
sz = strlen(RepAtom(at)->StrOfAE);
|
||||
if (sz +1 >= len)
|
||||
if (sz + 1 + sizeof(wchar_t) >= len)
|
||||
return (Atom)NULL;
|
||||
strcpy(ptr, RepAtom(at)->StrOfAE);
|
||||
*hpp = ptr+(sz+1);
|
||||
@@ -1198,10 +1206,11 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
|
||||
return (Atom)(p0-buf);
|
||||
}
|
||||
|
||||
/* place a buffer: first arity then the atom */
|
||||
static inline
|
||||
Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
|
||||
{
|
||||
CELL *hptr = (UInt *)AdjustSizeAtom(*hpp);
|
||||
CELL *hptr = AdjustSize((CELL *)*hpp, buf);
|
||||
UInt arity = ArityOfFunctor(f);
|
||||
if (2*sizeof(CELL) >= len)
|
||||
return NULL;
|
||||
@@ -1209,7 +1218,9 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
|
||||
*hpp = (char *)(hptr+1);
|
||||
if (!export_atom(NameOfFunctor(f), hpp, buf, len))
|
||||
return NULL;
|
||||
/* increment so that it cannot be mistaken with a standard functor */
|
||||
/* increment so that it cannot be mistaken with a functor on the stack,
|
||||
(increment is used as a tag ........01
|
||||
*/
|
||||
return (Functor)(((char *)hptr-buf)+1);
|
||||
}
|
||||
|
||||
@@ -1228,9 +1239,10 @@ export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, siz
|
||||
{
|
||||
char *td = bptr;
|
||||
CELL *bf = (CELL *)buf;
|
||||
if (buf + len < (char *)((CELL *)td + (tf-t0)))
|
||||
if (buf + len < (char *)((CELL *)td + (tf-t0))) {
|
||||
return FALSE;
|
||||
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
|
||||
}
|
||||
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
|
||||
bf[0] = (td-buf);
|
||||
bf[1] = (tf-t0);
|
||||
bf[2] = inpt;
|
||||
@@ -1541,6 +1553,7 @@ static Atom
|
||||
AddAtom(Atom t, char *buf)
|
||||
{
|
||||
char *s = buf+(UInt)t;
|
||||
|
||||
if (!*s) {
|
||||
return Yap_LookupAtom(s+1);
|
||||
} else {
|
||||
@@ -1557,7 +1570,7 @@ FetchFunctor(CELL *pt, char *buf)
|
||||
UInt arity = *ptr++;
|
||||
Atom name, at;
|
||||
// and then an atom
|
||||
ptr = (CELL *)AdjustSizeAtom((char*)ptr);
|
||||
ptr = AdjustSize(ptr, buf);
|
||||
name = (Atom)((char *)ptr-buf);
|
||||
at = AddAtom(name, buf);
|
||||
*pt = (CELL)Yap_MkFunctor(at, arity);
|
||||
@@ -1627,7 +1640,7 @@ Yap_ImportTerm(char * buf) {
|
||||
return MkVarTerm();
|
||||
if (IsAtomOrIntTerm(tinp)) {
|
||||
if (IsAtomTerm(tinp)) {
|
||||
char *pt = AdjustSizeAtom((char *)(bc+3));
|
||||
char *pt = (char *)AdjustSize(bc+3, buf);
|
||||
return MkAtomTerm(Yap_LookupAtom(pt));
|
||||
} else
|
||||
return tinp;
|
||||
@@ -4189,6 +4202,298 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, register
|
||||
CELL *pt1, CELL *npt USES_REGS)
|
||||
{
|
||||
register CELL **to_visit = (CELL **)ASP;
|
||||
tr_fr_ptr OLDTR = TR;
|
||||
int out;
|
||||
CELL *bindings = NULL, *tbindings = NULL;
|
||||
HB = H;
|
||||
|
||||
loop:
|
||||
while (pt0 < pt0_end) {
|
||||
register CELL d0, d1;
|
||||
|
||||
++ pt0;
|
||||
++ pt1;
|
||||
d0 = Derefa(pt0);
|
||||
d1 = Derefa(pt1);
|
||||
if (d0 == d1) {
|
||||
*npt++ = d0;
|
||||
continue;
|
||||
} else if (IsVarTerm(d0)) {
|
||||
CELL *match, *omatch = NULL;
|
||||
|
||||
match = VarOfTerm(d0);
|
||||
if (match >= HB) {
|
||||
while (match >= HB) {
|
||||
/* chained to a sequence */
|
||||
if (Yap_eq(d1, match[1]) ) {
|
||||
*npt++ = match[2];
|
||||
break;
|
||||
}
|
||||
omatch = match;
|
||||
match = (CELL *)match[3];
|
||||
}
|
||||
/* found a match */
|
||||
if (match >= HB)
|
||||
continue;
|
||||
/* could not find a match, add to end of chain */
|
||||
RESET_VARIABLE(H); /* key */
|
||||
H[1] = d1; /* comparison value */
|
||||
H[2] = (CELL)npt; /* new value */
|
||||
H[3] = (CELL)match; /* end of chain points back to first cell */
|
||||
omatch[3] = (CELL)H;
|
||||
H+=4;
|
||||
RESET_VARIABLE(npt);
|
||||
npt++;
|
||||
continue;
|
||||
}
|
||||
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
|
||||
goto trail_overflow;
|
||||
}
|
||||
RESET_VARIABLE(H);
|
||||
H[1] = d1;
|
||||
H[2] = (CELL)npt;
|
||||
H[3] = d0;
|
||||
Bind(VarOfTerm(d0), (CELL)H);
|
||||
H+=4;
|
||||
RESET_VARIABLE(npt);
|
||||
npt++;
|
||||
continue;
|
||||
} else if (IsPairTerm(d0) && IsPairTerm(d1)) {
|
||||
CELL *match = bindings;
|
||||
|
||||
while (match) {
|
||||
if (match[0] == d0 && match[1] == d1) {
|
||||
*npt++ = match[2];
|
||||
break;
|
||||
}
|
||||
match = (CELL *)match[3];
|
||||
}
|
||||
if (match) {
|
||||
continue;
|
||||
}
|
||||
if (bindings) {
|
||||
*tbindings = (CELL)H;
|
||||
} else {
|
||||
bindings = H;
|
||||
}
|
||||
H[0] = d0;
|
||||
H[1] = d1;
|
||||
H[2] = AbsPair(H+4);
|
||||
H[3] = (CELL)NULL;
|
||||
tbindings = H+3;
|
||||
H+=4;
|
||||
*npt++ = AbsPair(H);
|
||||
#ifdef RATIONAL_TREES
|
||||
/* now link the two structures so that no one else will */
|
||||
/* come here */
|
||||
to_visit -= 5;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = tbindings;
|
||||
to_visit[4] = npt;
|
||||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit -= 4;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = npt;
|
||||
}
|
||||
#endif
|
||||
pt0 = RepPair(d0) - 1;
|
||||
pt0_end = RepPair(d0) + 1;
|
||||
pt1 = RepPair(d1) - 1;
|
||||
npt = H;
|
||||
H += 2;
|
||||
if (H > (CELL *)to_visit -1024)
|
||||
goto stack_overflow;
|
||||
continue;
|
||||
} else if (IsApplTerm(d0) && IsApplTerm(d1)) {
|
||||
CELL *ap2 = RepAppl(d0);
|
||||
CELL *ap3 = RepAppl(d1);
|
||||
Functor f = (Functor)(*ap2);
|
||||
Functor f2 = (Functor)(*ap3);
|
||||
if (f == f2) {
|
||||
CELL *match = bindings;
|
||||
|
||||
if (IsExtensionFunctor(f)) {
|
||||
if (unify_extension(f, d0, ap2, d1)) {
|
||||
*npt++ = d0;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
while (match) {
|
||||
if (match[0] == d0 && match[1] == d1) {
|
||||
*npt++ = match[2];
|
||||
break;
|
||||
}
|
||||
match = (CELL *)match[3];
|
||||
}
|
||||
if (match) {
|
||||
continue;
|
||||
}
|
||||
if (bindings) {
|
||||
*tbindings = (CELL)H;
|
||||
} else {
|
||||
bindings = H;
|
||||
}
|
||||
H[0] = d0;
|
||||
H[1] = d1;
|
||||
H[2] = AbsAppl(H+4);
|
||||
H[3] = (CELL)NULL;
|
||||
tbindings = H+3;
|
||||
H+=4;
|
||||
*npt++ = AbsAppl(H);
|
||||
#ifdef RATIONAL_TREES
|
||||
/* now link the two structures so that no one else will */
|
||||
/* come here */
|
||||
to_visit -= 5;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = tbindings;
|
||||
to_visit[4] = npt;
|
||||
#else
|
||||
/* store the terms to visit */
|
||||
if (pt0 < pt0_end) {
|
||||
to_visit -= 4;
|
||||
to_visit[0] = pt0;
|
||||
to_visit[1] = pt0_end;
|
||||
to_visit[2] = pt1;
|
||||
to_visit[3] = npt;
|
||||
}
|
||||
#endif
|
||||
d0 = ArityOfFunctor(f);
|
||||
pt0 = ap2;
|
||||
pt0_end = ap2 + d0;
|
||||
pt1 = ap3;
|
||||
npt = H;
|
||||
*npt++ = (CELL)f;
|
||||
H += d0;
|
||||
if (H > (CELL *)to_visit -1024)
|
||||
goto stack_overflow;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
RESET_VARIABLE(npt);
|
||||
npt++;
|
||||
}
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit < (CELL **)ASP) {
|
||||
#ifdef RATIONAL_TREES
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
pt1 = to_visit[2];
|
||||
tbindings = to_visit[3];
|
||||
npt = to_visit[ 4];
|
||||
if (!tbindings) {
|
||||
bindings = NULL;
|
||||
}
|
||||
to_visit += 5;
|
||||
#else
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
pt1 = to_visit[2];
|
||||
npt = to_visit[3];
|
||||
to_visit += 4;
|
||||
#endif
|
||||
goto loop;
|
||||
}
|
||||
out = 1;
|
||||
|
||||
complete:
|
||||
/* get rid of intermediate variables */
|
||||
while (TR != OLDTR) {
|
||||
CELL *pt1 = (CELL *) TrailTerm(--TR);
|
||||
RESET_VARIABLE(pt1);
|
||||
}
|
||||
HBREG = B->cp_h;
|
||||
return out;
|
||||
|
||||
stack_overflow:
|
||||
out = -1;
|
||||
goto complete;
|
||||
|
||||
trail_overflow:
|
||||
out = -2;
|
||||
goto complete;
|
||||
|
||||
}
|
||||
|
||||
static Int
|
||||
p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */
|
||||
{
|
||||
int out = 0;
|
||||
|
||||
while (out != 1) {
|
||||
Term t1 = Deref(ARG1);
|
||||
Term t2 = Deref(ARG2);
|
||||
CELL *oldH = H;
|
||||
|
||||
if (t1 == t2)
|
||||
return Yap_unify(ARG3,t1);
|
||||
if (IsPairTerm(t1) && IsPairTerm(t2)) {
|
||||
Term tf = AbsAppl(H);
|
||||
H += 2;
|
||||
HB = H;
|
||||
if ((out = term_subsumer_complex(RepPair(t1)-1,
|
||||
RepPair(t1)+1,
|
||||
RepPair(t2)-1, H-2 PASS_REGS)) > 0) {
|
||||
HB = B->cp_h;
|
||||
return Yap_unify(ARG3,tf);
|
||||
}
|
||||
} else if (IsApplTerm(t1) && IsApplTerm(t2)) {
|
||||
Functor f1;
|
||||
|
||||
if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) {
|
||||
if (IsExtensionFunctor(f1)) {
|
||||
if (unify_extension(f1, t1, RepAppl(t1), t2)) {
|
||||
return Yap_unify(ARG3,t1);
|
||||
}
|
||||
} else {
|
||||
Term tf = AbsAppl(H);
|
||||
UInt ar = ArityOfFunctor(f1);
|
||||
H[0] = (CELL)f1;
|
||||
H += 1+ar;
|
||||
HB = H;
|
||||
if ((out = term_subsumer_complex(RepAppl(t1),
|
||||
RepAppl(t1)+ArityOfFunctor(f1),
|
||||
RepAppl(t2), H-ar PASS_REGS)) > 0) {
|
||||
HB = B->cp_h;
|
||||
return Yap_unify(ARG3,tf);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
HB = B->cp_h;
|
||||
if (out == 0) {
|
||||
return Yap_unify(ARG3, MkVarTerm());
|
||||
} else {
|
||||
H = oldH;
|
||||
if (out == -1) {
|
||||
if (!Yap_gcl((ASP-H)*sizeof(CELL), 0, ENV, gc_P(P,CP))) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_subsumer");
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
/* Trail overflow */
|
||||
if (!Yap_growtrail(0, FALSE)) {
|
||||
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "in term_subsumer");
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
#ifdef DEBUG
|
||||
static Int
|
||||
p_force_trail_expansion( USES_REGS1 )
|
||||
@@ -4875,6 +5180,7 @@ void Yap_InitUtilCPreds(void)
|
||||
Yap_InitCPred("instantiated_term_hash", 4, p_instantiated_term_hash, 0);
|
||||
Yap_InitCPred("variant", 2, p_variant, 0);
|
||||
Yap_InitCPred("subsumes", 2, p_subsumes, 0);
|
||||
Yap_InitCPred("term_subsumer", 3, p_term_subsumer, 0);
|
||||
Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0);
|
||||
Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0);
|
||||
Yap_InitCPred("export_term", 3, p_export_term, 0);
|
||||
|
||||
Reference in New Issue
Block a user