trim_trail for default machine
be more aggressive about try-retry-trust chains. - handle cases where block starts with a wait - don't use _killed instructions, just let the thing rot by itself. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1027 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
5d79688b6b
commit
4242efb73f
125
C/absmi.c
125
C/absmi.c
|
|
@ -10,8 +10,11 @@
|
|||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2004-03-10 14:59:54 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.125 2004/03/10 14:59:54 vsc
|
||||
* optimise -> for type tests
|
||||
*
|
||||
* Revision 1.124 2004/03/08 19:31:01 vsc
|
||||
* move to 4.5.3
|
||||
* *
|
||||
|
|
@ -1198,7 +1201,7 @@ Yap_absmi(int inp)
|
|||
/* I am the last one using this clause, hence I don't need a lock
|
||||
to dispose of it
|
||||
*/
|
||||
Yap_RemoveLogUpdIndex(cl);
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
} else {
|
||||
UNLOCK(cl->ClLock);
|
||||
}
|
||||
|
|
@ -1209,7 +1212,7 @@ Yap_absmi(int inp)
|
|||
TR = --B->cp_tr;
|
||||
/* next, recover space for the indexing code if it was erased */
|
||||
if (cl->ClFlags & ErasedMask) {
|
||||
Yap_RemoveLogUpdIndex(cl);
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1627,9 +1630,7 @@ Yap_absmi(int inp)
|
|||
case _retry_and_mark:
|
||||
case _profiled_retry_and_mark:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
low_level_trace(retry_pred, ipc->u.ld.p, B->cp_args);
|
||||
break;
|
||||
case _Nstop:
|
||||
|
|
@ -1780,12 +1781,12 @@ Yap_absmi(int inp)
|
|||
/* AbsAppl means */
|
||||
/* multi-assignment variable */
|
||||
/* so the next cell is the old value */
|
||||
pt0--;
|
||||
#if FROZEN_STACKS
|
||||
pt[0] = TrailVal(pt0);
|
||||
#else
|
||||
pt[0] = TrailTerm(pt0);
|
||||
#endif /* FROZEN_STACKS */
|
||||
pt0 -= 2;
|
||||
goto failloop;
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1818,7 +1819,56 @@ Yap_absmi(int inp)
|
|||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
trim_trail:
|
||||
{
|
||||
tr_fr_ptr pt1, pt0;
|
||||
pt1 = pt0 = B->cp_tr;
|
||||
while (pt1 != TR) {
|
||||
BEGD(d1);
|
||||
if (IsVarTerm(d1 = TrailTerm(pt1))) {
|
||||
if (d1 < (CELL)HBREG || d1 > Unsigned(B)) {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0++;
|
||||
}
|
||||
pt1++;
|
||||
} else if (IsApplTerm(d1)) {
|
||||
TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
|
||||
TrailTerm(pt0+1) = TrailTerm(pt1+1);
|
||||
pt0 += 3;
|
||||
pt1 += 3;
|
||||
} else if (IsPairTerm(d1)) {
|
||||
CELL *pt = RepPair(d1);
|
||||
if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
|
||||
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
|
||||
int erase;
|
||||
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
cl->ClFlags &= ~InUseMask;
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
/* at this point,
|
||||
we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
saveregs();
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
setregs();
|
||||
}
|
||||
} else {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0++;
|
||||
}
|
||||
pt1++;
|
||||
} else {
|
||||
TrailTerm(pt0) = d1;
|
||||
pt0++;
|
||||
pt1++;
|
||||
}
|
||||
ENDD(d1);
|
||||
}
|
||||
TR = pt0;
|
||||
}
|
||||
}
|
||||
ENDD(d0);
|
||||
GONext();
|
||||
|
|
@ -1843,7 +1893,7 @@ Yap_absmi(int inp)
|
|||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
goto trim_trail;
|
||||
}
|
||||
ENDD(d0);
|
||||
GONext();
|
||||
|
|
@ -1867,7 +1917,7 @@ Yap_absmi(int inp)
|
|||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
goto trim_trail;
|
||||
}
|
||||
ENDD(d0);
|
||||
GONext();
|
||||
|
|
@ -1928,7 +1978,7 @@ Yap_absmi(int inp)
|
|||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(pt0);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
goto trim_trail;
|
||||
}
|
||||
}
|
||||
ENDD(d0);
|
||||
|
|
@ -1964,7 +2014,7 @@ Yap_absmi(int inp)
|
|||
#endif /* TABLING */
|
||||
SET_BB(PROTECT_FROZEN_B(B));
|
||||
HBREG = PROTECT_FROZEN_H(pt0);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
goto trim_trail;
|
||||
}
|
||||
}
|
||||
ENDD(d0);
|
||||
|
|
@ -6564,23 +6614,6 @@ Yap_absmi(int inp)
|
|||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
/* same as retry */
|
||||
BOp(retry_killed, ld);
|
||||
CACHE_Y(B);
|
||||
restore_yaam_regs(NEXTOP(PREG, ld));
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
#endif /* FROZEN_STACKS */
|
||||
SET_BB(B_YREG);
|
||||
ENDCACHE_Y();
|
||||
PREG = PREG->u.ld.d;
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
BOp(retry, ld);
|
||||
CACHE_Y(B);
|
||||
restore_yaam_regs(NEXTOP(PREG, ld));
|
||||
|
|
@ -6597,34 +6630,6 @@ Yap_absmi(int inp)
|
|||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
/* same as trust */
|
||||
BOp(trust_killed, ld);
|
||||
CACHE_Y(B);
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
else
|
||||
#endif /* YAPOR */
|
||||
{
|
||||
pop_yaam_regs();
|
||||
pop_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
SET_BB(B_YREG);
|
||||
ENDCACHE_Y();
|
||||
PREG = PREG->u.ld.d;
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
BOp(trust, ld);
|
||||
CACHE_Y(B);
|
||||
#ifdef YAPOR
|
||||
|
|
@ -7641,10 +7646,11 @@ Yap_absmi(int inp)
|
|||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
PREG = NEXTOP(PREG, xF);
|
||||
goto trim_trail;
|
||||
}
|
||||
ENDCHO(pt0);
|
||||
PREG = NEXTOP(PREG, xF);
|
||||
ENDCHO(pt0);
|
||||
GONext();
|
||||
|
||||
BEGP(pt1);
|
||||
|
|
@ -7688,7 +7694,8 @@ Yap_absmi(int inp)
|
|||
abolish_incomplete_subgoals(B);
|
||||
#endif /* TABLING */
|
||||
HBREG = PROTECT_FROZEN_H(B);
|
||||
TR = trim_trail(B, TR, HBREG);
|
||||
PREG = NEXTOP(PREG, yF);
|
||||
goto trim_trail;
|
||||
}
|
||||
PREG = NEXTOP(PREG, yF);
|
||||
GONext();
|
||||
|
|
|
|||
135
C/cdmgr.c
135
C/cdmgr.c
|
|
@ -9,10 +9,11 @@
|
|||
**************************************************************************
|
||||
* *
|
||||
* File: cdmgr.c *
|
||||
* Last rev: 8/2/88 *
|
||||
* mods: *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
|
||||
|
|
@ -80,6 +81,7 @@ STATIC_PROTO(Int p_call_count_reset, (void));
|
|||
STATIC_PROTO(Int p_toggle_static_predicates_in_use, (void));
|
||||
STATIC_PROTO(Atom YapConsultingFile, (void));
|
||||
STATIC_PROTO(Int PredForCode,(yamop *, Atom *, UInt *, Term *));
|
||||
STATIC_PROTO(void kill_first_log_iblock,(LogUpdIndex *, LogUpdIndex *, PredEntry *));
|
||||
|
||||
#define PredArity(p) (p->ArityOfPE)
|
||||
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G)
|
||||
|
|
@ -163,6 +165,8 @@ IPred(PredEntry *ap)
|
|||
Term t = Deref(ARG1);
|
||||
if (IsAtomTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else if (IsIntegerTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
Atom At = NameOfFunctor(f);
|
||||
|
|
@ -289,9 +293,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
|
|||
ipc = NEXTOP(ipc,p);
|
||||
break;
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
decrease_ref_counter(ipc->u.ld.d, beg, end, suspend_code);
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
|
|
@ -401,6 +403,48 @@ kill_static_child_indxs(StaticIndex *indx)
|
|||
Yap_FreeCodeSpace((CODEADDR)indx);
|
||||
}
|
||||
|
||||
static void
|
||||
kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
{
|
||||
if (parent != NULL) {
|
||||
/* sat bye bye */
|
||||
/* decrease refs */
|
||||
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
LOCK(parent->ClLock);
|
||||
parent->ClRefCount--;
|
||||
if (parent->ClFlags & ErasedMask &&
|
||||
!(parent->ClFlags & InUseMask) &&
|
||||
parent->ClRefCount == 0) {
|
||||
/* cool, I can erase the father too. */
|
||||
if (parent->ClFlags & SwitchRootMask) {
|
||||
UNLOCK(parent->ClLock);
|
||||
kill_off_lu_block(parent, NULL, ap);
|
||||
} else {
|
||||
UNLOCK(parent->ClLock);
|
||||
kill_off_lu_block(parent, parent->u.ParentIndex, ap);
|
||||
}
|
||||
} else {
|
||||
UNLOCK(parent->ClLock);
|
||||
}
|
||||
}
|
||||
UNLOCK(c->ClLock);
|
||||
#ifdef DEBUG
|
||||
{
|
||||
LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
|
||||
while (parent != NULL) {
|
||||
if (c == parent) {
|
||||
if (c0) c0->SiblingIndex = c->SiblingIndex;
|
||||
else DBErasedIList = c->SiblingIndex;
|
||||
break;
|
||||
}
|
||||
c0 = parent;
|
||||
parent = parent->SiblingIndex;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
Yap_FreeCodeSpace((CODEADDR)c);
|
||||
}
|
||||
|
||||
static void
|
||||
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
{
|
||||
|
|
@ -440,44 +484,11 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
|||
}
|
||||
LOCK(c->ClLock);
|
||||
c->ClRefCount--;
|
||||
#ifdef DEBUG
|
||||
{
|
||||
LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
|
||||
while (parent != NULL) {
|
||||
if (c == parent) {
|
||||
if (c0) c0->SiblingIndex = c->SiblingIndex;
|
||||
else DBErasedIList = c->SiblingIndex;
|
||||
}
|
||||
c0 = parent;
|
||||
parent = parent->SiblingIndex;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
|
||||
if (parent != NULL) {
|
||||
/* sat bye bye */
|
||||
/* decrease refs */
|
||||
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
LOCK(parent->ClLock);
|
||||
parent->ClRefCount--;
|
||||
if (parent->ClFlags & ErasedMask &&
|
||||
!(parent->ClFlags & InUseMask) &&
|
||||
parent->ClRefCount == 0) {
|
||||
/* cool, I can erase the father too. */
|
||||
if (parent->ClFlags & SwitchRootMask) {
|
||||
UNLOCK(parent->ClLock);
|
||||
kill_first_log_iblock(parent, NULL, ap);
|
||||
} else {
|
||||
UNLOCK(parent->ClLock);
|
||||
kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
|
||||
}
|
||||
} else {
|
||||
UNLOCK(parent->ClLock);
|
||||
}
|
||||
}
|
||||
UNLOCK(c->ClLock);
|
||||
Yap_FreeCodeSpace((CODEADDR)c);
|
||||
kill_off_lu_block(c, parent, ap);
|
||||
} else {
|
||||
if (c->ClFlags & ErasedMask)
|
||||
return;
|
||||
c->ClFlags |= ErasedMask;
|
||||
/* try to move up, so that we don't hold a switch table */
|
||||
if (parent != NULL &&
|
||||
|
|
@ -498,6 +509,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
|||
#endif
|
||||
UNLOCK(c->ClLock);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -555,12 +567,21 @@ Yap_ErLogUpdIndex(LogUpdIndex *clau)
|
|||
{
|
||||
LogUpdIndex *c = clau;
|
||||
if (clau->ClFlags & ErasedMask) {
|
||||
/* nothing I can do, I have been erased already */
|
||||
if (!c->ClRefCount) {
|
||||
if (c->ClFlags & SwitchRootMask) {
|
||||
kill_off_lu_block(clau, NULL, c->u.pred);
|
||||
} else {
|
||||
while (!(c->ClFlags & SwitchRootMask))
|
||||
c = c->u.ParentIndex;
|
||||
kill_off_lu_block(clau, clau->u.ParentIndex, c->u.pred);
|
||||
}
|
||||
}
|
||||
/* otherwise, nothing I can do, I have been erased already */
|
||||
return;
|
||||
}
|
||||
if (c->ClFlags & SwitchRootMask) {
|
||||
kill_first_log_iblock(clau, NULL, c->u.pred);
|
||||
} else {
|
||||
} else {
|
||||
while (!(c->ClFlags & SwitchRootMask))
|
||||
c = c->u.ParentIndex;
|
||||
#if defined(THREADS) || defined(YAPOR)
|
||||
|
|
@ -579,36 +600,6 @@ Yap_ErLogUpdIndex(LogUpdIndex *clau)
|
|||
}
|
||||
}
|
||||
|
||||
void
|
||||
Yap_RemoveLogUpdIndex(LogUpdIndex *cl)
|
||||
{
|
||||
if (cl->ClFlags & ErasedMask) {
|
||||
/* nothing I can do, I have been erased already */
|
||||
return;
|
||||
}
|
||||
if (cl->ClFlags & SwitchRootMask) {
|
||||
kill_first_log_iblock(cl, NULL, cl->u.pred);
|
||||
} else {
|
||||
LogUpdIndex *pcl = cl;
|
||||
while (!(pcl->ClFlags & SwitchRootMask)) {
|
||||
pcl = pcl->u.ParentIndex;
|
||||
}
|
||||
#if defined(THREADS) || defined(YAPOR)
|
||||
LOCK(cl->u.ParentIndex->ClLock);
|
||||
/* protect against attempts at erasing */
|
||||
cl->u.ParentIndex->ClRefCount++;
|
||||
UNLOCK(cl->u.ParentIndex->ClLock);
|
||||
#endif
|
||||
kill_first_log_iblock(cl, cl->u.ParentIndex, pcl->u.pred);
|
||||
#if defined(THREADS) || defined(YAPOR)
|
||||
LOCK(cl->u.ParentIndex->ClLock);
|
||||
/* protect against attempts at erasing */
|
||||
cl->u.ParentIndex->ClRefCount--;
|
||||
UNLOCK(cl->u.ParentIndex->ClLock);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
/* Routine used when wanting to remove the indexation */
|
||||
/* ap is known to already have been locked for WRITING */
|
||||
static int
|
||||
|
|
|
|||
56
C/heapgc.c
56
C/heapgc.c
|
|
@ -1335,7 +1335,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
|||
/* reset the gc to believe the original tag */
|
||||
TrailTerm(trail_ptr) = AbsAppl((CELL *)TrailTerm(trail_ptr));
|
||||
}
|
||||
trail_ptr --;
|
||||
trail_ptr -= 2;
|
||||
} else {
|
||||
tr_fr_ptr trp = (*lkp)-1;
|
||||
TrailTerm(trp) = TrailTerm(trail_ptr-1);
|
||||
|
|
@ -1350,6 +1350,8 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
|||
#ifdef FROZEN_STACKS
|
||||
RESET_VARIABLE(&TrailVal(trail_ptr));
|
||||
#endif
|
||||
trail_ptr--;
|
||||
RESET_VARIABLE(&TrailTerm(trail_ptr));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
|
@ -1365,14 +1367,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
|||
if (HEAP_PTR(TrailVal(trail_ptr))) {
|
||||
mark_external_reference(&TrailVal(trail_ptr));
|
||||
}
|
||||
#endif
|
||||
/*
|
||||
swap the two so that the sweep_trail() knows we have
|
||||
a multi-assignment binding
|
||||
*/
|
||||
TrailTerm(live_list->trptr) = TrailTerm(live_list->trptr-1);
|
||||
TrailTerm(live_list->trptr-1) = trail_cell2;
|
||||
#ifdef FROZEN_STACKS
|
||||
if (HEAP_PTR(TrailVal(trail_ptr-1))) {
|
||||
mark_external_reference(&TrailVal(trail_ptr-1));
|
||||
}
|
||||
|
|
@ -1739,9 +1733,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
|
|||
case _retry_me4:
|
||||
case _trust_me4:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
nargs = rtp->u.ld.s;
|
||||
break;
|
||||
default:
|
||||
|
|
@ -2004,7 +1996,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||
}
|
||||
#if MULTI_ASSIGNMENT_VARIABLES
|
||||
} else {
|
||||
CELL trail_cell = TrailTerm(trail_ptr);
|
||||
CELL trail_cell = TrailTerm(trail_ptr+2);
|
||||
CELL *ptr;
|
||||
CELL old = TrailTerm(trail_ptr+1);
|
||||
|
||||
|
|
@ -2013,40 +2005,40 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||
else
|
||||
ptr = RepAppl(trail_cell);
|
||||
|
||||
TrailTerm(dest) = old;
|
||||
TrailTerm(dest+1) = trail_cell;
|
||||
TrailTerm(dest+1) = old;
|
||||
TrailTerm(dest+2) = TrailTerm(dest) = trail_cell;
|
||||
if (MARKED(old)) {
|
||||
UNMARK(&TrailTerm(dest));
|
||||
UNMARK(&TrailTerm(dest+1));
|
||||
if (HEAP_PTR(old)) {
|
||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(old));
|
||||
into_relocation_chain(&TrailTerm(dest+1), GET_NEXT(old));
|
||||
}
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED(TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest)));
|
||||
TrailVal(dest+1) = TrailVal(trail_ptr+1);
|
||||
if (MARKED(TrailVal(dest+1))) {
|
||||
UNMARK(&TrailVal(dest+1));
|
||||
if (HEAP_PTR(TrailVal(dest+1))) {
|
||||
into_relocation_chain(&TrailVal(dest+1), GET_NEXT(TrailTerm(dest+1)));
|
||||
}
|
||||
}
|
||||
TrailVal(dest+2) = TrailVal(trail_ptr+2);
|
||||
if (MARKED(TrailVal(dest+2))) {
|
||||
UNMARK(&TrailVal(dest+2));
|
||||
if (HEAP_PTR(TrailVal(dest+2))) {
|
||||
into_relocation_chain(&TrailVal(dest+2), GET_NEXT(TrailTerm(dest+2)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
dest++;
|
||||
if (MARKED(trail_cell)) {
|
||||
UNMARK(&TrailTerm(dest));
|
||||
UNMARK(&TrailTerm(dest+2));
|
||||
if (HEAP_PTR(trail_cell)) {
|
||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
||||
into_relocation_chain(&TrailTerm(dest+2), GET_NEXT(trail_cell));
|
||||
}
|
||||
}
|
||||
trail_ptr++;
|
||||
#ifdef FROZEN_STACKS
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED(TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
trail_ptr += 2;
|
||||
dest += 2;
|
||||
#endif
|
||||
}
|
||||
trail_ptr++;
|
||||
|
|
|
|||
321
C/index.c
321
C/index.c
|
|
@ -9,10 +9,11 @@
|
|||
**************************************************************************
|
||||
* *
|
||||
* File: index.c *
|
||||
* Last rev: 5/2/88 *
|
||||
* mods: *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $ *
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
|
|
@ -375,9 +376,7 @@ has_cut(yamop *pc)
|
|||
case _retry_and_mark:
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
#ifdef YAPOR
|
||||
case _getwork:
|
||||
case _getwork_seq:
|
||||
|
|
@ -1574,9 +1573,7 @@ add_info(ClauseDef *clause, UInt regno)
|
|||
case _retry_and_mark:
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
case _enter_lu_pred:
|
||||
case _stale_lu_index:
|
||||
#ifdef YAPOR
|
||||
|
|
@ -2595,12 +2592,17 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates
|
|||
*/
|
||||
if (first &&
|
||||
cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
||||
UInt ncls;
|
||||
labl_dyn0 = new_label();
|
||||
if (clleft)
|
||||
labl_dynf = labl_dyn0;
|
||||
else
|
||||
labl_dynf = new_label();
|
||||
Yap_emit_3ops(enter_lu_op, labl_dyn0, labl_dynf, (cf-c0)+1, cint);
|
||||
if (clleft == 0) /* trust*/
|
||||
ncls = (cf-c0)+1;
|
||||
else
|
||||
ncls = 0;
|
||||
Yap_emit_3ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, cint);
|
||||
Yap_emit(label_op, labl_dyn0, Zero, cint);
|
||||
}
|
||||
if (c0 == cf) {
|
||||
|
|
@ -2910,9 +2912,8 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, struct intermedi
|
|||
if (clleft) {
|
||||
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
||||
UInt labl = new_label();
|
||||
PredEntry *ap = cint->CurrentPred;
|
||||
|
||||
Yap_emit_3ops(enter_lu_op, labl, labl, ap->cs.p_code.NOfClauses, cint);
|
||||
Yap_emit_3ops(enter_lu_op, labl, labl, 0, cint);
|
||||
Yap_emit(label_op, labl, Zero, cint);
|
||||
}
|
||||
Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint);
|
||||
|
|
@ -3773,7 +3774,6 @@ expand_index(struct intermediates *cint) {
|
|||
switch(op) {
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
/* this clause had no indexing */
|
||||
if (ap->PredFlags & LogUpdatePredFlag) {
|
||||
first = ClauseCodeToLogUpdClause(ipc->u.ld.d)->ClNext->ClCode;
|
||||
|
|
@ -3827,7 +3827,6 @@ expand_index(struct intermediates *cint) {
|
|||
stack[0].pos = 0;
|
||||
break;
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
/* we should never be here */
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, "New indexing code");
|
||||
labp = NULL;
|
||||
|
|
@ -4100,6 +4099,7 @@ expand_index(struct intermediates *cint) {
|
|||
} else {
|
||||
max = install_clauses(cls, ap, stack, first, last);
|
||||
}
|
||||
fprintf(stderr,"expanding %d/%d\n",(max-cls)+1,NClauses);
|
||||
/* don't count last clause if you don't have to */
|
||||
if (alt && max->Code == last) max--;
|
||||
if (max < cls && labp != NULL) {
|
||||
|
|
@ -4222,6 +4222,8 @@ ExpandIndex(PredEntry *ap) {
|
|||
Term t = Deref(ARG1);
|
||||
if (IsAtomTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else if (IsIntegerTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
Atom At = NameOfFunctor(f);
|
||||
|
|
@ -4643,15 +4645,18 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp, PredEntry *a
|
|||
{
|
||||
LogUpdIndex *blk;
|
||||
yamop *start;
|
||||
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
||||
op_numbers op0;
|
||||
|
||||
while ((--sp)->flag != block_entry);
|
||||
blk = (LogUpdIndex *)(sp->u.cle.block);
|
||||
start = blk->ClCode;
|
||||
op0 = Yap_op_from_opcode(start->opc);
|
||||
if (sp->u.cle.entry_code == NULL ||
|
||||
(op0 != _enter_lu_pred && op0 != _stale_lu_index)) {
|
||||
while (op0 == _jump_if_nonvar) {
|
||||
start = NEXTOP(start, xl);
|
||||
op0 = Yap_op_from_opcode(start->opc);
|
||||
}
|
||||
if ((op0 != _enter_lu_pred && op0 != _stale_lu_index)
|
||||
|| !start->u.Ill.s /* weird block */) {
|
||||
return kill_block(sp+1, ap);
|
||||
} else {
|
||||
/* decrease number of clauses */
|
||||
|
|
@ -4667,9 +4672,16 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp, PredEntry *a
|
|||
case _retry:
|
||||
case _try_clause:
|
||||
/* kill block and replace by this single clause */
|
||||
if (!IN_BETWEEN(bg, codep->u.ld.d, lt)) {
|
||||
path_stack_entry *nsp = sp;
|
||||
if (codep->u.ld.d != FAILCODE) {
|
||||
path_stack_entry *nsp;
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(codep->u.ld.d);
|
||||
|
||||
if (tgl->ClFlags & ErasedMask ||
|
||||
IN_BETWEEN(bg, codep->u.ld.d, lt)) {
|
||||
codep = NEXTOP(codep,ld);
|
||||
break;
|
||||
}
|
||||
nsp = sp;
|
||||
while ((--nsp)->flag != block_entry);
|
||||
*sp->u.cle.entry_code = codep->u.ld.d;
|
||||
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap);
|
||||
|
|
@ -4678,10 +4690,6 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp, PredEntry *a
|
|||
codep = NEXTOP(codep,ld);
|
||||
}
|
||||
break;
|
||||
case _retry_killed:
|
||||
case _trust_killed:
|
||||
codep = NEXTOP(codep, ld);
|
||||
break;
|
||||
case _trust_logical_pred:
|
||||
codep = NEXTOP(codep, l);
|
||||
break;
|
||||
|
|
@ -4698,11 +4706,10 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp, PredEntry *a
|
|||
/* just mark the clause as dead and the code as unreachable, but
|
||||
don't do anything else
|
||||
*/
|
||||
if (IN_BETWEEN(bg, start->u.Ill.l1->u.ld.d, lt)) {
|
||||
start->u.Ill.l1->u.ld.d = FAILCODE;
|
||||
}
|
||||
start->opc = Yap_opcode(_stale_lu_index);
|
||||
if (op == _trust) ipc->opc = Yap_opcode(_trust_killed);
|
||||
/* in case of a try clause, just get rid of it */
|
||||
else if (op == _try_clause) ipc->u.ld.d = FAILCODE;
|
||||
else ipc->opc = Yap_opcode(_retry_killed);
|
||||
return sp;
|
||||
}
|
||||
}
|
||||
|
|
@ -4760,6 +4767,24 @@ gen_lui_trust(yamop *codep, yamop *ocodep, int profiled, int count_call, PredEnt
|
|||
return copy_ld(codep, ocodep, ap, code, has_cut);
|
||||
}
|
||||
|
||||
static void
|
||||
clean_ref_to_clause(LogUpdClause *tgl, op_numbers op, int compact_mode)
|
||||
{
|
||||
if (op == _try_clause || !compact_mode)
|
||||
return;
|
||||
LOCK(tgl->ClLock);
|
||||
tgl->ClRefCount--;
|
||||
if ((tgl->ClFlags & ErasedMask) &&
|
||||
!(tgl->ClRefCount) &&
|
||||
!(tgl->ClFlags & InUseMask)) {
|
||||
/* last ref to the clause */
|
||||
UNLOCK(tgl->ClLock);
|
||||
Yap_ErLogUpdCl(tgl);
|
||||
} else {
|
||||
UNLOCK(tgl->ClLock);
|
||||
}
|
||||
}
|
||||
|
||||
static yamop *
|
||||
cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *ap, yamop *code, int has_cut, LogUpdIndex *nblk, UInt ncls, UInt i)
|
||||
{
|
||||
|
|
@ -4772,72 +4797,40 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
|
|||
op_numbers op = Yap_op_from_opcode(ocodep->opc);
|
||||
switch (op) {
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
if (ocodep->u.ld.d == FAILCODE) {
|
||||
ocodep = NEXTOP(ocodep, ld);
|
||||
break;
|
||||
}
|
||||
do_retry:
|
||||
if (i == 0) {
|
||||
if (op != _try_clause) {
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
|
||||
if (compact_mode) {
|
||||
LOCK(tgl->ClLock);
|
||||
tgl->ClRefCount--;
|
||||
if (tgl->ClFlags & ErasedMask &&
|
||||
!(tgl->ClRefCount) &&
|
||||
!(tgl->ClFlags & InUseMask)) {
|
||||
/* last ref to the clause */
|
||||
UNLOCK(tgl->ClLock);
|
||||
Yap_ErLogUpdCl(tgl);
|
||||
} else {
|
||||
UNLOCK(tgl->ClLock);
|
||||
}
|
||||
}
|
||||
}
|
||||
codep->opc = Yap_opcode(_try_clause);
|
||||
codep = copy_ld(codep, ocodep, ap, ocodep->u.ld.d, FALSE);
|
||||
} else if (i == ncls-1) {
|
||||
goto do_trust;
|
||||
} else {
|
||||
if (op == _try_clause || !compact_mode) {
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
|
||||
tgl->ClRefCount++;
|
||||
}
|
||||
codep = gen_lui_retry(codep, ocodep, profiled, count_reds, ap);
|
||||
}
|
||||
i++;
|
||||
ocodep = NEXTOP(ocodep, ld);
|
||||
break;
|
||||
case _retry:
|
||||
case _trust:
|
||||
if (i < ncls-1) goto do_retry;
|
||||
do_trust:
|
||||
if (!compact_mode) {
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
|
||||
tgl->ClRefCount++;
|
||||
} else {
|
||||
Yap_cleanup_dangling_indices(NEXTOP(ocodep,ld),ostart->u.Ill.l1,ostart->u.Ill.l2,(yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
}
|
||||
codep = gen_lui_trust(codep, ocodep, profiled, count_reds, ap, ocodep->u.ld.d, TRUE, nblk);
|
||||
ocodep = NULL;
|
||||
break;
|
||||
case _retry_killed:
|
||||
case _trust_killed:
|
||||
if (compact_mode) {
|
||||
{
|
||||
/* set up a try_clause */
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
|
||||
|
||||
LOCK(tgl->ClLock);
|
||||
tgl->ClRefCount--;
|
||||
if (tgl->ClFlags & ErasedMask &&
|
||||
!(tgl->ClRefCount) &&
|
||||
!(tgl->ClFlags & InUseMask)) {
|
||||
/* last ref to the clause */
|
||||
UNLOCK(tgl->ClLock);
|
||||
Yap_ErLogUpdCl(tgl);
|
||||
if (tgl->ClFlags & ErasedMask) {
|
||||
clean_ref_to_clause(tgl, op, compact_mode);
|
||||
ocodep = NEXTOP(ocodep, ld);
|
||||
break;
|
||||
} else if (i == 0) {
|
||||
codep->opc = Yap_opcode(_try_clause);
|
||||
codep = copy_ld(codep, ocodep, ap, ocodep->u.ld.d, FALSE);
|
||||
} else if (i == ncls-1) {
|
||||
if (!compact_mode) {
|
||||
tgl->ClRefCount++;
|
||||
} else {
|
||||
Yap_cleanup_dangling_indices(NEXTOP(ocodep,ld),ostart->u.Ill.l1,ostart->u.Ill.l2,(yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
}
|
||||
codep = gen_lui_trust(codep, ocodep, profiled, count_reds, ap, ocodep->u.ld.d, TRUE, nblk);
|
||||
ocodep = NULL;
|
||||
break;
|
||||
} else {
|
||||
UNLOCK(tgl->ClLock);
|
||||
if (op == _try_clause || !compact_mode) {
|
||||
tgl->ClRefCount++;
|
||||
}
|
||||
codep = gen_lui_retry(codep, ocodep, profiled, count_reds, ap);
|
||||
}
|
||||
}
|
||||
i++;
|
||||
ocodep = NEXTOP(ocodep, ld);
|
||||
break;
|
||||
case _trust_logical_pred:
|
||||
|
|
@ -4860,25 +4853,33 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
|
|||
static yamop *
|
||||
replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has_cut)
|
||||
{
|
||||
yamop *codep, *start, *ocodep = blk->ClCode->u.Ill.l1;
|
||||
UInt ncls, xcls;
|
||||
yamop *begin = blk->ClCode, *codep, *start, *ocodep;
|
||||
yamop *nbegin;
|
||||
UInt ncls, xcls, jnvs = 0;
|
||||
UInt sz, i;
|
||||
LogUpdIndex *ncl, *pcl;
|
||||
int count_reds = ap->PredFlags & CountPredFlag;
|
||||
int profiled = ap->PredFlags & ProfiledPredFlag;
|
||||
|
||||
op_numbers op = Yap_op_from_opcode(begin->opc);
|
||||
|
||||
|
||||
while (op == _jump_if_nonvar) {
|
||||
jnvs++;
|
||||
begin = NEXTOP(begin, xl);
|
||||
op = Yap_op_from_opcode(begin->opc);
|
||||
}
|
||||
/* add half the current space plus 1, and also the extra clause */
|
||||
if (flag == RECORDA || flag == RECORDZ) {
|
||||
/* we are still introducing a clause */
|
||||
ncls = ++(blk->ClCode->u.Ill.s);
|
||||
ncls = ++(begin->u.Ill.s);
|
||||
xcls = ncls+ncls/2+2;
|
||||
} else {
|
||||
ncls = blk->ClCode->u.Ill.s;
|
||||
ncls = begin->u.Ill.s;
|
||||
xcls = ncls;
|
||||
}
|
||||
sz = sizeof(LogUpdIndex)+
|
||||
xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
|
||||
jnvs*((UInt)NEXTOP((yamop *)NULL,l))+
|
||||
(UInt)NEXTOP((yamop *)NULL,Ill)+
|
||||
(UInt)NEXTOP((yamop *)NULL,p);
|
||||
if (count_reds) sz += xcls*((UInt)NEXTOP((yamop *)NULL,p));
|
||||
|
|
@ -4890,18 +4891,38 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
|
|||
return NULL;
|
||||
}
|
||||
ncl->ClFlags = LogUpdMask|IndexedPredFlag|IndexMask;
|
||||
if (blk->ClFlags & SwitchRootMask) {
|
||||
ncl->ClFlags |= SwitchRootMask;
|
||||
ncl->u.pred = blk->u.pred;
|
||||
} else {
|
||||
ncl->u.ParentIndex = blk->u.ParentIndex;
|
||||
}
|
||||
ncl->ClRefCount = 0;
|
||||
ncl->u.ParentIndex = blk->u.ParentIndex;
|
||||
ncl->ChildIndex = NULL;
|
||||
{
|
||||
LogUpdIndex *idx = ncl->ChildIndex = blk->ChildIndex;
|
||||
while (idx) {
|
||||
blk->ClRefCount--;
|
||||
idx = idx->SiblingIndex;
|
||||
}
|
||||
}
|
||||
blk->ChildIndex = NULL;
|
||||
ncl->ClSize = sz;
|
||||
INIT_LOCK(ncl->ClLock);
|
||||
INIT_CLREF_COUNT(ncl);
|
||||
codep = start = ncl->ClCode;
|
||||
nbegin = ncl->ClCode;
|
||||
begin = blk->ClCode;
|
||||
while (jnvs--) {
|
||||
nbegin->opc = begin->opc;
|
||||
begin = NEXTOP(begin, xl);
|
||||
nbegin = NEXTOP(nbegin, xl);
|
||||
}
|
||||
codep = start = nbegin;
|
||||
/* ok, we've allocated and set up things, now let's finish */
|
||||
codep->opc = Yap_opcode(_enter_lu_pred);
|
||||
codep->u.Ill.s = blk->ClCode->u.Ill.s;
|
||||
codep->u.Ill.s = begin->u.Ill.s;
|
||||
codep->u.Ill.I = ncl;
|
||||
codep = NEXTOP(codep,Ill);
|
||||
ocodep = begin->u.Ill.l1;
|
||||
if (flag == RECORDA) {
|
||||
int j;
|
||||
|
||||
|
|
@ -4924,17 +4945,21 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
|
|||
start->u.Ill.l1 = codep;
|
||||
i = 0;
|
||||
}
|
||||
codep = cp_lu_trychain(codep, ocodep, blk->ClCode, flag, ap, code, has_cut, ncl, ncls, i);
|
||||
codep = cp_lu_trychain(codep, ocodep, begin, flag, ap, code, has_cut, ncl, ncls, i);
|
||||
/* the copying has been done */
|
||||
start->u.Ill.l2 = codep;
|
||||
/* insert ourselves into chain */
|
||||
pcl = blk->u.ParentIndex;
|
||||
ncl->SiblingIndex = pcl->ChildIndex;
|
||||
pcl->ChildIndex = ncl;
|
||||
/* we have a new pointer to our clause */
|
||||
pcl->ClRefCount++;
|
||||
if (!(blk->ClFlags & ErasedMask)) {
|
||||
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
|
||||
if (blk->ClFlags & SwitchRootMask) {
|
||||
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
|
||||
} else {
|
||||
pcl = blk->u.ParentIndex;
|
||||
ncl->SiblingIndex = pcl->ChildIndex;
|
||||
pcl->ChildIndex = ncl;
|
||||
/* we have a new pointer to our clause */
|
||||
pcl->ClRefCount++;
|
||||
if (!(blk->ClFlags & ErasedMask)) {
|
||||
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
|
||||
}
|
||||
}
|
||||
return start;
|
||||
}
|
||||
|
|
@ -4948,11 +4973,18 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
|
|||
if (blk->ClFlags & InUseMask) {
|
||||
/* make a new block */
|
||||
yamop *new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE);
|
||||
*jlbl = new;
|
||||
if (jlbl)
|
||||
*jlbl = new;
|
||||
return new;
|
||||
} else {
|
||||
/* work on the current block */
|
||||
codep->u.Ill.l2 = cp_lu_trychain(codep->u.Ill.l1, codep->u.Ill.l1, blk->ClCode, REFRESH, ap, NULL, FALSE, blk, ncls, 0);
|
||||
op_numbers op = Yap_op_from_opcode(codep->opc);
|
||||
|
||||
while (op == _jump_if_nonvar) {
|
||||
codep = NEXTOP(codep, xl);
|
||||
op = Yap_op_from_opcode(codep->opc);
|
||||
}
|
||||
codep->u.Ill.l2 = cp_lu_trychain(codep->u.Ill.l1, codep->u.Ill.l1, codep, REFRESH, ap, NULL, FALSE, blk, ncls, 0);
|
||||
return codep->u.Ill.l1;
|
||||
}
|
||||
}
|
||||
|
|
@ -4963,8 +4995,13 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
op_numbers op = Yap_op_from_opcode(blk->ClCode->opc);
|
||||
yamop *end, *last, *where, *next;
|
||||
UInt bsize;
|
||||
yamop *begin = blk->ClCode;
|
||||
|
||||
/* make sure this is something I can work with */
|
||||
while (op == _jump_if_nonvar) {
|
||||
begin = NEXTOP(begin, xl);
|
||||
op = Yap_op_from_opcode(begin->opc);
|
||||
}
|
||||
if (op != _enter_lu_pred && op != _stale_lu_index) {
|
||||
if (blk->ClFlags & SwitchRootMask) {
|
||||
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
|
||||
|
|
@ -4977,7 +5014,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
similar */
|
||||
bsize = blk->ClSize;
|
||||
end = (yamop *)((CODEADDR)blk+bsize);
|
||||
where = last = blk->ClCode->u.Ill.l2;
|
||||
where = last = begin->u.Ill.l2;
|
||||
next = NEXTOP(NEXTOP(where, ld),p); /* trust logical followed by trust */
|
||||
last = PREVOP(last, ld);
|
||||
/* follow profiling and counting instructions */
|
||||
|
|
@ -4991,9 +5028,9 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
/* we got space to put something in */
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(code);
|
||||
|
||||
if (blk->ClCode->opc != Yap_opcode(_stale_lu_index)) {
|
||||
if (begin->opc != Yap_opcode(_stale_lu_index)) {
|
||||
if (blk->ClFlags & InUseMask) {
|
||||
blk->ClCode->opc = Yap_opcode(_stale_lu_index);
|
||||
begin->opc = Yap_opcode(_stale_lu_index);
|
||||
} else {
|
||||
/* we need to rebuild the code */
|
||||
/* first, shift the last retry down, getting rid of the trust logical pred */
|
||||
|
|
@ -5028,10 +5065,10 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
#ifdef TABLING
|
||||
where->u.ld.te = last->u.ld.te;
|
||||
#endif /* TABLING */
|
||||
blk->ClCode->u.Ill.l2 = NEXTOP(where,ld);
|
||||
blk->ClCode->u.Ill.s++;
|
||||
begin->u.Ill.l2 = NEXTOP(where,ld);
|
||||
begin->u.Ill.s++;
|
||||
tgl->ClRefCount++;
|
||||
return blk->ClCode;
|
||||
return begin;
|
||||
} else {
|
||||
return replace_lu_block(blk, RECORDZ, ap, code, has_cut(code));
|
||||
}
|
||||
|
|
@ -5042,7 +5079,13 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
{
|
||||
op_numbers op = Yap_op_from_opcode(blk->ClCode->opc);
|
||||
yamop *start, *next, *here;
|
||||
yamop *begin = blk->ClCode;
|
||||
|
||||
/* make sure this is something I can work with */
|
||||
while (op == _jump_if_nonvar) {
|
||||
begin = NEXTOP(begin, xl);
|
||||
op = Yap_op_from_opcode(begin->opc);
|
||||
}
|
||||
if (op != _enter_lu_pred && op != _stale_lu_index) {
|
||||
if (blk->ClFlags & SwitchRootMask) {
|
||||
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
|
||||
|
|
@ -5053,13 +5096,13 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
}
|
||||
/* ok, we are in a sequence of try-retry-trust instructions, or something
|
||||
similar */
|
||||
here = next = blk->ClCode->u.Ill.l1;
|
||||
here = next = begin->u.Ill.l1;
|
||||
if (here->opc == Yap_opcode(_try_clause) && here->u.ld.d == FAILCODE) {
|
||||
blk->ClCode->u.Ill.s++;
|
||||
begin->u.Ill.s++;
|
||||
here->u.ld.d = code;
|
||||
return blk->ClCode;
|
||||
return begin;
|
||||
}
|
||||
start = NEXTOP(blk->ClCode,Ill);
|
||||
start = NEXTOP(begin,Ill);
|
||||
here = PREVOP(here, ld);
|
||||
/* follow profiling and counting instructions */
|
||||
if (ap->PredFlags & ProfiledPredFlag) {
|
||||
|
|
@ -5072,15 +5115,11 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
}
|
||||
if (here >= start) {
|
||||
/* we got space to put something in */
|
||||
op_numbers sop = Yap_op_from_opcode(next->opc);
|
||||
if (sop != _retry_killed) {
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(next->u.ld.d);
|
||||
|
||||
next->opc = Yap_opcode(_retry);
|
||||
tgl->ClRefCount++;
|
||||
}
|
||||
blk->ClCode->u.Ill.l1 = here;
|
||||
blk->ClCode->u.Ill.s++;
|
||||
LogUpdClause *tgl = ClauseCodeToLogUpdClause(next->u.ld.d);
|
||||
next->opc = Yap_opcode(_retry);
|
||||
tgl->ClRefCount++;
|
||||
begin->u.Ill.l1 = here;
|
||||
begin->u.Ill.s++;
|
||||
here->opc = Yap_opcode(_try_clause);
|
||||
here->u.ld.s = next->u.ld.s;
|
||||
here->u.ld.p = ap;
|
||||
|
|
@ -5102,7 +5141,7 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
|
|||
here->opc = Yap_opcode(_retry_profiled);
|
||||
here->u.p.p = ap;
|
||||
}
|
||||
return blk->ClCode;
|
||||
return begin;
|
||||
} else {
|
||||
return replace_lu_block(blk, RECORDA, ap, code, has_cut(code));
|
||||
}
|
||||
|
|
@ -5212,7 +5251,6 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
|
|||
ipc = pop_path(&sp, cls, ap);
|
||||
break;
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
/* this clause had no indexing */
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
|
|
@ -5257,7 +5295,6 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
|
|||
ipc = NEXTOP(ipc, l);
|
||||
break;
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
sp = expandz_block(sp, ap, cls, group1, alt, cint);
|
||||
ipc = pop_path(&sp, cls, ap);
|
||||
break;
|
||||
|
|
@ -5660,6 +5697,8 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
|
|||
Term t = Deref(ARG1);
|
||||
if (IsAtomTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else if (IsIntegerTerm(t)) {
|
||||
Yap_plwrite(t, Yap_DebugPutc, 0);
|
||||
} else {
|
||||
Functor f = FunctorOfTerm(t);
|
||||
Atom At = NameOfFunctor(f);
|
||||
|
|
@ -5776,8 +5815,6 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
|
|||
case _trust_logical_pred:
|
||||
ipc = NEXTOP(ipc,l);
|
||||
break;
|
||||
case _trust_killed:
|
||||
ipc = NEXTOP(ipc, ld);
|
||||
case _trust:
|
||||
if (IN_BETWEEN(bg,ipc->u.ld.d,lt)) {
|
||||
sp = kill_clause(ipc, bg, lt, sp, ap);
|
||||
|
|
@ -5786,7 +5823,8 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
|
|||
break;
|
||||
case _stale_lu_index:
|
||||
case _enter_lu_pred:
|
||||
ipc = ipc->u.Ill.l1;
|
||||
sp = kill_clause(ipc, bg, lt, sp, ap);
|
||||
ipc = pop_path(&sp, cls, ap);
|
||||
break;
|
||||
/* instructions type l */
|
||||
case _try_me:
|
||||
|
|
@ -5802,7 +5840,6 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
|
|||
sp = push_path(sp, &(ipc->u.ld.d), cls);
|
||||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _retry_killed:
|
||||
case _profiled_trust_me:
|
||||
case _trust_me:
|
||||
case _count_trust_me:
|
||||
|
|
@ -6352,7 +6389,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
|
|||
ipc = NEXTOP(ipc,p);
|
||||
break;
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
|
|
@ -6367,7 +6403,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
|
|||
ipc = NEXTOP(ipc,ld);
|
||||
break;
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
#ifdef YAPOR
|
||||
CUT_prune_to(B->cp_b);
|
||||
#else
|
||||
|
|
@ -6406,7 +6441,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
|
|||
/* I am the last one using this clause, hence I don't need a lock
|
||||
to dispose of it
|
||||
*/
|
||||
Yap_RemoveLogUpdIndex(cl);
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
} else {
|
||||
UNLOCK(cl->ClLock);
|
||||
}
|
||||
|
|
@ -6418,7 +6453,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
|
|||
TR = --(B->cp_tr);
|
||||
/* next, recover space for the indexing code if it was erased */
|
||||
if (cl->ClFlags & ErasedMask) {
|
||||
Yap_RemoveLogUpdIndex(cl);
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
|
@ -7114,6 +7149,9 @@ find_caller(PredEntry *ap, yamop *code) {
|
|||
alt = NULL;
|
||||
}
|
||||
break;
|
||||
case _stale_lu_index:
|
||||
/* found myself */
|
||||
return NULL;
|
||||
default:
|
||||
if (alt == NULL) {
|
||||
Yap_Error(SYSTEM_ERROR,t,"Bug in Indexing Code");
|
||||
|
|
@ -7126,15 +7164,12 @@ find_caller(PredEntry *ap, yamop *code) {
|
|||
return NULL;
|
||||
}
|
||||
|
||||
static int vsc_clup;
|
||||
|
||||
yamop *
|
||||
Yap_CleanUpIndex(LogUpdIndex *blk)
|
||||
{
|
||||
PredEntry *ap;
|
||||
LogUpdIndex *pblk = blk->u.ParentIndex, *tblk;
|
||||
LogUpdIndex *pblk = blk, *tblk;
|
||||
|
||||
vsc_clup++;
|
||||
/* first, go up until findin'your pred */
|
||||
tblk = pblk;
|
||||
while (!(tblk->ClFlags & SwitchRootMask))
|
||||
|
|
@ -7146,21 +7181,31 @@ vsc_clup++;
|
|||
yamop **caller, *new;
|
||||
caller = find_caller(ap, blk->ClCode);
|
||||
while (TRUE) {
|
||||
*caller = new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE);
|
||||
new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE);
|
||||
/* will be null, if we are in the middle of the current block */
|
||||
if (new == NULL) {
|
||||
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FAILCODE;
|
||||
}
|
||||
} else {
|
||||
return new;
|
||||
}
|
||||
if (caller) {
|
||||
*caller = new;
|
||||
}
|
||||
return new;
|
||||
}
|
||||
} else {
|
||||
/* just compact the code */
|
||||
yamop *start = blk->ClCode, *codep = start->u.Ill.l1;
|
||||
yamop *start = blk->ClCode, *codep;
|
||||
op_numbers op = Yap_op_from_opcode(start->opc);
|
||||
|
||||
while (op == _jump_if_nonvar) {
|
||||
start = NEXTOP(start, xl);
|
||||
op = Yap_op_from_opcode(start->opc);
|
||||
}
|
||||
codep = start->u.Ill.l1;
|
||||
start->opc = Yap_opcode(_enter_lu_pred);
|
||||
start->u.Ill.l2 = cp_lu_trychain(codep, codep, blk->ClCode, REFRESH, ap, NULL, FALSE, blk, start->u.Ill.s, 0);
|
||||
start->u.Ill.l2 = cp_lu_trychain(codep, codep, start, REFRESH, ap, NULL, FALSE, blk, start->u.Ill.s, 0);
|
||||
return start;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -127,6 +127,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||
}
|
||||
#endif
|
||||
vsc_count++;
|
||||
if (vsc_count < 5319900)
|
||||
return;
|
||||
if (vsc_count == 5319949)
|
||||
vsc_xstop = 1;
|
||||
#ifdef COMMENTED
|
||||
// if (vsc_count == 218280)
|
||||
// vsc_xstop = 1;
|
||||
|
|
|
|||
|
|
@ -11,8 +11,11 @@
|
|||
* File: YapOpcodes.h *
|
||||
* comments: Central Table with all YAP opcodes *
|
||||
* *
|
||||
* Last rev: $Date: 2004-03-10 14:59:55 $ *
|
||||
* $Log: not supported by cvs2svn $ *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.21 2004/03/10 14:59:55 vsc
|
||||
* optimise -> for type tests
|
||||
* *
|
||||
* *
|
||||
*************************************************************************/
|
||||
OPCODE(Ystop ,e),
|
||||
|
|
@ -151,7 +154,7 @@
|
|||
OPCODE(trust ,ld),
|
||||
OPCODE(try_in ,l),
|
||||
OPCODE(jump_if_var ,l),
|
||||
OPCODE(jump_if_nonvar ,l),
|
||||
OPCODE(jump_if_nonvar ,xl),
|
||||
OPCODE(switch_on_cons ,ssl),
|
||||
OPCODE(switch_on_type ,llll),
|
||||
OPCODE(switch_list_nl ,ollll),
|
||||
|
|
@ -264,8 +267,6 @@
|
|||
OPCODE(alloc_for_logical_pred ,EC),
|
||||
OPCODE(unify_idb_term ,e),
|
||||
OPCODE(copy_idb_term ,e),
|
||||
OPCODE(retry_killed ,ld),
|
||||
OPCODE(trust_killed ,ld),
|
||||
#if THREADS
|
||||
OPCODE(thread_local ,e),
|
||||
#endif
|
||||
|
|
|
|||
54
H/absmi.h
54
H/absmi.h
|
|
@ -1092,60 +1092,6 @@ Macros to check the limits of stacks
|
|||
#define save_hb()
|
||||
#endif
|
||||
|
||||
|
||||
#if defined(SBA) || defined(MULTI_ASSIGNMENT_VARIABLES)
|
||||
#define trim_trail(B, TR, HBREG) (TR)
|
||||
#elif FROZEN_STACKS
|
||||
static inline tr_fr_ptr
|
||||
trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
|
||||
{
|
||||
tr_fr_ptr pt1, pt0;
|
||||
pt1 = tr;
|
||||
pt0 = TR = B->cp_tr;
|
||||
BEGD(d0);
|
||||
d0 = Unsigned(hbreg);
|
||||
while (pt0 < pt1) {
|
||||
BEGD(d1);
|
||||
if (IsVarTerm(d1 = TrailTerm(pt0))) {
|
||||
if (d1 < d0 || d1 > Unsigned(B)) {
|
||||
DO_TRAIL(d1, TrailVal(pt0));
|
||||
}
|
||||
pt0++;
|
||||
} else {
|
||||
if (!IsPairTerm(d1)) {
|
||||
DO_TRAIL(d1, TrailVal(pt0));
|
||||
}
|
||||
pt0++;
|
||||
}
|
||||
ENDD(d1);
|
||||
}
|
||||
ENDD(d0);
|
||||
return(TR);
|
||||
}
|
||||
#else
|
||||
static inline tr_fr_ptr
|
||||
trim_trail(choiceptr b, tr_fr_ptr tr, CELL *hbreg)
|
||||
{
|
||||
tr_fr_ptr pt1, pt0;
|
||||
pt1 = TR;
|
||||
pt0 = TR = B->cp_tr;
|
||||
BEGD(d0);
|
||||
d0 = Unsigned(HBREG);
|
||||
while (pt0 < pt1) {
|
||||
BEGD(d1);
|
||||
if (IsVarTerm(d1 = TrailTerm(pt0))) {
|
||||
if (d1 < d0 || d1 > Unsigned(B)) {
|
||||
DO_TRAIL(d1, TrailVal(pt0));
|
||||
}
|
||||
pt0++;
|
||||
}
|
||||
ENDD(d1);
|
||||
}
|
||||
ENDD(d0);
|
||||
return(TR);
|
||||
}
|
||||
#endif
|
||||
|
||||
#if IN_ABSMI_C || IN_UNIFY_C
|
||||
|
||||
static int
|
||||
|
|
|
|||
|
|
@ -292,9 +292,10 @@ Binding Macros for Multiple Assignment Variables.
|
|||
|
||||
************************************************************/
|
||||
|
||||
#define DO_MATRAIL(VP, OLDV, D) \
|
||||
{ TrailTerm(TR++) = OLDV; \
|
||||
TrailTerm(TR++) = AbsAppl(VP); \
|
||||
#define DO_MATRAIL(VP, OLDV, D) \
|
||||
{ TrailTerm(TR+1) = OLDV; \
|
||||
TrailTerm(TR) = TrailTerm(TR+2) = AbsAppl(VP); \
|
||||
TR += 2; \
|
||||
}
|
||||
|
||||
#define MATRAIL(VP,OLDV,D) if (OUTSIDE(HBREG,VP,B)) \
|
||||
|
|
@ -333,6 +334,7 @@ Binding Macros for Multiple Assignment Variables.
|
|||
|
||||
#define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
|
||||
|
||||
|
||||
#define MaBind(VP,D) { MATRAIL((VP),*(VP),(D)); *(VP) = (D); }
|
||||
|
||||
#if defined(__GNUC__) && defined(i386) && !defined(TERM_EXTENSIONS) && !defined(TABLING)
|
||||
|
|
|
|||
|
|
@ -173,7 +173,6 @@ wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
|
|||
void STD_PROTO(Yap_InitComma,(void));
|
||||
|
||||
/* cdmgr.c */
|
||||
void STD_PROTO(Yap_RemoveLogUpdIndex,(LogUpdIndex *));
|
||||
void STD_PROTO(Yap_IPred,(PredEntry *));
|
||||
void STD_PROTO(Yap_addclause,(Term,yamop *,int,Term));
|
||||
void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int));
|
||||
|
|
|
|||
|
|
@ -8,11 +8,12 @@
|
|||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: rheap.c *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $ *
|
||||
* *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
|
||||
|
|
@ -559,9 +560,7 @@ restore_opcodes(yamop *pc)
|
|||
case _retry_and_mark:
|
||||
case _try_clause:
|
||||
case _retry:
|
||||
case _retry_killed:
|
||||
case _trust:
|
||||
case _trust_killed:
|
||||
#ifdef YAPOR
|
||||
case _getwork:
|
||||
case _getwork_seq:
|
||||
|
|
|
|||
|
|
@ -9,9 +9,10 @@
|
|||
**************************************************************************
|
||||
* *
|
||||
* File: checker.yap *
|
||||
* Last rev: 8/2/88 *
|
||||
* mods: *
|
||||
* comments: style checker Prolog *
|
||||
* comments: style checker for Prolog *
|
||||
* *
|
||||
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $ *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
|
|
|
|||
Reference in New Issue