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

a new and hopefully much better implementation of atts.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1392 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-09-09 17:24:39 +00:00
parent 2444b775b7
commit 03ba05f24a
14 changed files with 624 additions and 495 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/absmi.c
View File

@ -10,8 +10,11 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-09-08 22:06:44 $,$Author: rslopes $ * * Last rev: $Date: 2005-09-09 17:24:37 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.176 2005/09/08 22:06:44 rslopes
* BEAM for YAP update...
*
* Revision 1.175 2005/08/12 17:00:00 ricroc * Revision 1.175 2005/08/12 17:00:00 ricroc
* TABLING FIX: support for incomplete tables * TABLING FIX: support for incomplete tables
* *
@ -1754,12 +1757,17 @@ Yap_absmi(int inp)
} }
pt1--; pt1--;
} else if (IsApplTerm(d1)) { } else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
} else {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0-1) = TrailTerm(pt1-1); TrailTerm(pt0-1) = TrailTerm(pt1-1);
TrailVal(pt0-1) = TrailVal(pt1-1); TrailVal(pt0-1) = TrailVal(pt1-1);
pt0 -= 2; pt0 -= 2;
pt1 -= 2; pt1 -= 2;
}
} else { } else {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
@ -1793,6 +1801,13 @@ Yap_absmi(int inp)
} }
pt1++; pt1++;
} else if (IsApplTerm(d1)) { } else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
#ifdef FROZEN_STACKS
pt1 += 2;
#else
pt1 += 3;
#endif
} else {
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1; TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
@ -1806,6 +1821,7 @@ Yap_absmi(int inp)
pt0 += 3; pt0 += 3;
pt1 += 3; pt1 += 3;
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
}
} else if (IsPairTerm(d1)) { } else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1); CELL *pt = RepPair(d1);
if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) { if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {

711
C/attvar.c
View File

@ -30,10 +30,6 @@ static char SccsId[]="%W% %G%";
#ifdef COROUTINING #ifdef COROUTINING
STATIC_PROTO(Term InitVarTime, (void));
STATIC_PROTO(void PutAtt, (attvar_record *,Int,Term));
STATIC_PROTO(Int BuildNewAttVar, (Term,Int,Term));
static CELL * static CELL *
AddToQueue(attvar_record *attv) AddToQueue(attvar_record *attv)
{ {
@ -75,68 +71,55 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
register attvar_record *attv = (attvar_record *)orig; register attvar_record *attv = (attvar_record *)orig;
register attvar_record *newv; register attvar_record *newv;
CELL **to_visit = *to_visit_ptr; CELL **to_visit = *to_visit_ptr;
Term time = InitVarTime(); CELL *vt;
Int j;
/* add a new attributed variable */ /* add a new attributed variable */
newv = DelayTop(); newv = DelayTop();
if (H0 - (CELL *)newv < 1024+(2*NUM_OF_ATTS)) if (H0 - (CELL *)newv < 1024)
return FALSE; return FALSE;
RESET_VARIABLE(&(newv->Done));
newv->sus_id = attvars_ext;
RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Value));
newv->NS = Yap_UpdateTimedVar(AttsMutableList, (CELL)&(newv->Done)); RESET_VARIABLE(&(newv->Done));
for (j = 0; j < NUM_OF_ATTS; j++) { vt = &(attv->Atts);
Term t = Deref(attv->Atts[2*j+1]);
newv->Atts[2*j] = time;
if (IsVarTerm(t)) {
CELL *vt = VarOfTerm(t);
if (vt == attv->Atts+(2*j+1)) {
RESET_VARIABLE(newv->Atts+(2*j+1));
} else {
to_visit[0] = vt-1; to_visit[0] = vt-1;
to_visit[1] = vt; to_visit[1] = vt;
to_visit[2] = newv->Atts+2*j+1; to_visit[2] = &(newv->Atts);
to_visit[3] = (CELL *)vt[-1]; to_visit[3] = (CELL *)vt[-1];
to_visit += 4; *to_visit_ptr = to_visit+4;
}
} else if (IsVarTerm(t) && IsAtomicTerm(t)) {
newv->Atts[2*j+1] = t;
} else {
to_visit[0] = attv->Atts+2*j;
to_visit[1] = attv->Atts+2*j+1;
to_visit[2] = newv->Atts+2*j+1;
to_visit[3] = (CELL *)(attv->Atts[2*j]);
to_visit += 4;
}
}
*to_visit_ptr = to_visit;
*res = (CELL)&(newv->Done); *res = (CELL)&(newv->Done);
SetDelayTop(attv->Atts+2*j); SetDelayTop(newv+1);
return(TRUE); return TRUE;
} }
static Term static Term
AttVarToTerm(CELL *orig) AttVarToTerm(CELL *orig)
{ {
register attvar_record *attv = (attvar_record *)orig; attvar_record *attv = (attvar_record *)orig;
Term list = TermNil;
int j; return attv->Atts;
for (j = 0; j < NUM_OF_ATTS; j++) { }
Term t = attv->Atts[2*(NUM_OF_ATTS-j-1)+1];
if (IsVarTerm(t)) static attvar_record *
list = MkPairTerm(MkVarTerm(),list); BuildNewAttVar(void)
else {
list = MkPairTerm(t,list); attvar_record *attv = DelayTop();
if (H0 - (CELL *)(attv+1) < 1024) {
return NULL;
} }
return(list); RESET_VARIABLE(&(attv->Done));
RESET_VARIABLE(&(attv->Value));
RESET_VARIABLE(&(attv->Atts));
SetDelayTop(attv+1);
return attv;
} }
static int static int
TermToAttVar(Term attvar, Term to) TermToAttVar(Term attvar, Term to)
{ {
return(BuildNewAttVar(to, -1, attvar)); attvar_record *attv = BuildNewAttVar();
if (!attv)
return FALSE;
attv->Atts = attvar;
return TRUE;
} }
static void static void
@ -155,11 +138,6 @@ WakeAttVar(CELL* pt1, CELL reg2)
attvar_record *susp2 = (attvar_record *)VarOfTerm(reg2); attvar_record *susp2 = (attvar_record *)VarOfTerm(reg2);
/* binding two suspended variables, be careful */ /* binding two suspended variables, be careful */
if (susp2->sus_id != attvars_ext) {
/* joining two different kinds of suspensions */
Yap_Error(SYSTEM_ERROR, TermNil, "joining two different suspensions not implemented");
return;
}
if (susp2 >= attv) { if (susp2 >= attv) {
if (!IsVarTerm(susp2->Value) || !IsUnboundVar(&susp2->Value)) { if (!IsVarTerm(susp2->Value) || !IsUnboundVar(&susp2->Value)) {
/* oops, our goal is on the queue to be woken */ /* oops, our goal is on the queue to be woken */
@ -207,13 +185,10 @@ static void
mark_attvar(CELL *orig) mark_attvar(CELL *orig)
{ {
register attvar_record *attv = (attvar_record *)orig; register attvar_record *attv = (attvar_record *)orig;
Int i;
Yap_mark_external_reference(&(attv->Value)); Yap_mark_external_reference(&(attv->Value));
Yap_mark_external_reference(&(attv->Done)); Yap_mark_external_reference(&(attv->Done));
for (i = 0; i < NUM_OF_ATTS; i++) { Yap_mark_external_reference(&(attv->Atts));
Yap_mark_external_reference(attv->Atts+2*i+1);
}
} }
#if FROZEN_STACKS #if FROZEN_STACKS
@ -224,173 +199,113 @@ CurrentTime(void) {
#endif #endif
static Term static Term
InitVarTime(void) { BuildAttTerm(Functor mfun, UInt ar)
#if FROZEN_STACKS {
if (B->cp_tr == TR) { CELL *h0 = H;
/* we run the risk of not making non-determinate bindings before UInt i;
the end of the night */
/* so we just init a TR cell that will not harm anyone */ if (H+(1024+ar) > ASP) {
Bind((CELL *)(TR+1),AbsAppl(H-1)); return 0L;
} }
return(MkIntegerTerm(B->cp_tr-(tr_fr_ptr)Yap_TrailBase)); H[0] = (CELL)mfun;
#else RESET_VARIABLE(H+1);
Term t = (CELL)H; H += 2;
*H++ = TermFoundVar; for (i = 1; i< ar; i++) {
return(t); *H = TermFoundVar;
#endif H++;
}
return AbsAppl(h0);
}
static Term
SearchAttsForModule(Term start, Functor mfun)
{
do {
if (IsVarTerm(start) ||
FunctorOfTerm(start) == mfun)
return start;
start = ArgOfTerm(1,start);
} while (TRUE);
}
static Term
SearchAttsForModuleName(Term start, Atom mname)
{
do {
if (IsVarTerm(start) ||
NameOfFunctor(FunctorOfTerm(start)) == mname)
return start;
start = ArgOfTerm(1,start);
} while (TRUE);
} }
static void static void
PutAtt(attvar_record *attv, Int i, Term tatt) { AddNewModule(attvar_record *attv, Term t, int new)
Int pos = i*2;
#if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)Yap_TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp
&& timestmp <= TR) {
#if defined(SBA)
if (Unsigned((Int)(attv)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
CELL *ptr = STACK_TO_SBA(attv->Atts+pos+1);
*ptr = tatt;
} else
#endif
attv->Atts[pos+1] = tatt;
if (Unsigned((Int)(attv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = tatt;
} else {
Term tnewt;
MaBind(attv->Atts+pos+1, tatt);
tnewt = CurrentTime();
MaBind(attv->Atts+pos, tnewt);
}
#else
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp) {
attv->Atts[pos+1] = tatt;
} else {
Term tnewt;
MaBind(attv->Atts+pos+1, tatt);
tnewt = (Term)H;
*H++ = TermFoundVar;
MaBind(attv->Atts+pos, tnewt);
}
#endif
}
static Int
UpdateAtt(attvar_record *attv, Int i, Term tatt) {
Int pos = i*2;
Term tv = attv->Atts[pos+1];
if (!IsVarTerm(tv) || !IsUnboundVar(attv->Atts+pos+1)) {
tatt = MkPairTerm(tatt, attv->Atts[pos+1]);
} else {
tatt = MkPairTerm(tatt, TermNil);
}
PutAtt(attv, i, tatt);
return TRUE;
}
static Int
RmAtt(attvar_record *attv, Int i) {
Int pos = i *2;
if (!IsVarTerm(attv->Atts[pos+1])) {
#if FROZEN_STACKS
tr_fr_ptr timestmp = (tr_fr_ptr)Yap_TrailBase+IntegerOfTerm(attv->Atts[pos]);
if (B->cp_tr <= timestmp
&& timestmp <= TR) {
RESET_VARIABLE(attv->Atts+(pos+1));
if (Unsigned((Int)(attv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = attv->Atts[pos+1];
} else {
/* reset the variable */
Term tnewt;
#ifdef SBA
MaBind(attv->Atts+(pos+1), 0L);
#else
MaBind(attv->Atts+(pos+1), (CELL)(attv->Atts+(pos+1)));
#endif
tnewt = CurrentTime();
MaBind(attv->Atts+pos, tnewt);
}
#else
CELL *timestmp = (CELL *)(attv->Atts[pos]);
if (B->cp_h <= timestmp) {
RESET_VARIABLE(attv->Atts+(pos+1));
} else {
/* reset the variable */
Term tnewt;
#ifdef SBA
MaBind(attv->Atts+(pos+1), 0L);
#else
MaBind(attv->Atts+(pos+1), (CELL)(attv->Atts+(pos+1)));
#endif
tnewt = (Term)H;
*H++ = TermFoundVar;
MaBind(attv->Atts+pos, tnewt);
}
#endif
}
return(TRUE);
}
static Int
BuildNewAttVar(Term t, Int i, Term tatt)
{ {
/* allocate space in Heap */ if (IsVarTerm(attv->Atts)) {
Term time; if (new) {
int j; attv->Atts = t;
attvar_record *attv = DelayTop();
if (H0 - (CELL *)attv < 1024+(2*NUM_OF_ATTS)) {
return FALSE;
}
time = InitVarTime();
RESET_VARIABLE(&(attv->Value));
RESET_VARIABLE(&(attv->Done));
attv->sus_id = attvars_ext;
for (j = 0; j < NUM_OF_ATTS; j++) {
attv->Atts[2*j] = time;
RESET_VARIABLE(attv->Atts+(2*j+1));
}
attv->NS = Yap_UpdateTimedVar(AttsMutableList, (CELL)&(attv->Done));
Bind((CELL *)t,(CELL)attv);
SetDelayTop(attv->Atts+2*j);
/* avoid trouble in gc */
/* if i < 0 then we have the list of arguments */
if (i < 0) {
Int j = 0;
while (IsPairTerm(tatt)) {
Term t = HeadOfTerm(tatt);
/* I need to do this because BuildNewAttVar may shift the stacks */
if (!IsVarTerm(t)) {
attv->Atts[2*j+1] = t;
}
j++;
tatt = TailOfTerm(tatt);
}
return TRUE;
} else { } else {
PutAtt(attv, i, tatt); Bind(&(attv->Atts),t);
return TRUE; }
} else {
Term *wherep = &attv->Atts;
do {
if (IsVarTerm(*wherep)) {
Bind_Global(wherep,t);
return;
} else {
wherep = RepAppl(Deref(*wherep))+1;
}
} while (TRUE);
} }
} }
static Int static void
GetAtt(attvar_record *attv, int i) { ReplaceAtts(attvar_record *attv, Term oatt, Term att)
Int pos = i *2; {
#if SBA UInt ar = ArityOfFunctor(FunctorOfTerm(oatt)), i;
if (IsVarTerm(attv->Atts[pos+1]) && IsUnboundVar(attv->Atts+pos+1)) CELL *oldp = RepAppl(oatt)+1;
return((CELL)&(attv->Atts[pos+1])); CELL *newp = RepAppl(att)+1;
#endif
return(attv->Atts[pos+1]); *newp++ = *oldp++;
for (i=1; i< ar; i++) {
if (*newp == TermFoundVar) {
*newp = *oldp;
}
oldp++;
newp++;
}
if (attv->Atts == oatt) {
if (RepAppl(attv->Atts) >= HB)
attv->Atts = att;
else
MaBind(&(attv->Atts), att);
} else {
Term *wherep = &attv->Atts;
do {
if (*wherep == oatt) {
MaBind(wherep, att);
return;
} else {
wherep = RepAppl(Deref(*wherep))+1;
}
} while (TRUE);
}
} }
static Int static void
FreeAtt(attvar_record *attv, int i) { PutAtt(Int pos, Term atts, Term att)
Int pos = i *2; {
return(IsVarTerm(attv->Atts[pos+1])); if (IsVarTerm(att) && (CELL *)att > H && (CELL *)att < LCL0) {
/* globalise locals */
Term tnew = MkVarTerm();
Bind((CELL *)att, tnew);
att = tnew;
}
MaBind(RepAppl(atts)+pos, att);
} }
static Int static Int
@ -426,35 +341,35 @@ BindAttVar(attvar_record *attv) {
static Term static Term
GetAllAtts(attvar_record *attv) { GetAllAtts(attvar_record *attv) {
Int i; /* check if we are already there */
Term t = TermNil; return attv->Atts;
for (i = NUM_OF_ATTS-1; i >= 0; i --) {
if (!IsVarTerm(attv->Atts[2*i+1]))
t = MkPairTerm(MkPairTerm(MkIntegerTerm(i),attv->Atts[2*i+1]), t);
}
return(t);
} }
static Term static Term
AllAttVars(Term t) { AllAttVars(attvar_record *attv) {
CELL *h0 = H; CELL *h0 = H;
attvar_record *max = DelayTop();
while (t != TermNil) { while (attv != max) {
attvar_record *attv;
if (ASP - H < 1024) { if (ASP - H < 1024) {
H = h0; H = h0;
return 0L; return 0L;
} }
attv = (attvar_record *)VarOfTerm(t);
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) { if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
if (IsIntegerTerm(attv->Atts)) {
/* skip call residue(s) */
UInt n = IntegerOfTerm(attv->Atts)-1;
attv += n;
} else {
if (H != h0) { if (H != h0) {
H[-1] = AbsPair(H); H[-1] = AbsPair(H);
} }
H[0] = t; H[0] = (CELL)attv;
H += 2; H += 2;
} }
t = attv->NS; }
attv++;
} }
if (H != h0) { if (H != h0) {
H[-1] = TermNil; H[-1] = TermNil;
@ -470,54 +385,37 @@ p_put_att(void) {
Term inp = Deref(ARG1); Term inp = Deref(ARG1);
/* if this is unbound, ok */ /* if this is unbound, ok */
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { attvar_record *attv;
attvar_record *attv = (attvar_record *)VarOfTerm(inp); Atom modname = AtomOfTerm(Deref(ARG2));
exts id = (exts)attv->sus_id; UInt ar = IntegerOfTerm(Deref(ARG3));
Functor mfun;
Term tatts;
int new = FALSE;
if (id != attvars_ext) { if (IsAttachedTerm(inp)) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); attv = (attvar_record *)VarOfTerm(inp);
return(FALSE);
}
PutAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3));
return TRUE;
}
while (!BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), Deref(ARG3))) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
return FALSE;
}
inp = Deref(ARG1);
}
return TRUE;
} else { } else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); while (!(attv = BuildNewAttVar())) {
return(FALSE);
}
}
static Int
p_update_att(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
return(UpdateAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3)));
}
while (!BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), MkPairTerm(Deref(ARG3),TermNil))) {
if (!Yap_growglobal(NULL)) { if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage); Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
inp = Deref(ARG1); inp = Deref(ARG1);
} }
new = TRUE;
}
mfun= Yap_MkFunctor(modname,ar);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) {
while (!(tatts = BuildAttTerm(mfun,ar))) {
if (!Yap_gc(5, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
Yap_unify(ARG1, (Term)attv);
AddNewModule(attv,tatts,new);
}
PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, Deref(ARG5));
return TRUE; return TRUE;
} else { } else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
@ -531,47 +429,109 @@ p_rm_att(void) {
Term inp = Deref(ARG1); Term inp = Deref(ARG1);
/* if this is unbound, ok */ /* if this is unbound, ok */
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { attvar_record *attv;
attvar_record *attv = (attvar_record *)VarOfTerm(inp); Atom modname = AtomOfTerm(Deref(ARG2));
exts id = (exts)attv->sus_id; UInt ar = IntegerOfTerm(Deref(ARG3));
Functor mfun;
Term tatts;
int new = FALSE;
if (id != attvars_ext) { if (IsAttachedTerm(inp)) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2"); attv = (attvar_record *)VarOfTerm(inp);
return(FALSE);
}
return(RmAtt(attv, IntegerOfTerm(Deref(ARG2))));
}
return(TRUE);
} else { } else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"delete_attribute/2"); while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
return FALSE;
}
inp = Deref(ARG1);
}
new = TRUE;
Yap_unify(ARG1, (Term)attv);
}
mfun= Yap_MkFunctor(modname,ar);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) {
while (!(tatts = BuildAttTerm(mfun,ar))) {
if (!Yap_gc(4, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
AddNewModule(attv,tatts,new);
} else {
PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, TermFoundVar);
}
return TRUE;
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE); return(FALSE);
} }
} }
static Int
p_put_atts(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
Term otatts;
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
attvar_record *attv;
Term tatts = Deref(ARG2);
Functor mfun = FunctorOfTerm(tatts);
int new = FALSE;
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
} else {
while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
return FALSE;
}
tatts = Deref(ARG2);
}
new = TRUE;
Yap_unify(ARG1, (Term)attv);
}
if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts,mfun))) {
AddNewModule(attv,tatts,new);
} else {
ReplaceAtts(attv, otatts, tatts);
}
return TRUE;
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return FALSE;
}
}
static Int static Int
p_get_att(void) { p_get_att(void) {
/* receive a variable in ARG1 */ /* receive a variable in ARG1 */
Term inp = Deref(ARG1); Term inp = Deref(ARG1);
/* if this is unbound, ok */ /* if this is unbound, ok */
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { Atom modname = AtomOfTerm(Deref(ARG2));
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
Term out;
exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (IsAttachedTerm(inp)) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); attvar_record *attv;
return FALSE; Term tout, tatts;
}
out = GetAtt(attv,IntegerOfTerm(Deref(ARG2))); attv = (attvar_record *)VarOfTerm(inp);
return !IsVarTerm(out) && Yap_unify(ARG3,out); if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
}
/* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2");*/
return FALSE; return FALSE;
tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
if (tout == TermFoundVar) return FALSE;
return Yap_unify(tout, ARG4);
} else { } else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
return FALSE; return FALSE;
} }
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
} }
static Int static Int
@ -580,19 +540,86 @@ p_free_att(void) {
Term inp = Deref(ARG1); Term inp = Deref(ARG1);
/* if this is unbound, ok */ /* if this is unbound, ok */
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { Atom modname = AtomOfTerm(Deref(ARG2));
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
exts id = (exts)attv->sus_id;
if (id != attvars_ext) { if (IsAttachedTerm(inp)) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2"); attvar_record *attv;
Term tout, tatts;
attv = (attvar_record *)VarOfTerm(inp);
if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
return TRUE;
tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
return (tout == TermFoundVar);
} else {
/* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
return TRUE;
}
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE); return(FALSE);
} }
return(FreeAtt(attv,IntegerOfTerm(Deref(ARG2)))); }
static Int
p_get_atts(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv;
Term tatts;
Term access = Deref(ARG2);
Functor mfun = FunctorOfTerm(access);
UInt ar, i;
CELL *old, *new;
attv = (attvar_record *)VarOfTerm(inp);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun)))
return FALSE;
ar = ArityOfFunctor(mfun);
new = RepAppl(access)+2;
old = RepAppl(tatts)+2;
for (i = 1; i < ar; i++,new++,old++) {
if (*new != TermFreeTerm) {
if (*old == TermFoundVar && *new != TermFoundVar)
return FALSE;
if (!Yap_unify(*new,*old)) return FALSE;
} }
return(TRUE); }
return TRUE;
} else { } else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"free_att/2"); /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
return FALSE;
}
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE);
}
}
static Int
p_has_atts(void) {
/* receive a variable in ARG1 */
Term inp = Deref(ARG1);
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv;
Term tatts;
Term access = Deref(ARG2);
Functor mfun = FunctorOfTerm(access);
attv = (attvar_record *)VarOfTerm(inp);
return !IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun));
} else {
/* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
return FALSE;
}
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2");
return(FALSE); return(FALSE);
} }
} }
@ -605,12 +632,6 @@ p_bind_attvar(void) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp); attvar_record *attv = (attvar_record *)VarOfTerm(inp);
exts id = (exts)attv->sus_id;
if (id != attvars_ext) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
return(BindAttVar(attv)); return(BindAttVar(attv));
} }
return(TRUE); return(TRUE);
@ -628,12 +649,6 @@ p_get_all_atts(void) {
if (IsVarTerm(inp)) { if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) { if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp); attvar_record *attv = (attvar_record *)VarOfTerm(inp);
exts id = (exts)(attv->sus_id);
if (id != attvars_ext) {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return(FALSE);
}
return Yap_unify(ARG2,GetAllAtts(attv)); return Yap_unify(ARG2,GetAllAtts(attv));
} }
return TRUE; return TRUE;
@ -644,31 +659,52 @@ p_get_all_atts(void) {
} }
static Int static Int
p_inc_atts(void) p_modules_with_atts(void) {
{ /* receive a variable in ARG1 */
Term t = MkIntegerTerm(NUM_OF_ATTS); Term inp = Deref(ARG1);
NUM_OF_ATTS++; /* if this is unbound, ok */
return(Yap_unify(ARG1,t)); if (IsVarTerm(inp)) {
} if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
CELL *h0 = H;
Term tatt;
static Int if (IsVarTerm(tatt = attv->Atts))
p_n_atts(void) return Yap_unify(ARG2,TermNil);
{ while (!IsVarTerm(tatt)) {
Term t = MkIntegerTerm(NUM_OF_ATTS); if (H != H0)
return Yap_unify(ARG1,t); H[-1] = AbsPair(H);
*H = MkAtomTerm(NameOfFunctor(FunctorOfTerm(tatt)));
H+=2;
tatt = ArgOfTerm(1,tatt);
}
H[-1] = TermNil;
return Yap_unify(ARG2,AbsPair(h0));
}
return TermNil;
} else {
Yap_Error(TYPE_ERROR_VARIABLE,inp,"get_att/2");
return FALSE;
}
} }
static Int static Int
p_all_attvars(void) p_all_attvars(void)
{ {
do {
Term out; Term out;
while ((out = AllAttVars(Yap_ReadTimedVar(AttsMutableList))) == 0L) { attvar_record *base;
base = (attvar_record *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(AttsMutableList));
if (!(out = AllAttVars(base))) {
if (!Yap_gc(1, ENV, P)) { if (!Yap_gc(1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
} } else {
return Yap_unify(ARG1,out); return Yap_unify(ARG1,out);
}
} while (TRUE);
} }
static Int static Int
@ -676,8 +712,7 @@ p_is_attvar(void)
{ {
Term t = Deref(ARG1); Term t = Deref(ARG1);
return(IsVarTerm(t) && return(IsVarTerm(t) &&
IsAttachedTerm(t) && IsAttachedTerm(t));
((attvar_record *)VarOfTerm(t))->sus_id == attvars_ext);
} }
/* check if we are not redoing effort */ /* check if we are not redoing effort */
@ -687,7 +722,6 @@ p_attvar_bound(void)
Term t = Deref(ARG1); Term t = Deref(ARG1);
return(IsVarTerm(t) && return(IsVarTerm(t) &&
IsAttachedTerm(t) && IsAttachedTerm(t) &&
((attvar_record *)VarOfTerm(t))->sus_id == attvars_ext &&
!IsUnboundVar(&((attvar_record *)VarOfTerm(t))->Done)); !IsUnboundVar(&((attvar_record *)VarOfTerm(t))->Done));
} }
@ -713,6 +747,18 @@ p_attvar_bound(void)
#endif /* COROUTINING */ #endif /* COROUTINING */
static Int
p_void_term(void)
{
return Yap_unify(ARG1,TermFoundVar);
}
static Int
p_free_term(void)
{
return Yap_unify(ARG1,TermFreeTerm);
}
void Yap_InitAttVarPreds(void) void Yap_InitAttVarPreds(void)
{ {
Term OldCurrentModule = CurrentModule; Term OldCurrentModule = CurrentModule;
@ -723,15 +769,18 @@ void Yap_InitAttVarPreds(void)
attas[attvars_ext].to_term_op = AttVarToTerm; attas[attvars_ext].to_term_op = AttVarToTerm;
attas[attvars_ext].term_to_op = TermToAttVar; attas[attvars_ext].term_to_op = TermToAttVar;
attas[attvars_ext].mark_op = mark_attvar; attas[attvars_ext].mark_op = mark_attvar;
Yap_InitCPred("get_att", 3, p_get_att, SafePredFlag); Yap_InitCPred("get_att", 4, p_get_att, SafePredFlag);
Yap_InitCPred("get_module_atts", 2, p_get_atts, SafePredFlag);
Yap_InitCPred("has_module_atts", 2, p_has_atts, SafePredFlag);
Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag); Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag);
Yap_InitCPred("free_att", 2, p_free_att, SafePredFlag); Yap_InitCPred("free_att", 3, p_free_att, SafePredFlag);
Yap_InitCPred("put_att", 3, p_put_att, 0); Yap_InitCPred("put_att", 5, p_put_att, 0);
Yap_InitCPred("update_att", 3, p_update_att, 0); Yap_InitCPred("put_module_atts", 2, p_put_atts, 0);
Yap_InitCPred("rm_att", 2, p_rm_att, SafePredFlag); Yap_InitCPred("rm_att", 4, p_rm_att, 0);
Yap_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag);
Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag); Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
Yap_InitCPred("void_term", 1, p_void_term, SafePredFlag);
Yap_InitCPred("free_term", 1, p_free_term, SafePredFlag);
Yap_InitCPred("modules_with_attributes", 2, p_modules_with_atts, SafePredFlag);
#endif /* COROUTINING */ #endif /* COROUTINING */
Yap_InitCPred("all_attvars", 1, p_all_attvars, 0); Yap_InitCPred("all_attvars", 1, p_all_attvars, 0);
CurrentModule = OldCurrentModule; CurrentModule = OldCurrentModule;

