store constraints in DB
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@233 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
c79f7e0f35
commit
7b77c87b94
@ -1790,8 +1790,8 @@ absmi(int inp)
|
||||
/* find something to fool S */
|
||||
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
||||
SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,2),0));
|
||||
PREG = NEXTOP(PREG,x);
|
||||
XREGS[0] = XREG(PREG->u.y.y);
|
||||
PREG = NEXTOP(PREG,y);
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
@ -1802,7 +1802,6 @@ absmi(int inp)
|
||||
/* find something to fool S */
|
||||
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
||||
SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,2),0));
|
||||
PREG = NEXTOP(PREG,x);
|
||||
#if USE_THREADED_CODE
|
||||
if (PREG->opc == (OPCODE)OpAddress[_fcall])
|
||||
#else
|
||||
@ -1819,6 +1818,7 @@ absmi(int inp)
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
}
|
||||
XREGS[0] = XREG(PREG->u.x.x);
|
||||
PREG = NEXTOP(PREG,x);
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
|
||||
11
C/arith0.c
11
C/arith0.c
@ -143,6 +143,16 @@ p_b(E_ARGS)
|
||||
#endif
|
||||
}
|
||||
|
||||
static E_FUNC
|
||||
p_env(E_ARGS)
|
||||
{
|
||||
#if SBA
|
||||
RINT((Int)YENV);
|
||||
#else
|
||||
RINT(YENV - (CELL *)B);
|
||||
#endif
|
||||
}
|
||||
|
||||
static E_FUNC
|
||||
p_globalsp(E_ARGS)
|
||||
{
|
||||
@ -178,6 +188,7 @@ static InitConstEntry InitConstTab[] = {
|
||||
{"local_sp", p_localsp},
|
||||
{"global_sp", p_globalsp},
|
||||
{"$last_choice_pt", p_b},
|
||||
{"$env", p_env},
|
||||
{"stackfree", p_stackfree},
|
||||
};
|
||||
|
||||
|
||||
45
C/attvar.c
45
C/attvar.c
@ -31,6 +31,8 @@ static char SccsId[]="%W% %G%";
|
||||
#endif
|
||||
|
||||
STATIC_PROTO(Term InitVarTime, (void));
|
||||
STATIC_PROTO(Int PutAtt, (attvar_record *,Int,Term));
|
||||
STATIC_PROTO(Int BuildNewAttVar, (Term,Int,Term));
|
||||
|
||||
static CELL *
|
||||
AddToQueue(attvar_record *attv)
|
||||
@ -137,6 +139,47 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Term
|
||||
AttVarToTerm(CELL *orig)
|
||||
{
|
||||
register attvar_record *attv = (attvar_record *)orig;
|
||||
Term list = TermNil;
|
||||
int j;
|
||||
for (j = 0; j < NUM_OF_ATTS; j++) {
|
||||
Term t = attv->Atts[2*(NUM_OF_ATTS-j-1)+1];
|
||||
if (IsVarTerm(t))
|
||||
list = MkPairTerm(MkVarTerm(),list);
|
||||
else
|
||||
list = MkPairTerm(t,list);
|
||||
}
|
||||
return(list);
|
||||
}
|
||||
|
||||
static int
|
||||
TermToAttVar(Term attvar, Term to)
|
||||
{
|
||||
int i = 0;
|
||||
int open = FALSE;
|
||||
|
||||
while (IsPairTerm(attvar)) {
|
||||
Term t = HeadOfTerm(attvar);
|
||||
if (!IsVarTerm(t)) {
|
||||
if (open) {
|
||||
attvar_record *attv = (attvar_record *)VarOfTerm(Deref(to));
|
||||
if (!PutAtt(attv, i, t))
|
||||
return(FALSE);
|
||||
} else {
|
||||
if (!BuildNewAttVar(to, i, t))
|
||||
return(FALSE);
|
||||
open = TRUE;
|
||||
}
|
||||
}
|
||||
i++;
|
||||
attvar = TailOfTerm(attvar);
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static void
|
||||
WakeAttVar(CELL* pt1, CELL reg2)
|
||||
{
|
||||
@ -578,6 +621,8 @@ void InitAttVarPreds(void)
|
||||
{
|
||||
attas[attvars_ext].bind_op = WakeAttVar;
|
||||
attas[attvars_ext].copy_term_op = CopyAttVar;
|
||||
attas[attvars_ext].to_term_op = AttVarToTerm;
|
||||
attas[attvars_ext].term_to_op = TermToAttVar;
|
||||
#ifndef FIXED_STACKS
|
||||
attas[attvars_ext].mark_op = mark_attvar;
|
||||
#endif
|
||||
|
||||
53
C/corout.c
53
C/corout.c
@ -342,6 +342,57 @@ CopySuspendedVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Term
|
||||
mk_sus_var_list(sus_record *sr, sus_record *osr)
|
||||
{
|
||||
if (sr == osr)
|
||||
return(TermNil);
|
||||
return(MkPairTerm(sr->SG, mk_sus_var_list(sr->NR, sr)));
|
||||
}
|
||||
|
||||
static Term
|
||||
SuspendedVarToTerm(CELL *orig)
|
||||
{
|
||||
register sus_tag *sreg = (sus_tag *)orig;
|
||||
|
||||
return(MkPairTerm(sreg->SG->SG, mk_sus_var_list(sreg->SG->NR, sreg->SG)));
|
||||
}
|
||||
|
||||
static sus_record *
|
||||
terms_to_suspended_goals(Term gl)
|
||||
{
|
||||
sus_record *gf;
|
||||
gf = (sus_record *)H;
|
||||
H += sizeof(sus_record)/sizeof(CELL);
|
||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||
gf->NS = UpdateSVarList(gf);
|
||||
#endif
|
||||
gf->SG = HeadOfTerm(gl);
|
||||
gl = TailOfTerm(gl);
|
||||
if (gl == TermNil) {
|
||||
gf->NR = (sus_record *)&(gf->NR);
|
||||
} else {
|
||||
gf->NR = terms_to_suspended_goals(gl);
|
||||
}
|
||||
return(gf);
|
||||
}
|
||||
|
||||
static int
|
||||
TermToSuspendedVar(Term gs, Term var)
|
||||
{
|
||||
register sus_tag *vs;
|
||||
/* add a new suspension */
|
||||
vs = (sus_tag *)ReadTimedVar(DelayedVars);
|
||||
if (H0 - (CELL *)vs < 1024)
|
||||
return(FALSE);
|
||||
RESET_VARIABLE(&(vs->ActiveSus));
|
||||
vs->sus_id = susp_ext;
|
||||
vs->SG = terms_to_suspended_goals(gs);
|
||||
unify(var,(CELL)&(vs->ActiveSus));
|
||||
UpdateTimedVar(DelayedVars, (CELL)(vs+1));
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
|
||||
#ifndef FIXED_STACKS
|
||||
|
||||
@ -1155,6 +1206,8 @@ void InitCoroutPreds(void)
|
||||
|
||||
attas[susp_ext].bind_op = Wake;
|
||||
attas[susp_ext].copy_term_op = CopySuspendedVar;
|
||||
attas[susp_ext].to_term_op = SuspendedVarToTerm;
|
||||
attas[susp_ext].term_to_op = TermToSuspendedVar;
|
||||
#ifndef FIXED_STACKS
|
||||
attas[susp_ext].mark_op = mark_suspended_goal;
|
||||
#endif /* FIXED_STACKS */
|
||||
|
||||
124
C/dbase.c
124
C/dbase.c
@ -57,7 +57,6 @@ static char SccsId[] = "%W% %G%";
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#ifdef KEEP_ENTRY_AGE
|
||||
#define DISCONNECT_OLD_ENTRIES 1
|
||||
#else
|
||||
@ -199,7 +198,11 @@ STATIC_PROTO(CELL *linkcells,(CELL *,Int));
|
||||
STATIC_PROTO(Int cmpclls,(CELL *,CELL *,Int));
|
||||
STATIC_PROTO(Prop FindDBProp,(AtomEntry *, int, unsigned int, SMALLUNSGN));
|
||||
STATIC_PROTO(CELL CalcKey, (Term));
|
||||
#ifdef COROUTINING
|
||||
STATIC_PROTO(CELL *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, CELL *,int *));
|
||||
#else
|
||||
STATIC_PROTO(CELL *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, int *));
|
||||
#endif
|
||||
STATIC_PROTO(DBRef CreateDBStruct, (Term, DBProp, int));
|
||||
STATIC_PROTO(DBRef new_lu_index, (LogUpdDBProp));
|
||||
STATIC_PROTO(void clean_lu_index, (DBRef));
|
||||
@ -450,7 +453,10 @@ CELL
|
||||
EvalMasks(register Term tm, CELL *keyp)
|
||||
{
|
||||
|
||||
if (IsApplTerm(tm)) {
|
||||
if (IsVarTerm(tm)) {
|
||||
*keyp = 0L;
|
||||
return(0L);
|
||||
} else if (IsApplTerm(tm)) {
|
||||
Functor fun = FunctorOfTerm(tm);
|
||||
|
||||
if (IsExtensionFunctor(fun)) {
|
||||
@ -583,6 +589,9 @@ typedef struct {
|
||||
static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
register CELL *StoPoint,
|
||||
CELL *CodeMax, CELL *tbase,
|
||||
#ifdef COROUTINING
|
||||
CELL *attachmentsp,
|
||||
#endif
|
||||
int *vars_foundp)
|
||||
{
|
||||
|
||||
@ -592,6 +601,10 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
CELL **to_visit_base = to_visit;
|
||||
/* where we are going to add a new pair */
|
||||
int vars_found = 0;
|
||||
#ifdef COROUTINING
|
||||
Term ConstraintsTerm = TermNil;
|
||||
CELL *ConstraintsBottom = NULL;
|
||||
#endif
|
||||
|
||||
loop:
|
||||
while (pt0 <= pt0_end) {
|
||||
@ -794,13 +807,14 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
|
||||
/* the code to dereference a variable */
|
||||
deref_var:
|
||||
if (!MARKED(d0))
|
||||
{
|
||||
if (!MARKED(d0)) {
|
||||
if (
|
||||
#if SBA
|
||||
if (d0 != 0) {
|
||||
d0 != 0
|
||||
#else
|
||||
if (d0 != (CELL)ptd0) {
|
||||
d0 != (CELL)ptd0
|
||||
#endif
|
||||
) {
|
||||
ptd0 = (Term *) d0;
|
||||
d0 = *ptd0;
|
||||
goto restart; /* continue dereferencing */
|
||||
@ -822,7 +836,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
/* variables need to be offset at read time */
|
||||
*ptd0 = (displacement | MBIT);
|
||||
#if SBA
|
||||
/* the copy we keep will be an empty vaiable */
|
||||
/* the copy we keep will be an empty variable */
|
||||
*StoPoint++ = 0;
|
||||
#else
|
||||
#ifdef IDB_USE_MBIT
|
||||
@ -839,6 +853,30 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#endif
|
||||
/* indicate we found variables */
|
||||
vars_found++;
|
||||
#ifdef COROUTINING
|
||||
if (IsAttachedTerm((CELL)ptd0)) {
|
||||
Term t[4];
|
||||
int sz = to_visit-to_visit_base;
|
||||
|
||||
H = (CELL *)to_visit;
|
||||
/* store the constraint away for now */
|
||||
t[0] = (CELL)ptd0;
|
||||
t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
|
||||
t[2] = MkIntegerTerm(ExtFromCell(ptd0));
|
||||
t[3] = TermNil;
|
||||
if (ConstraintsBottom == NULL) {
|
||||
ConstraintsTerm = MkApplTerm(FunctorClist, 4, t);
|
||||
ConstraintsBottom = RepAppl(ConstraintsTerm)+4;
|
||||
} else {
|
||||
Term new = MkApplTerm(FunctorClist, 4, t);
|
||||
*ConstraintsBottom = new;
|
||||
ConstraintsBottom = RepAppl(new)+4;
|
||||
}
|
||||
memcpy((void *)(H), (void *)(to_visit_base), sz*sizeof(CELL *));
|
||||
to_visit_base = (CELL **)H;
|
||||
to_visit = to_visit_base+sz;
|
||||
}
|
||||
#endif
|
||||
continue;
|
||||
} else {
|
||||
/* references need to be offset at read time */
|
||||
@ -861,7 +899,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
}
|
||||
|
||||
/* Do we still have compound terms to visit */
|
||||
if (to_visit > (CELL **)to_visit_base) {
|
||||
if (to_visit > to_visit_base) {
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit -= 4;
|
||||
pt0 = to_visit[0];
|
||||
@ -877,6 +915,18 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
goto loop;
|
||||
}
|
||||
|
||||
#ifdef COROUTINING
|
||||
/* we still may have constraints to do */
|
||||
if (ConstraintsTerm != TermNil) {
|
||||
*attachmentsp = (CELL)(CodeMax)-(CELL)(tbase);
|
||||
pt0 = RepAppl(ConstraintsTerm)+1;
|
||||
pt0_end = RepAppl(ConstraintsTerm)+4;
|
||||
ConstraintsTerm = TermNil;
|
||||
StoPoint = CodeMax;
|
||||
CodeMax += 4;
|
||||
goto loop;
|
||||
}
|
||||
#endif
|
||||
/* we're done */
|
||||
*vars_foundp = vars_found;
|
||||
UNWIND_CUNIF();
|
||||
@ -886,7 +936,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
DBErrorFlag = OVF_ERROR_IN_DB;
|
||||
*vars_foundp = vars_found;
|
||||
#ifdef RATIONAL_TREES
|
||||
while (to_visit > (CELL **)to_visit_base) {
|
||||
while (to_visit > to_visit_base) {
|
||||
to_visit -= 4;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
@ -901,7 +951,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
DBErrorFlag = SOVF_ERROR_IN_DB;
|
||||
*vars_foundp = vars_found;
|
||||
#ifdef RATIONAL_TREES
|
||||
while (to_visit > (CELL **)to_visit_base) {
|
||||
while (to_visit > to_visit_base) {
|
||||
to_visit -= 4;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
@ -917,7 +967,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
DBErrorFlag = TOVF_ERROR_IN_DB; \
|
||||
*vars_foundp = vars_found;
|
||||
#ifdef RATIONAL_TREES
|
||||
while (to_visit > (CELL **)to_visit_base) {
|
||||
while (to_visit > to_visit_base) {
|
||||
to_visit -= 4;
|
||||
pt0 = to_visit[0];
|
||||
pt0_end = to_visit[1];
|
||||
@ -1123,10 +1173,17 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
|
||||
DBRef *TmpRefBase = (DBRef *)ConsultSp;
|
||||
CELL *CodeAbs; /* how much code did we find */
|
||||
int vars_found;
|
||||
#ifdef COROUTINING
|
||||
CELL attachments = 0;
|
||||
#endif
|
||||
|
||||
DBErrorFlag = NO_ERROR_IN_DB;
|
||||
|
||||
if (IsVarTerm(Tm)) {
|
||||
if (IsVarTerm(Tm)
|
||||
#ifdef COROUTINING
|
||||
&& !IsAttachedTerm(Tm)
|
||||
#endif
|
||||
) {
|
||||
Register DBRef pp;
|
||||
|
||||
tt = Tm;
|
||||
@ -1185,11 +1242,26 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
|
||||
ntp0 = pp0->Contents;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
lr = LinkAr = (link_entry *)TR;
|
||||
#endif
|
||||
#ifdef COROUTINING
|
||||
/* attachment */
|
||||
if (IsVarTerm(Tm)) {
|
||||
tt = sizeof(CELL);
|
||||
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
|
||||
&attachments,
|
||||
&vars_found);
|
||||
if (ntp == NULL)
|
||||
return(NULL);
|
||||
} else
|
||||
#endif
|
||||
if (IsPairTerm(Tm)) {
|
||||
/* avoid null pointers!! */
|
||||
tt = AbsPair((CELL *)sizeof(CELL));
|
||||
ntp = MkDBTerm(RepPair(Tm), RepPair(Tm)+1, ntp0, ntp0+2, ntp0-1, &vars_found);
|
||||
ntp = MkDBTerm(RepPair(Tm), RepPair(Tm)+1, ntp0, ntp0+2, ntp0-1,
|
||||
#ifdef COROUTINING
|
||||
&attachments,
|
||||
#endif
|
||||
&vars_found);
|
||||
if (ntp == NULL) {
|
||||
return(NULL);
|
||||
}
|
||||
@ -1274,7 +1346,11 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
|
||||
arity = ArityOfFunctor(fun);
|
||||
ntp = MkDBTerm(RepAppl(Tm)+1,
|
||||
RepAppl(Tm)+arity,
|
||||
ntp0+1, ntp0+1+arity, ntp0-1, &vars_found);
|
||||
ntp0+1, ntp0+1+arity, ntp0-1,
|
||||
#ifdef COROUTINING
|
||||
&attachments,
|
||||
#endif
|
||||
&vars_found);
|
||||
if (ntp == NULL)
|
||||
return(NULL);
|
||||
}
|
||||
@ -1359,6 +1435,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
|
||||
#endif /* IDB_LINK_TABLE */
|
||||
|
||||
pp->NOfCells = NOfCells;
|
||||
#ifdef COROUTINING
|
||||
pp->attachments = attachments;
|
||||
#endif
|
||||
if (pp0 != pp) {
|
||||
nar = pp->Contents;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
@ -1918,6 +1997,18 @@ p_rcdzifnot(void)
|
||||
goto restart_record;
|
||||
}
|
||||
|
||||
#ifdef COROUTINING
|
||||
static void
|
||||
copy_attachments(CELL *ts)
|
||||
{
|
||||
while (TRUE) {
|
||||
attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0]);
|
||||
if (ts[3] == TermNil) return;
|
||||
ts = RepAppl(ts[3])+1;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
static Term
|
||||
GetDBTerm(DBRef DBSP)
|
||||
{
|
||||
@ -1942,6 +2033,11 @@ GetDBTerm(DBRef DBSP)
|
||||
link_entry *lp = (link_entry *)pt;
|
||||
linkblk(lp, HOld-1);
|
||||
}
|
||||
#endif
|
||||
#ifdef COROUTINING
|
||||
if (DBSP->attachments != 0L) {
|
||||
copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)(HOld-1)));
|
||||
}
|
||||
#endif
|
||||
return (AdjustIDBPtr((Term)(DBSP->Entry),Unsigned(HOld)-sizeof(CELL)));
|
||||
}
|
||||
|
||||
1
C/init.c
1
C/init.c
@ -955,6 +955,7 @@ InitCodes(void)
|
||||
heap_regs->functor_braces = MkFunctor(AtomBraces, 1);
|
||||
heap_regs->functor_call = MkFunctor(AtomCall, 1);
|
||||
heap_regs->functor_cut_by = MkFunctor(AtomCutBy, 1);
|
||||
heap_regs->functor_clist = MkFunctor(LookupAtom("$when"), 4);
|
||||
heap_regs->functor_comma = MkFunctor(AtomComma, 2);
|
||||
heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
|
||||
heap_regs->functor_eq = MkFunctor(AtomEq, 2);
|
||||
|
||||
23
C/save.c
23
C/save.c
@ -493,10 +493,14 @@ save_stacks(int mode)
|
||||
tr_fr_ptr tr_ptr = TR;
|
||||
while (tr_ptr != (tr_fr_ptr)TrailBase) {
|
||||
CELL val = TrailTerm(tr_ptr-1);
|
||||
if (!IsVarTerm(val) && IsPairTerm(val)) {
|
||||
if (IsVarTerm(val)) {
|
||||
CELL *d1 = VarOfTerm(val);
|
||||
if (d1 < (CELL *)HeapTop)
|
||||
putout(val);
|
||||
} else if (IsPairTerm(val)) {
|
||||
CELL *d1 = RepPair(val);
|
||||
if (d1 < (CELL *)HeapTop)
|
||||
putcellptr(d1);
|
||||
putout(val);
|
||||
}
|
||||
tr_ptr--;
|
||||
}
|
||||
@ -2898,17 +2902,22 @@ UnmarkTrEntries(void)
|
||||
B--;
|
||||
B->cp_ap = (yamop *)NOCODE;
|
||||
Entries = (CELL *)TrailBase;
|
||||
while ((CODEADDR)(entry = *Entries++) != NULL) {
|
||||
while ((entry = *Entries++) != (CELL)NULL) {
|
||||
if (IsVarTerm(entry)) {
|
||||
RESET_VARIABLE((CELL *)entry);
|
||||
} else if (IsPairTerm(entry)) {
|
||||
CODEADDR ent = (CODEADDR)RepPair(entry);
|
||||
register CELL flags;
|
||||
|
||||
flags = Flags(entry);
|
||||
flags = Flags(ent);
|
||||
ResetFlag(InUseMask, flags);
|
||||
Flags(entry) = flags;
|
||||
Flags(ent) = flags;
|
||||
if (FlagOn(ErasedMask, flags)) {
|
||||
if (FlagOn(DBClMask, flags)) {
|
||||
ErDBE((DBRef) (entry - (CELL) &(((DBRef) NIL)->Flags)));
|
||||
ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags)));
|
||||
} else {
|
||||
ErCl(ClauseFlagsToClause(entry));
|
||||
ErCl(ClauseFlagsToClause(ent));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@ -114,7 +114,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
extern int gc_calls;
|
||||
|
||||
vsc_count++;
|
||||
/* if (vsc_count < 13198050) return; */
|
||||
/* if (vsc_count < 1025) return; */
|
||||
/* if (vsc_count > 500000) exit(0); */
|
||||
/* if (gc_calls < 1) return;*/
|
||||
YP_fprintf(YP_stderr,"%lu (%x) ", vsc_count, CreepFlag);
|
||||
|
||||
4
H/Heap.h
4
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.14 2001-11-26 12:33:05 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.15 2001-12-17 18:31:10 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -223,6 +223,7 @@ typedef struct various_codes {
|
||||
#endif
|
||||
functor_braces,
|
||||
functor_call,
|
||||
functor_clist,
|
||||
functor_comma,
|
||||
functor_csult,
|
||||
functor_cut_by,
|
||||
@ -411,6 +412,7 @@ typedef struct various_codes {
|
||||
#endif
|
||||
#define FunctorBraces heap_regs->functor_braces
|
||||
#define FunctorCall heap_regs->functor_call
|
||||
#define FunctorClist heap_regs->functor_clist
|
||||
#define FunctorComma heap_regs->functor_comma
|
||||
#define FunctorCsult heap_regs->functor_csult
|
||||
#define FunctorCutBy heap_regs->functor_cut_by
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: TermExt.h *
|
||||
* mods: *
|
||||
* comments: Extensions to standard terms for YAP *
|
||||
* version: $Id: TermExt.h.m4,v 1.4 2001-12-11 03:34:03 vsc Exp $ *
|
||||
* version: $Id: TermExt.h.m4,v 1.5 2001-12-17 18:31:11 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#if USE_OFFSETS
|
||||
@ -71,6 +71,9 @@ typedef struct {
|
||||
void (*bind_op)(Term *, Term);
|
||||
/* what to do if someone wants to copy our constraint */
|
||||
int (*copy_term_op)(CELL *, CELL ***, CELL *);
|
||||
/* copy the constraint into a term and back */
|
||||
Term (*to_term_op)(CELL *);
|
||||
int (*term_to_op)(Term, Term);
|
||||
/* op called to do marking in GC */
|
||||
void (*mark_op)(CELL *);
|
||||
} ext_op;
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h.m4,v 1.12 2001-09-24 18:07:16 vsc Exp $ *
|
||||
* version: $Id: Yap.h.m4,v 1.13 2001-12-17 18:31:11 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
@ -567,7 +567,7 @@ and RefOfTerm(t) : Term -> DBRef = ...
|
||||
incompatible with the high tag scheme. Linux-ELF also does not like
|
||||
if you place things in the lower addresses (power to the libc people).
|
||||
*/
|
||||
#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
|
||||
#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
|
||||
#define USE_LOW32_TAGS 1
|
||||
#endif
|
||||
|
||||
|
||||
@ -287,6 +287,9 @@ typedef struct DB_STRUCT {
|
||||
Int age; /* entry's age, negative if from recorda,
|
||||
positive if it was recordz */
|
||||
#endif /* KEEP_ENTRY_AGE */
|
||||
#ifdef COROUTINING
|
||||
CELL attachments; /* attached terms */
|
||||
#endif
|
||||
CELL Mask; /* parts that should be cleared */
|
||||
CELL Key; /* A mask that can be used to check before
|
||||
you unify */
|
||||
|
||||
66
pl/boot.yap
66
pl/boot.yap
@ -43,6 +43,7 @@ true :- true. % otherwise, $$compile will ignore this clause.
|
||||
'$set_yap_flags'(10,0),
|
||||
'$set_value'('$gc',on),
|
||||
'$init_catch',
|
||||
% '$init_newcatch', commented out for now
|
||||
prompt(' ?- '),
|
||||
(
|
||||
'$get_value'('$break',0)
|
||||
@ -68,17 +69,6 @@ true :- true. % otherwise, $$compile will ignore this clause.
|
||||
true
|
||||
).
|
||||
|
||||
'$init_catch' :-
|
||||
% initialise access to the catch queue
|
||||
( '$has_static_array'('$catch_queue') ->
|
||||
true
|
||||
;
|
||||
static_array('$catch_queue',2, term)
|
||||
),
|
||||
update_array('$catch_queue', 0, '$'),
|
||||
update_array('$catch_queue', 1, '$').
|
||||
|
||||
|
||||
%
|
||||
% encapsulate $cut_by because of co-routining.
|
||||
%
|
||||
@ -1125,9 +1115,51 @@ expand_term(Term,Expanded) :-
|
||||
'$expand_term_modules'(A,A,A,_).
|
||||
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
% catch/throw implementation
|
||||
|
||||
/* new design, not working for now:
|
||||
|
||||
% at each catch point I need to know:
|
||||
% what is ball;
|
||||
% where was the previous catch
|
||||
newcatch(G, C, A) :-
|
||||
array_element('$catch', 0, OldEnv),
|
||||
Env is '$env',
|
||||
update_array('$catch', 0, Env),
|
||||
'$execute'(G),
|
||||
update_array('$catch', 0, Env),
|
||||
array_element('$catch', 1, V),
|
||||
(var(V) ->
|
||||
true
|
||||
;
|
||||
!, '$handle_throw'(C, A)
|
||||
).
|
||||
|
||||
'$handle_throw'(C, A) :-
|
||||
% reset info
|
||||
array_element('$catch', 1, _),
|
||||
array_element('$catch', 2, Ball),
|
||||
(C = Ball ->
|
||||
'$execute'(A)
|
||||
;
|
||||
throw(Ball)
|
||||
).
|
||||
|
||||
newthrow(Ball) :-
|
||||
% say we are throwing something.
|
||||
array_element('$catch', 1, []),
|
||||
update_array('$catch', 2, Ball),
|
||||
array_element('$catch', 0, Env),
|
||||
'$jump_env'(Env).
|
||||
|
||||
'$init_newcatch' :-
|
||||
'$create_array'('$catch', 3).
|
||||
|
||||
|
||||
*/
|
||||
|
||||
catch(G,C,A) :- var(G), !,
|
||||
throw(error(instantiation_error,catch(G,C,A))).
|
||||
catch(G,C,A) :- number(G), !,
|
||||
@ -1252,6 +1284,18 @@ throw(G) :-
|
||||
'$format'(user_error,"system_error_at(~w)",[G]),
|
||||
abort.
|
||||
|
||||
|
||||
'$init_catch' :-
|
||||
% initialise access to the catch queue
|
||||
( '$has_static_array'('$catch_queue') ->
|
||||
true
|
||||
;
|
||||
static_array('$catch_queue',2, term)
|
||||
),
|
||||
update_array('$catch_queue', 0, '$'),
|
||||
update_array('$catch_queue', 1, '$').
|
||||
|
||||
|
||||
'$check_list'(V, _) :- var(V), !.
|
||||
'$check_list'([], _) :- !.
|
||||
'$check_list'([_|B], T) :- !,
|
||||
|
||||
@ -619,7 +619,8 @@ call_residue(Goal,Residue) :-
|
||||
;
|
||||
'$pick_vars_for_project'(LIV,NLIV),
|
||||
'$project_module'(LMods,NLIV,LAV),
|
||||
'$all_attvars'(NLAV),
|
||||
'$all_attvars'(NLAV0),
|
||||
sort(NLAV0, NLAV),
|
||||
'$convert_att_vars'(NLAV, LIV, Gs, Gs0)
|
||||
).
|
||||
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
|
||||
load_foreign_files(Objs,Libs,Entry) :-
|
||||
'$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
|
||||
'$check_lib_for_load_foreign_files'(Libs,load_foreign_files(Objs,Libs,Entry)),
|
||||
'$check_libs_for_load_foreign_files'(Libs,load_foreign_files(Objs,Libs,Entry)),
|
||||
'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
|
||||
'$load_foreign_files'(NewObjs,Libs,Entry).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user