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

make sure we do trim_trail whenever we mess with B!

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2258 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-06-04 14:47:18 +00:00
parent 08422c967a
commit 175a0ba6dd
8 changed files with 204 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2008-04-04 16:11:40 $,$Author: vsc $ *
* Last rev: $Date: 2008-06-04 14:47:18 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.240 2008/04/04 16:11:40 vsc
* yapor had gotten broken with recent thread changes
*
* Revision 1.239 2008/04/03 13:26:37 vsc
* protect signal handling with locks for threaded version.
* fix close/1 entry in manual (obs from Nicos).
@ -2192,182 +2195,7 @@ Yap_absmi(int inp)
#endif /* TABLING */
trim_trail:
HBREG = PROTECT_FROZEN_H(B->cp_b);
#ifdef FROZEN_STACKS
{
tr_fr_ptr pt0, pt1, pbase;
pbase = B->cp_tr;
pt0 = pt1 = TR - 1;
while (pt1 >= pbase) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt == Yap_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1);
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
} else
#endif /* LIMIT_TABLING */
if ((ADDR) pt >= Yap_TrailBase) {
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
pt1--;
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
#if defined(THREADS) || defined(YAPOR)
PredEntry *ap = cl->ClPred;
#endif
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount);
if (erase) {
/* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */
saveregs();
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
} else {
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0-1) = TrailVal(pt1-1);
TrailTerm(pt0-1) = TrailTerm(pt1-1);
pt0 -= 2;
pt1 -= 2;
}
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
pt1--;
}
ENDD(d1);
}
if (pt0 != pt1) {
int size;
pt0++;
size = TR - pt0;
memcpy(pbase, pt0, size * sizeof(struct trail_frame));
TR = pbase + size;
}
}
#else
{
tr_fr_ptr pt1, pt0;
pt1 = pt0 = B->cp_tr;
while (pt1 != TR) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
#ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1);
#endif /* FROZEN_STACKS */
TrailTerm(pt0) = d1;
pt0++;
}
pt1++;
} 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
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0+1) = TrailVal(pt1+1);
TrailTerm(pt0+1) = TrailTerm(pt1+1);
pt0 += 2;
pt1 += 2;
#else
TrailTerm(pt0+1) = TrailTerm(pt1+1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
pt0 += 3;
pt1 += 3;
#endif /* FROZEN_STACKS */
}
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
#if defined(YAPOR) || defined(THREADS)
PredEntry *ap = cl->ClPred;
#endif
int erase;
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (DirtyMask|ErasedMask)) && !(cl->ClRefCount);
if (erase) {
/* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */
saveregs();
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
pt0++;
}
pt1++;
} else {
TrailTerm(pt0) = d1;
pt0++;
pt1++;
}
ENDD(d1);
}
TR = pt0;
}
#endif /* FROZEN_STACKS */
#include "trim_trail.h"
B = B->cp_b;
SET_BB(PROTECT_FROZEN_B(B));
}

11
C/c_interface.c
View File

@ -10,8 +10,11 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2008-06-04 13:58:36 $,$Author: vsc $ *
* Last rev: $Date: 2008-06-04 14:47:18 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.117 2008/06/04 13:58:36 vsc
* more fixes to C-interface
*
* Revision 1.116 2008/04/28 23:02:32 vsc
* fix bug in current_predicate/2
* fix bug in c_interface.
@ -964,6 +967,7 @@ YAP_cut_up(void)
B = B->cp_b; /* cut_fail */
#endif
HB = B->cp_h; /* cut_fail */
Yap_TrimTrail();
RECOVER_B();
}
@ -1407,6 +1411,8 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
DEPTH = B->cp_depth;
#endif /* DEPTH_LIMIT */
YENV = ENV = B->cp_env;
} else {
Yap_TrimTrail();
}
/* recover local stack */
ASP = (CELL *)(B+1);
@ -1464,6 +1470,7 @@ YAP_RunGoalOnce(Term t)
CUT_prune_to(cut_pt);
#endif
B = cut_pt;
Yap_TrimTrail();
}
ASP = B->cp_env;
ENV = (CELL *)ASP[E_E];
@ -1530,6 +1537,7 @@ YAP_ShutdownGoal(int backtrack)
ASP = cut_pt->cp_env;
ENV = (CELL *)ASP[E_E];
B = (choiceptr)ASP[E_CB];
Yap_TrimTrail();
#ifdef DEPTH_LIMIT
DEPTH = ASP[E_DEPTH];
#endif
@ -1563,6 +1571,7 @@ YAP_PruneGoal(void)
}
B = B->cp_b;
Yap_TrimTrail();
RECOVER_B();
}