36
C/corout.c
View File

@ -22,6 +22,7 @@ static char SccsId[]="%W% %G%";
#include "Yatom.h" #include "Yatom.h"
#include "Heap.h" #include "Heap.h"
#include "heapgc.h" #include "heapgc.h"
#include "attvar.h"
#ifndef NULL #ifndef NULL
#define NULL (void *)0 #define NULL (void *)0
#endif #endif
@ -31,7 +32,7 @@ p_read_svar_list(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
return(Yap_unify(ARG1, AttsMutableList)); return Yap_unify(ARG1,Yap_ReadTimedVar(AttsMutableList));
#else #else
return(TRUE); return(TRUE);
#endif #endif
@ -45,10 +46,39 @@ p_set_svar_list(void)
{ {
#ifdef COROUTINING #ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES #ifdef MULTI_ASSIGNMENT_VARIABLES
AttsMutableList = Deref(ARG1); Term newl = Deref(ARG1);
attvar_record *max = DelayTop();
if (IsVarTerm(newl)) {
/* set to current top */
UInt diff;
Term tdiff;
RESET_VARIABLE(&max->Done);
RESET_VARIABLE(&max->Value);
max->Atts = MkIntTerm(1);
max++;
SetDelayTop(max);
diff = max-(attvar_record *)Yap_GlobalBase;
tdiff = MkIntegerTerm(diff);
Yap_UpdateTimedVar(AttsMutableList,tdiff);
return Yap_unify(ARG1,tdiff);
} else {
UInt old = IntegerOfTerm(Yap_UpdateTimedVar(AttsMutableList,newl));
attvar_record *aold = (attvar_record *)Yap_GlobalBase + (old-1);
if (max > aold+1) {
/* we are moving forward */
/* these items are protected by call-residue, should not
be visible to AllAtts
*/
MaBind(&(aold->Atts),MkIntegerTerm(max-aold));
}
}
#endif #endif
#endif #endif
return(TRUE); return TRUE;
} }
#ifdef COROUTINING #ifdef COROUTINING

2
C/exec.c
View File

@ -1605,7 +1605,7 @@ Yap_InitYaamRegs(void)
DelayedVars = Yap_NewTimedVar(MkIntTerm(0)); DelayedVars = Yap_NewTimedVar(MkIntTerm(0));
WokenGoals = Yap_NewTimedVar(TermNil); WokenGoals = Yap_NewTimedVar(TermNil);
MutableList = Yap_NewTimedVar(TermNil); MutableList = Yap_NewTimedVar(TermNil);
AttsMutableList = Yap_NewTimedVar(TermNil); AttsMutableList = Yap_NewTimedVar(MkIntTerm(0));
#endif #endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
PP = NULL; PP = NULL;

7
C/init.c
View File

@ -937,6 +937,9 @@ InitCodes(void)
Yap_heap_regs->atom_sig_pending = Yap_FullLookupAtom("$sig_pending"); Yap_heap_regs->atom_sig_pending = Yap_FullLookupAtom("$sig_pending");
#endif #endif
AtomBraces = Yap_LookupAtom("{}"); AtomBraces = Yap_LookupAtom("{}");
#ifdef COROUTINING
Yap_heap_regs->atom_att = Yap_FullLookupAtom("$att");
#endif
Yap_heap_regs->atom_b = Yap_FullLookupAtom("$last_choice_pt"); Yap_heap_regs->atom_b = Yap_FullLookupAtom("$last_choice_pt");
Yap_heap_regs->atom_break = Yap_FullLookupAtom("$break"); Yap_heap_regs->atom_break = Yap_FullLookupAtom("$break");
Yap_heap_regs->atom_call = Yap_LookupAtom("call"); Yap_heap_regs->atom_call = Yap_LookupAtom("call");
@ -1182,8 +1185,10 @@ Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
INIT_RWLOCK(HashChain[i].AERWLock); INIT_RWLOCK(HashChain[i].AERWLock);
HashChain[i].Entry = NIL; HashChain[i].Entry = NIL;
} }
Yap_LookupAtomWithAddress("FoundVar",&(SF_STORE->AtFoundVar)); Yap_LookupAtomWithAddress(".",&(SF_STORE->AtFoundVar));
Yap_ReleaseAtom(AtomFoundVar); Yap_ReleaseAtom(AtomFoundVar);
Yap_LookupAtomWithAddress("?",&(SF_STORE->AtFreeTerm));
Yap_ReleaseAtom(AtomFreeTerm);
Yap_LookupAtomWithAddress("[]",&(SF_STORE->AtNil)); Yap_LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
Yap_LookupAtomWithAddress(".",&(SF_STORE->AtDot)); Yap_LookupAtomWithAddress(".",&(SF_STORE->AtDot));
/* InitAbsmi must be done before InitCodes */ /* InitAbsmi must be done before InitCodes */

2
C/tracer.c
View File

@ -120,6 +120,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
if (vsc_count < 487000)
return;
#ifdef COMMENTED #ifdef COMMENTED
// if (vsc_count == 218280) // if (vsc_count == 218280)
// vsc_xstop = 1; // vsc_xstop = 1;

18
C/write.c
View File

@ -313,8 +313,8 @@ write_var(CELL *t, struct write_globs *wglb)
Yap_Portray_delays = FALSE; Yap_Portray_delays = FALSE;
if (ext == attvars_ext) { if (ext == attvars_ext) {
attvar_record *attv = (attvar_record *)t; attvar_record *attv = (attvar_record *)t;
int i;
long sl = 0; long sl = 0;
Term l = attv->Atts;
wrputs("$AT(",wglb->writech); wrputs("$AT(",wglb->writech);
write_var(t, wglb); write_var(t, wglb);
@ -324,26 +324,12 @@ write_var(CELL *t, struct write_globs *wglb)
sl = Yap_InitSlot((CELL)attv); sl = Yap_InitSlot((CELL)attv);
} }
writeTerm((Term)&(attv->Value), 999, 1, FALSE, wglb); writeTerm((Term)&(attv->Value), 999, 1, FALSE, wglb);
if (wglb->keep_terms) {
attv = (attvar_record *)Yap_GetFromSlot(sl);
Yap_RecoverSlots(1);
}
for (i = 0; i < NUM_OF_ATTS; i ++) {
if (!IsVarTerm(attv->Atts[2*i+1])) {
long sl = 0;
wrputc(',', wglb->writech); wrputc(',', wglb->writech);
if (wglb->keep_terms) { writeTerm(l, 999, 1, FALSE, wglb);
/* garbage collection may be called */
sl = Yap_InitSlot((CELL)attv);
}
writeTerm((Term)&(attv->Atts[2*i+1]), 999, 1, FALSE, wglb);
if (wglb->keep_terms) { if (wglb->keep_terms) {
attv = (attvar_record *)Yap_GetFromSlot(sl); attv = (attvar_record *)Yap_GetFromSlot(sl);
Yap_RecoverSlots(1); Yap_RecoverSlots(1);
} }
}
}
wrputc(')', wglb->writech); wrputc(')', wglb->writech);
} }
Yap_Portray_delays = TRUE; Yap_Portray_delays = TRUE;

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.82 2005-08-01 15:40:38 ricroc Exp $ * * version: $Id: Heap.h,v 1.83 2005-09-09 17:24:39 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -264,6 +264,7 @@ typedef struct various_codes {
atom_append, atom_append,
atom_array, atom_array,
atom_assert, atom_assert,
atom_att,
atom_b, atom_b,
atom_break, atom_break,
atom_call, atom_call,
@ -534,6 +535,7 @@ struct various_codes *Yap_heap_regs;
#define AtomAppend Yap_heap_regs->atom_append #define AtomAppend Yap_heap_regs->atom_append
#define AtomArray Yap_heap_regs->atom_array #define AtomArray Yap_heap_regs->atom_array
#define AtomAssert Yap_heap_regs->atom_assert #define AtomAssert Yap_heap_regs->atom_assert
#define AtomAtt Yap_heap_regs->atom_att
#define AtomB Yap_heap_regs->atom_b #define AtomB Yap_heap_regs->atom_b
#define AtomBreak Yap_heap_regs->atom_break #define AtomBreak Yap_heap_regs->atom_break
#define AtomCall Yap_heap_regs->atom_call #define AtomCall Yap_heap_regs->atom_call

16
H/TermExt.h
View File

@ -1,10 +1,3 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog %W% %G% * * YAP Prolog %W% %G% *
@ -17,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.1 2005-05-27 22:27:06 rslopes Exp $ * * version: $Id: TermExt.h,v 1.2 2005-09-09 17:24:39 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef USE_SYSTEM_MALLOC #ifdef USE_SYSTEM_MALLOC
@ -28,15 +21,18 @@
#if USE_OFFSETS #if USE_OFFSETS
#define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar))) #define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar)))
#define AtomFreeTerm ((Atom)(&(((special_functors *)(NULL))->AtFreeTerm)))
#define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil))) #define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil)))
#define AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot))) #define AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot)))
#else #else
#define AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar)) #define AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar))
#define AtomFreeTerm AbsAtom(&(SF_STORE->AtFreeTerm))
#define AtomNil AbsAtom(&(SF_STORE->AtNil)) #define AtomNil AbsAtom(&(SF_STORE->AtNil))
#define AtomDot AbsAtom(&(SF_STORE->AtDot)) #define AtomDot AbsAtom(&(SF_STORE->AtDot))
#endif #endif
#define TermFoundVar MkAtomTerm(AtomFoundVar) #define TermFoundVar MkAtomTerm(AtomFoundVar)
#define TermFreeTerm MkAtomTerm(AtomFreeTerm)
#define TermNil MkAtomTerm(AtomNil) #define TermNil MkAtomTerm(AtomNil)
#define TermDot MkAtomTerm(AtomDot) #define TermDot MkAtomTerm(AtomDot)
@ -125,6 +121,8 @@ typedef struct special_functors_struct
{ {
AtomEntry AtFoundVar; AtomEntry AtFoundVar;
char AtFoundVarChars[8]; char AtFoundVarChars[8];
AtomEntry AtFreeTerm;
char AtFreeTermChars[8];
AtomEntry AtNil; AtomEntry AtNil;
char AtNilChars[8]; char AtNilChars[8];
AtomEntry AtDot; AtomEntry AtDot;
@ -495,7 +493,7 @@ inline EXTERN exts ExtFromCell (CELL *);
inline EXTERN exts inline EXTERN exts
ExtFromCell (CELL * pt) ExtFromCell (CELL * pt)
{ {
return (exts) (pt[1]); return attvars_ext;
} }

20
H/attvar.h
View File

@ -36,17 +36,15 @@ Each attribute contains;
*/ */
/*
attvar_entry is just a Prolog structure such that the first argument is
a pointer to the next args
*/
typedef struct attvar_struct { typedef struct attvar_struct {
Term Done; /* if unbound suspension active, if bound terminated */ Term Done; /* if unbound suspension active, if bound terminated */
CELL sus_id;
Term NS; /* other attributed variables */
Term Value; /* value the variable will take */ Term Value; /* value the variable will take */
#ifdef __GNUC__ Term Atts; /* actual data */
/* GNUCC understands empty arrays */
Term Atts[0];
#else
Term Atts[2]; /* size of an entry */
#endif
} attvar_record; } attvar_record;
/*********** tags for suspension variables */ /*********** tags for suspension variables */
@ -56,12 +54,12 @@ typedef struct attvar_struct {
static inline attvar_record * static inline attvar_record *
DelayTop(void) { DelayTop(void) {
return (attvar_record *)((CELL *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(DelayedVars))); return (attvar_record *)((attvar_record *)Yap_GlobalBase+IntegerOfTerm(Yap_ReadTimedVar(DelayedVars)));
} }
static inline void static inline void
SetDelayTop(CELL *new_top) { SetDelayTop(attvar_record *new_top) {
Yap_UpdateTimedVar(DelayedVars, MkIntegerTerm((CELL)(new_top-(CELL *)Yap_GlobalBase))); Yap_UpdateTimedVar(DelayedVars, MkIntegerTerm((CELL)(new_top-(attvar_record *)Yap_GlobalBase)));
} }
#endif #endif

5
H/heapgc.h
View File

@ -67,7 +67,7 @@
/* is val pointing to something bound to the heap? */ /* is val pointing to something bound to the heap? */
#define GCIsPrimitiveTerm(X) (!IsVarTerm(X) && IsAtomOrIntTerm(X)) #define GCIsPrimitiveTerm(X) (/* not really needed !IsVarTerm(X) && */ IsAtomOrIntTerm(X))
/* Does X point to an object in the heap */ /* Does X point to an object in the heap */
#define HEAP_PTR(val) (!GCIsPrimitiveTerm(val) && ONHEAP(GET_NEXT(val))) #define HEAP_PTR(val) (!GCIsPrimitiveTerm(val) && ONHEAP(GET_NEXT(val)))
@ -131,8 +131,7 @@ UNRMARK(CELL* ptr)
static inline int static inline int
RMARKED(CELL* ptr) RMARKED(CELL* ptr)
{ {
CELL val = *ptr; return mcell(ptr) & RMARK_BIT;
return !GCIsPrimitiveTerm(val) && (mcell(ptr) & RMARK_BIT);
} }
#else #else

8
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2005-08-01 15:40:38 $,$Author: ricroc $ * * Last rev: $Date: 2005-09-09 17:24:39 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.53 2005/08/01 15:40:38 ricroc
* TABLING NEW: better support for incomplete tabling
*
* Revision 1.52 2005/07/06 19:34:11 ricroc * Revision 1.52 2005/07/06 19:34:11 ricroc
* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure. * TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure.
* *
@ -282,6 +285,9 @@ restore_codes(void)
Yap_heap_regs->atom_array = AtomAdjust(Yap_heap_regs->atom_array); Yap_heap_regs->atom_array = AtomAdjust(Yap_heap_regs->atom_array);
Yap_heap_regs->atom_assert = AtomAdjust(Yap_heap_regs->atom_assert); Yap_heap_regs->atom_assert = AtomAdjust(Yap_heap_regs->atom_assert);
Yap_heap_regs->atom_alarm = AtomAdjust(Yap_heap_regs->atom_alarm); Yap_heap_regs->atom_alarm = AtomAdjust(Yap_heap_regs->atom_alarm);
#ifdef COROUTINING
Yap_heap_regs->atom_att = AtomAdjust(Yap_heap_regs->atom_att);
#endif
Yap_heap_regs->atom_b = AtomAdjust(Yap_heap_regs->atom_b); Yap_heap_regs->atom_b = AtomAdjust(Yap_heap_regs->atom_b);
Yap_heap_regs->atom_break = AtomAdjust(Yap_heap_regs->atom_break); Yap_heap_regs->atom_break = AtomAdjust(Yap_heap_regs->atom_break);
Yap_heap_regs->atom_call = AtomAdjust(Yap_heap_regs->atom_call); Yap_heap_regs->atom_call = AtomAdjust(Yap_heap_regs->atom_call);

191
library/atts.yap
View File

@ -24,20 +24,10 @@
:- multifile :- multifile
user:term_expansion/2. user:term_expansion/2.
:- dynamic_predicate(existing_attribute/3,logical). :- dynamic existing_attribute/4.
:- dynamic_predicate(modules_with_attributes/1,logical). :- dynamic modules_with_attributes/1.
modules_with_attributes([]).
:- user_defined_directive(attribute(G), attributes:new_attribute(G)).
user:goal_expansion(get_atts(Var,AccessSpec), Mod, Gs) :- !,
expand_get_attributes(AccessSpec,Mod,Var,[],GL),
convert_to_goals(GL,Gs).
user:goal_expansion(put_atts(Var,AccessSpec), Mod, Gs) :- !,
expand_put_attributes(AccessSpec,Mod,Var,[],GL),
convert_to_goals(GL,Gs).
modules_with_attributes([prolog]).
% %
% defining a new attribute is just a question of establishing a % defining a new attribute is just a question of establishing a
@ -51,90 +41,135 @@ new_attribute((At1,At2)) :-
new_attribute(Na/Ar) :- new_attribute(Na/Ar) :-
source_module(Mod), source_module(Mod),
functor(S,Na,Ar), functor(S,Na,Ar),
existing_attribute(S,Mod,_) , !. existing_attribute(S,Mod,_,_) , !.
new_attribute(Na/Ar) :- new_attribute(Na/Ar) :-
source_module(Mod), source_module(Mod),
inc_n_of_atts(Key),
functor(S,Na,Ar), functor(S,Na,Ar),
store_new_module(Mod), store_new_module(Mod,Ar,Position),
assertz(existing_attribute(S,Mod,Key)). assertz(existing_attribute(S,Mod,Ar,Position)).
existing_attribute(delay(_),prolog,1,2).
store_new_module(Mod,Ar,ArgPosition) :-
(
retract(attributed_module(Mod,Position,_))
->
true
;
store_new_module(Mod), Position = 1
),
ArgPosition is Position+1,
( Ar == 0 -> NOfAtts is Position+1 ; NOfAtts is Position+Ar),
functor(AccessTerm,Mod,NOfAtts),
assertz(attributed_module(Mod,NOfAtts,AccessTerm)).
store_new_module(Mod) :-
existing_attribute(_,Mod,_), !.
store_new_module(Mod) :- store_new_module(Mod) :-
retract(modules_with_attributes(Mods)), retract(modules_with_attributes(Mods)),
assertz(modules_with_attributes([Mod|Mods])). assertz(modules_with_attributes([Mod|Mods])).
expand_get_attributes(V,Mod,Var,GL0,GL) :- var(V), !, :- user_defined_directive(attribute(G), attributes:new_attribute(G)).
GL = [attributes:get_atts_at_run_time(Var,V,Mod)|GL0].
expand_get_attributes([],_,_,LG,LG) :- !.
expand_get_attributes([Att|Atts],Mod,Var,L0,LF) :- !,
expand_get_attributes(Att,Mod,Var,L0,L1),
expand_get_attributes(Atts,Mod,Var,L1,LF).
expand_get_attributes(+Att,Mod,Var,L0,LF) :- !,
expand_get_attributes(Att,Mod,Var,L0,LF).
expand_get_attributes(-Att,Mod,Var,L0,[attributes:free_att(Var,Key)|L0]) :- !,
existing_attribute(Att,Mod,Key).
expand_get_attributes(Att,Mod,Var,L0,[attributes:get_att(Var,Key,Att)|L0]) :-
% searching for an attribute
existing_attribute(Att,Mod,Key).
get_atts_at_run_time(Var,Atts,Module) :- user:goal_expansion(get_atts(Var,AccessSpec), Mod, Goal) :-
var(Atts), !, expand_get_attributes(AccessSpec,Mod,Var,Goal).
get_all_atts(Var,LAtts), user:goal_expansion(put_atts(Var,AccessSpec), Mod, Goal) :-
fetch_interesting_attributes(LAtts, Module, Atts). expand_put_attributes(AccessSpec, Mod, Var, Goal).
get_atts_at_run_time(Var,Atts,Module) :-
expand_get_attributes(Atts,Module,Var,[],GL),
convert_to_goals(GL,Gs),
call(Gs).
fetch_interesting_attributes([], _, []).
fetch_interesting_attributes([[I|Att]|LAtts], Module, Atts) :-
fetch_interesting_attribute(Att, Module, I, Atts, AttsI),
fetch_interesting_attributes(LAtts, Module, AttsI).
% expand_get_attributes(V,_,_,_) :- var(V), !, fail.
% only output attributes if they are for the current module. expand_get_attributes([],_,_,true) :- !.
% expand_get_attributes([-G1],Mod,V,attributes:free_att(V,Mod,Pos)) :-
fetch_interesting_attribute(Att, Module, Key, [Att|Atts], Atts) :- existing_attribute(G1,Mod,_,Pos), !.
existing_attribute(Att, Module, Key), !. expand_get_attributes([+G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
fetch_interesting_attribute(_, _, _, Atts, Atts). existing_attribute(G1,Mod,1,Pos), !,
arg(1,G1,A).
expand_get_attributes([G1],Mod,V,attributes:get_att(V,Mod,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
arg(1,G1,A).
expand_get_attributes(Atts,Mod,Var,attributes:get_module_atts(Var,AccessTerm)) :- Atts = [_|_], !,
attributed_module(Mod,NOfAtts,AccessTerm),
cvt_atts(Atts,Mod,LAtts),
sort(LAtts,SortedLAtts),
free_term(Void),
build_att_term(1,NOfAtts,SortedLAtts,Void,AccessTerm).
expand_get_attributes(Att,Mod,Var,Goal) :-
expand_get_attributes([Att],Mod,Var,Goal).
expand_put_attributes(V,Mod,Var,G0,GF) :- var(V), !, build_att_term(NOfAtts,NOfAtts,[],_,_) :- !.
GF = [attributes:put_atts_at_run_time(Var,V,Mod)|G0]. build_att_term(I0,NOfAtts,[I-Info|SortedLAtts],Void,AccessTerm) :-
expand_put_attributes([],_,_,G,G) :- !. I is I0+1, !,
expand_put_attributes([Att|Atts],Mod,Var,G0,GF) :- !, copy_att_args(Info,I0,NI,AccessTerm),
expand_put_attributes(Att,Mod,Var,G0,GI), build_att_term(NI,NOfAtts,SortedLAtts,Void,AccessTerm).
expand_put_attributes(Atts,Mod,Var,GI,GF). build_att_term(I0,NOfAtts,SortedLAtts,Void,AccessTerm) :-
expand_put_attributes(+Att,Mod,Var,G0,GF) :- !, I is I0+1,
expand_put_attributes(Att,Mod,Var,G0,GF). arg(I,AccessTerm,Void),
expand_put_attributes(-Att,Mod,Var,G0,[attributes:rm_att(Var,Key)|G0]) :- !, build_att_term(I,NOfAtts,SortedLAtts,Void,AccessTerm).
existing_attribute(Att,Mod,Key).
expand_put_attributes(Att,Mod,Var,G0,[attributes:put_att(Var,Key,Att)|G0]) :-
% searching for an attribute
existing_attribute(Att,Mod,Key).
put_atts_at_run_time(Var,Atts,_) :- cvt_atts(V,_,_) :- var(V), !, fail.
var(Atts), !, cvt_atts([],_,[]).
throw(error(instantiation_error,put_atts(Var,Atts))). cvt_atts([V|_],_,_) :- var(V), !, fail.
put_atts_at_run_time(Var,Atts,Module) :- cvt_atts([+Att|Atts],Mod,[Pos-LAtts|Read]) :- !,
expand_put_attributes(Atts,Module,Var,[],GL), existing_attribute(Att,Mod,_,Pos),
convert_to_goals(GL,Gs), (atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
call(Gs). cvt_atts(Atts,Mod,Read).
cvt_atts([-Att|Atts],Mod,[Pos-LVoids|Read]) :- !,
existing_attribute(Att,Mod,_,Pos),
void_term(Void),
(
atom(Att)
->
LVoids = [Void]
;
Att =..[_|LAtts],
void_vars(LAtts,Void,LVoids)
),
cvt_atts(Atts,Mod,Read).
cvt_atts([Att|Atts],Mod,[Pos-LAtts|Read]) :- !,
existing_attribute(Att,Mod,_,Pos),
(atom(Att) -> LAtts = [_] ; Att=..[_|LAtts]),
cvt_atts(Atts,Mod,Read).
copy_att_args([],I,I,_).
copy_att_args([V|Info],I,NI,AccessTerm) :-
I1 is I+1,
arg(I1,AccessTerm,V),
copy_att_args(Info,I1,NI,AccessTerm).
void_vars([],_,[]).
void_vars([_|LAtts],Void,[Void|LVoids]) :-
void_vars(LAtts,Void,LVoids).
expand_put_attributes(V,_,_,_) :- var(V), !, fail.
expand_put_attributes([-G1],Mod,V,attributes:rm_att(V,Mod,NOfAtts,Pos)) :-
existing_attribute(G1,Mod,_,Pos), !,
attributed_module(Mod,NOfAtts,_).
expand_put_attributes([+G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
attributed_module(Mod,NOfAtts,_),
arg(1,G1,A).
expand_put_attributes([G1],Mod,V,attributes:put_att(V,Mod,NOfAtts,Pos,A)) :-
existing_attribute(G1,Mod,1,Pos), !,
attributed_module(Mod,NOfAtts,_),
arg(1,G1,A).
expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) :- Atts = [_|_], !,
attributed_module(Mod,NOfAtts,AccessTerm),
cvt_atts(Atts,Mod,LAtts),
sort(LAtts,SortedLAtts),
void_term(Void),
build_att_term(1,NOfAtts,SortedLAtts,Void,AccessTerm).
expand_put_attributes(Att,Mod,Var,Goal) :-
expand_put_attributes([Att],Mod,Var,Goal).
woken_att_do(AttVar, Binding) :- woken_att_do(AttVar, Binding) :-
modules_with_attributes(Mods), modules_with_attributes(AttVar,Mods),
do_verify_attributes(Mods, AttVar, Binding, Goals), do_verify_attributes(Mods, AttVar, Binding, Goals),
bind_attvar(AttVar), bind_attvar(AttVar),
lcall(Goals). lcall(Goals).
do_verify_attributes([], _, _, []). do_verify_attributes([], _, _, []).
do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :- do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
existing_attribute(_,Mod,Key), current_predicate(verify_attributes,Mod:verify_attributes(_,_,_)), !,
get_att(AttVar,Key,_), Mod:verify_attributes(AttVar, Binding, Goal),
current_predicate(verify_attributes, Mod:verify_attributes(_,_,_)), !, do_verify_attributes(Mods, AttVar, Binding, Goals).
do_verify_attributes(Mods, AttVar, Binding, Goals),
Mod:verify_attributes(AttVar, Binding, Goal).
do_verify_attributes([_|Mods], AttVar, Binding, Goals) :- do_verify_attributes([_|Mods], AttVar, Binding, Goals) :-
do_verify_attributes(Mods, AttVar, Binding, Goals). do_verify_attributes(Mods, AttVar, Binding, Goals).
@ -149,7 +184,7 @@ lcall2([Goal|Goals], Mod) :-
lcall2(Goals, Mod). lcall2(Goals, Mod).
convert_att_var(V, Gs) :- convert_att_var(V, Gs) :-
modules_with_attributes(LMods), modules_with_attributes(V,LMods),
fetch_att_goals(LMods,V,Gs0), !, fetch_att_goals(LMods,V,Gs0), !,
simplify_trues(Gs0, Gs). simplify_trues(Gs0, Gs).
convert_att_var(_, true). convert_att_var(_, true).
@ -167,8 +202,6 @@ fetch_att_goals([_|LMods], Att, LGoal) :-
% if there is an active attribute for this module call attribute_goal. % if there is an active attribute for this module call attribute_goal.
% %
call_module_attributes(Mod, AttV, G1) :- call_module_attributes(Mod, AttV, G1) :-
existing_attribute(_,Mod,Key),
get_att(AttV,Key,_), !,
current_predicate(attribute_goal, Mod:attribute_goal(AttV,G1)), current_predicate(attribute_goal, Mod:attribute_goal(AttV,G1)),
Mod:attribute_goal(AttV, G1). Mod:attribute_goal(AttV, G1).

13
pl/corout.yap
View File

@ -558,8 +558,7 @@ call_residue(Goal,Residue) :-
'$call_residue'(Goal,Module,Residue) :- '$call_residue'(Goal,Module,Residue) :-
'$read_svar_list'(OldAttsList), '$read_svar_list'(OldAttsList),
'$copy_term_but_not_constraints'(Goal, NGoal), '$copy_term_but_not_constraints'(Goal, NGoal),
( create_mutable([], CurrentAttsList), ( '$set_svar_list'(CurrentAttsList),
'$set_svar_list'(CurrentAttsList),
'$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)),
'$call_residue_continuation'(NGoal,NResidue), '$call_residue_continuation'(NGoal,NResidue),
@ -729,7 +728,13 @@ call_residue(Goal,Residue) :-
%'$freeze'(V,G) :- %'$freeze'(V,G) :-
% attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail. % attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail.
'$freeze'(V,G) :- '$freeze'(V,G) :-
attributes:update_att(V, 0, G). '$update_att'(V, G).
'$update_att'(V, G) :-
attributes:get_module_atts(V, prolog(_,Gs)), !,
attributes:put_module_atts(V, prolog(_,[G|Gs])).
'$update_att'(V, G) :-
attributes:put_module_atts(V, prolog(_,[G])).
'$goal_in'(G,[G1|_]) :- G == G1, !. '$goal_in'(G,[G1|_]) :- G == G1, !.
'$goal_in'(G,[_|Gs]) :- '$goal_in'(G,[_|Gs]) :-
@ -737,6 +742,6 @@ call_residue(Goal,Residue) :-
'$frozen_goals'(V,Gs) :- '$frozen_goals'(V,Gs) :-
var(V), var(V),
attributes:get_att(V, 0, Gs), nonvar(Gs). attributes:get_att(V, prolog, 2, Gs), nonvar(Gs).