5
C/exec.c
View File

@ -1789,7 +1789,7 @@ p_restore_regs2(void)
#endif /* TABLING */
B = pt0;
HB = B->cp_h;
/* trim_trail();*/
Yap_TrimTrail();
}
return(TRUE);
}
@ -1852,7 +1852,8 @@ p_cut_up_to_next_disjunction(void) {
abolish_incomplete_subgoals(B);
#endif /* TABLING */
}
/* trim_trail(); */
HB = B->cp_h;
Yap_TrimTrail();
return TRUE;
}

2
C/inlines.c
View File

@ -801,7 +801,7 @@ p_cut_by( void)
#endif /* TABLING */
B = pt0;
HB = B->cp_h;
/* trim_trail();*/
Yap_TrimTrail();
}
ENDCHO(pt0);
return(TRUE);

5
C/unify.c
View File

@ -680,3 +680,8 @@ Yap_InitAbsmi(void)
#endif
}
void
Yap_TrimTrail(void)
{
#include "trim_trail.h"
}

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.85 2008-03-27 00:41:32 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.86 2008-06-04 14:47:18 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -325,6 +325,7 @@ void STD_PROTO(Yap_InitLowLevelTrace,(void));
/* unify.c */
void STD_PROTO(Yap_InitAbsmi,(void));
void STD_PROTO(Yap_InitUnify,(void));
void STD_PROTO(Yap_TrimTrail,(void));
int STD_PROTO(Yap_IUnify,(register CELL d0,register CELL d1));
/* userpreds.c */

176
H/trim_trail.h Normal file
View File

@ -0,0 +1,176 @@
#ifdef FROZEN_STACKS
{
tr_fr_ptr pt0, pt1, pbase;
pbase = B->cp_tr;
pt0 = pt1 = TR - 1;
while (pt1 >= pbase) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt == Yap_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1);
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
} else
#endif /* LIMIT_TABLING */
if ((ADDR) pt >= Yap_TrailBase) {
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
pt1--;
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
#if defined(THREADS) || defined(YAPOR)
PredEntry *ap = cl->ClPred;
#endif
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount);
if (erase) {
/* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */
saveregs();
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
} else {
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0-1) = TrailVal(pt1-1);
TrailTerm(pt0-1) = TrailTerm(pt1-1);
pt0 -= 2;
pt1 -= 2;
}
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
pt1--;
}
ENDD(d1);
}
if (pt0 != pt1) {
int size;
pt0++;
size = TR - pt0;
memcpy(pbase, pt0, size * sizeof(struct trail_frame));
TR = pbase + size;
}
}
#else
{
tr_fr_ptr pt1, pt0;
pt1 = pt0 = B->cp_tr;
while (pt1 != TR) {
BEGD(d1);
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
#ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1);
#endif /* FROZEN_STACKS */
TrailTerm(pt0) = d1;
pt0++;
}
pt1++;
} 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
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0+1) = TrailVal(pt1+1);
TrailTerm(pt0+1) = TrailTerm(pt1+1);
pt0 += 2;
pt1 += 2;
#else
TrailTerm(pt0+1) = TrailTerm(pt1+1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
pt0 += 3;
pt1 += 3;
#endif /* FROZEN_STACKS */
}
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
#if defined(YAPOR) || defined(THREADS)
PredEntry *ap = cl->ClPred;
#endif
int erase;
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (DirtyMask|ErasedMask)) && !(cl->ClRefCount);
if (erase) {
/* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */
saveregs();
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
pt0++;
}
pt1++;
} else {
TrailTerm(pt0) = d1;
pt0++;
pt1++;
}
ENDD(d1);
}
TR = pt0;
}
#endif /* FROZEN_STACKS */

3
Makefile.in
View File

@ -111,8 +111,9 @@ HEADERS = \
$(srcdir)/H/index.h $(srcdir)/H/iopreds.h \
$(srcdir)/H/rclause.h \
$(srcdir)/H/rheap.h \
$(srcdir)/H/tracer.h \
$(srcdir)/H/threads.h \
$(srcdir)/H/tracer.h \
$(srcdir)/H/trim_trail.h \
$(srcdir)/H/yapio.h \
$(srcdir)/BEAM/eam.h $(srcdir)/BEAM/eamamasm.h \
$(srcdir)/OPTYap/opt.config.h \