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

trim_trail for default machine

Browse Source 
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 2004-03-19 11:35:42 +00:00
parent 5d79688b6b
commit 4242efb73f
11 changed files with 359 additions and 372 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
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: 2004-03-10 14:59:54 $,$Author: vsc $ * * Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $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 * Revision 1.124 2004/03/08 19:31:01 vsc
* move to 4.5.3 * 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 /* I am the last one using this clause, hence I don't need a lock
to dispose of it to dispose of it
*/ */
Yap_RemoveLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
} else { } else {
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
} }
@ -1209,7 +1212,7 @@ Yap_absmi(int inp)
TR = --B->cp_tr; TR = --B->cp_tr;
/* next, recover space for the indexing code if it was erased */ /* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & ErasedMask) { if (cl->ClFlags & ErasedMask) {
Yap_RemoveLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
} }
} }
#endif #endif
@ -1627,9 +1630,7 @@ Yap_absmi(int inp)
case _retry_and_mark: case _retry_and_mark:
case _profiled_retry_and_mark: case _profiled_retry_and_mark:
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
low_level_trace(retry_pred, ipc->u.ld.p, B->cp_args); low_level_trace(retry_pred, ipc->u.ld.p, B->cp_args);
break; break;
case _Nstop: case _Nstop:
@ -1780,12 +1781,12 @@ Yap_absmi(int inp)
/* AbsAppl means */ /* AbsAppl means */
/* multi-assignment variable */ /* multi-assignment variable */
/* so the next cell is the old value */ /* so the next cell is the old value */
pt0--;
#if FROZEN_STACKS #if FROZEN_STACKS
pt[0] = TrailVal(pt0); pt[0] = TrailVal(pt0);
#else #else
pt[0] = TrailTerm(pt0); pt[0] = TrailTerm(pt0);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
pt0 -= 2;
goto failloop; goto failloop;
} }
#endif #endif
@ -1818,7 +1819,56 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(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); ENDD(d0);
GONext(); GONext();
@ -1843,7 +1893,7 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B); HBREG = PROTECT_FROZEN_H(B);
TR = trim_trail(B, TR, HBREG); goto trim_trail;
} }
ENDD(d0); ENDD(d0);
GONext(); GONext();
@ -1867,7 +1917,7 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(B); HBREG = PROTECT_FROZEN_H(B);
TR = trim_trail(B, TR, HBREG); goto trim_trail;
} }
ENDD(d0); ENDD(d0);
GONext(); GONext();
@ -1928,7 +1978,7 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0); HBREG = PROTECT_FROZEN_H(pt0);
TR = trim_trail(B, TR, HBREG); goto trim_trail;
} }
} }
ENDD(d0); ENDD(d0);
@ -1964,7 +2014,7 @@ Yap_absmi(int inp)
#endif /* TABLING */ #endif /* TABLING */
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
HBREG = PROTECT_FROZEN_H(pt0); HBREG = PROTECT_FROZEN_H(pt0);
TR = trim_trail(B, TR, HBREG); goto trim_trail;
} }
} }
ENDD(d0); ENDD(d0);
@ -6564,23 +6614,6 @@ Yap_absmi(int inp)
JMPNext(); JMPNext();
ENDBOp(); 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); BOp(retry, ld);
CACHE_Y(B); CACHE_Y(B);
restore_yaam_regs(NEXTOP(PREG, ld)); restore_yaam_regs(NEXTOP(PREG, ld));
@ -6597,34 +6630,6 @@ Yap_absmi(int inp)
JMPNext(); JMPNext();
ENDBOp(); 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); BOp(trust, ld);
CACHE_Y(B); CACHE_Y(B);
#ifdef YAPOR #ifdef YAPOR
@ -7641,10 +7646,11 @@ Yap_absmi(int inp)
abolish_incomplete_subgoals(B); abolish_incomplete_subgoals(B);
#endif /* TABLING */ #endif /* TABLING */
HBREG = PROTECT_FROZEN_H(B); HBREG = PROTECT_FROZEN_H(B);
TR = trim_trail(B, TR, HBREG); PREG = NEXTOP(PREG, xF);
goto trim_trail;
} }
ENDCHO(pt0);
PREG = NEXTOP(PREG, xF); PREG = NEXTOP(PREG, xF);
ENDCHO(pt0);
GONext(); GONext();
BEGP(pt1); BEGP(pt1);
@ -7688,7 +7694,8 @@ Yap_absmi(int inp)
abolish_incomplete_subgoals(B); abolish_incomplete_subgoals(B);
#endif /* TABLING */ #endif /* TABLING */
HBREG = PROTECT_FROZEN_H(B); HBREG = PROTECT_FROZEN_H(B);
TR = trim_trail(B, TR, HBREG); PREG = NEXTOP(PREG, yF);
goto trim_trail;
} }
PREG = NEXTOP(PREG, yF); PREG = NEXTOP(PREG, yF);
GONext(); GONext();

135
C/cdmgr.c
View File

@ -9,10 +9,11 @@
************************************************************************** **************************************************************************
* * * *
* File: cdmgr.c * * File: cdmgr.c *
* Last rev: 8/2/88 *
* mods: *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; 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(Int p_toggle_static_predicates_in_use, (void));
STATIC_PROTO(Atom YapConsultingFile, (void)); STATIC_PROTO(Atom YapConsultingFile, (void));
STATIC_PROTO(Int PredForCode,(yamop *, Atom *, UInt *, Term *)); STATIC_PROTO(Int PredForCode,(yamop *, Atom *, UInt *, Term *));
STATIC_PROTO(void kill_first_log_iblock,(LogUpdIndex *, LogUpdIndex *, PredEntry *));
#define PredArity(p) (p->ArityOfPE) #define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G,F,N) ( (N)<5 ? (op_numbers)((int)F+(N)*3) : G) #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); Term t = Deref(ARG1);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_plwrite(t, Yap_DebugPutc, 0);
} else if (IsIntegerTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f); Atom At = NameOfFunctor(f);
@ -289,9 +293,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
ipc = NEXTOP(ipc,p); ipc = NEXTOP(ipc,p);
break; break;
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
decrease_ref_counter(ipc->u.ld.d, beg, end, suspend_code); decrease_ref_counter(ipc->u.ld.d, beg, end, suspend_code);
ipc = NEXTOP(ipc,ld); ipc = NEXTOP(ipc,ld);
break; break;
@ -401,6 +403,48 @@ kill_static_child_indxs(StaticIndex *indx)
Yap_FreeCodeSpace((CODEADDR)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 static void
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) 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); LOCK(c->ClLock);
c->ClRefCount--; 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 (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
if (parent != NULL) { kill_off_lu_block(c, parent, ap);
/* 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);
} else { } else {
if (c->ClFlags & ErasedMask)
return;
c->ClFlags |= ErasedMask; c->ClFlags |= ErasedMask;
/* try to move up, so that we don't hold a switch table */ /* try to move up, so that we don't hold a switch table */
if (parent != NULL && if (parent != NULL &&
@ -498,6 +509,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
#endif #endif
UNLOCK(c->ClLock); UNLOCK(c->ClLock);
} }
} }
static void static void
@ -555,12 +567,21 @@ Yap_ErLogUpdIndex(LogUpdIndex *clau)
{ {
LogUpdIndex *c = clau; LogUpdIndex *c = clau;
if (clau->ClFlags & ErasedMask) { 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; return;
} }
if (c->ClFlags & SwitchRootMask) { if (c->ClFlags & SwitchRootMask) {
kill_first_log_iblock(clau, NULL, c->u.pred); kill_first_log_iblock(clau, NULL, c->u.pred);
} else { } else {
while (!(c->ClFlags & SwitchRootMask)) while (!(c->ClFlags & SwitchRootMask))
c = c->u.ParentIndex; c = c->u.ParentIndex;
#if defined(THREADS) || defined(YAPOR) #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 */ /* Routine used when wanting to remove the indexation */
/* ap is known to already have been locked for WRITING */ /* ap is known to already have been locked for WRITING */
static int static int

56
C/heapgc.c
View File

@ -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 */ /* reset the gc to believe the original tag */
TrailTerm(trail_ptr) = AbsAppl((CELL *)TrailTerm(trail_ptr)); TrailTerm(trail_ptr) = AbsAppl((CELL *)TrailTerm(trail_ptr));
} }
trail_ptr --; trail_ptr -= 2;
} else { } else {
tr_fr_ptr trp = (*lkp)-1; tr_fr_ptr trp = (*lkp)-1;
TrailTerm(trp) = TrailTerm(trail_ptr-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 #ifdef FROZEN_STACKS
RESET_VARIABLE(&TrailVal(trail_ptr)); RESET_VARIABLE(&TrailVal(trail_ptr));
#endif #endif
trail_ptr--;
RESET_VARIABLE(&TrailTerm(trail_ptr));
} }
} }
#endif #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))) { if (HEAP_PTR(TrailVal(trail_ptr))) {
mark_external_reference(&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))) { if (HEAP_PTR(TrailVal(trail_ptr-1))) {
mark_external_reference(&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 _retry_me4:
case _trust_me4: case _trust_me4:
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
nargs = rtp->u.ld.s; nargs = rtp->u.ld.s;
break; break;
default: default:
@ -2004,7 +1996,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
} }
#if MULTI_ASSIGNMENT_VARIABLES #if MULTI_ASSIGNMENT_VARIABLES
} else { } else {
CELL trail_cell = TrailTerm(trail_ptr); CELL trail_cell = TrailTerm(trail_ptr+2);
CELL *ptr; CELL *ptr;
CELL old = TrailTerm(trail_ptr+1); CELL old = TrailTerm(trail_ptr+1);
@ -2013,40 +2005,40 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
else else
ptr = RepAppl(trail_cell); ptr = RepAppl(trail_cell);
TrailTerm(dest) = old; TrailTerm(dest+1) = old;
TrailTerm(dest+1) = trail_cell; TrailTerm(dest+2) = TrailTerm(dest) = trail_cell;
if (MARKED(old)) { if (MARKED(old)) {
UNMARK(&TrailTerm(dest)); UNMARK(&TrailTerm(dest+1));
if (HEAP_PTR(old)) { if (HEAP_PTR(old)) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(old)); into_relocation_chain(&TrailTerm(dest+1), GET_NEXT(old));
} }
} }
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
TrailVal(dest) = TrailVal(trail_ptr); TrailVal(dest+1) = TrailVal(trail_ptr+1);
if (MARKED(TrailVal(dest))) { if (MARKED(TrailVal(dest+1))) {
UNMARK(&TrailVal(dest)); UNMARK(&TrailVal(dest+1));
if (HEAP_PTR(TrailVal(dest))) { if (HEAP_PTR(TrailVal(dest+1))) {
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailTerm(dest))); 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 #endif
dest++;
if (MARKED(trail_cell)) { if (MARKED(trail_cell)) {
UNMARK(&TrailTerm(dest)); UNMARK(&TrailTerm(dest));
UNMARK(&TrailTerm(dest+2));
if (HEAP_PTR(trail_cell)) { if (HEAP_PTR(trail_cell)) {
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell)); into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
into_relocation_chain(&TrailTerm(dest+2), GET_NEXT(trail_cell));
} }
} }
trail_ptr++; trail_ptr += 2;
#ifdef FROZEN_STACKS dest += 2;
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
#endif #endif
} }
trail_ptr++; trail_ptr++;

321
C/index.c
View File

@ -9,10 +9,11 @@
************************************************************************** **************************************************************************
* * * *
* File: index.c * * File: index.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -375,9 +376,7 @@ has_cut(yamop *pc)
case _retry_and_mark: case _retry_and_mark:
case _try_clause: case _try_clause:
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
#ifdef YAPOR #ifdef YAPOR
case _getwork: case _getwork:
case _getwork_seq: case _getwork_seq:
@ -1574,9 +1573,7 @@ add_info(ClauseDef *clause, UInt regno)
case _retry_and_mark: case _retry_and_mark:
case _try_clause: case _try_clause:
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
case _enter_lu_pred: case _enter_lu_pred:
case _stale_lu_index: case _stale_lu_index:
#ifdef YAPOR #ifdef YAPOR
@ -2595,12 +2592,17 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates
*/ */
if (first && if (first &&
cint->CurrentPred->PredFlags & LogUpdatePredFlag) { cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
UInt ncls;
labl_dyn0 = new_label(); labl_dyn0 = new_label();
if (clleft) if (clleft)
labl_dynf = labl_dyn0; labl_dynf = labl_dyn0;
else else
labl_dynf = new_label(); 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); Yap_emit(label_op, labl_dyn0, Zero, cint);
} }
if (c0 == cf) { if (c0 == cf) {
@ -2910,9 +2912,8 @@ emit_protection_choicepoint(int first, int clleft, UInt nxtlbl, struct intermedi
if (clleft) { if (clleft) {
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) { if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
UInt labl = new_label(); 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(label_op, labl, Zero, cint);
} }
Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint); Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint);
@ -3773,7 +3774,6 @@ expand_index(struct intermediates *cint) {
switch(op) { switch(op) {
case _try_clause: case _try_clause:
case _retry: case _retry:
case _retry_killed:
/* this clause had no indexing */ /* this clause had no indexing */
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
first = ClauseCodeToLogUpdClause(ipc->u.ld.d)->ClNext->ClCode; first = ClauseCodeToLogUpdClause(ipc->u.ld.d)->ClNext->ClCode;
@ -3827,7 +3827,6 @@ expand_index(struct intermediates *cint) {
stack[0].pos = 0; stack[0].pos = 0;
break; break;
case _trust: case _trust:
case _trust_killed:
/* we should never be here */ /* we should never be here */
Yap_Error(SYSTEM_ERROR, TermNil, "New indexing code"); Yap_Error(SYSTEM_ERROR, TermNil, "New indexing code");
labp = NULL; labp = NULL;
@ -4100,6 +4099,7 @@ expand_index(struct intermediates *cint) {
} else { } else {
max = install_clauses(cls, ap, stack, first, last); 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 */ /* don't count last clause if you don't have to */
if (alt && max->Code == last) max--; if (alt && max->Code == last) max--;
if (max < cls && labp != NULL) { if (max < cls && labp != NULL) {
@ -4222,6 +4222,8 @@ ExpandIndex(PredEntry *ap) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_plwrite(t, Yap_DebugPutc, 0);
} else if (IsIntegerTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f); Atom At = NameOfFunctor(f);
@ -4643,15 +4645,18 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp, PredEntry *a
{ {
LogUpdIndex *blk; LogUpdIndex *blk;
yamop *start; yamop *start;
op_numbers op = Yap_op_from_opcode(ipc->opc);
op_numbers op0; op_numbers op0;
while ((--sp)->flag != block_entry); while ((--sp)->flag != block_entry);
blk = (LogUpdIndex *)(sp->u.cle.block); blk = (LogUpdIndex *)(sp->u.cle.block);
start = blk->ClCode; start = blk->ClCode;
op0 = Yap_op_from_opcode(start->opc); op0 = Yap_op_from_opcode(start->opc);
if (sp->u.cle.entry_code == NULL || while (op0 == _jump_if_nonvar) {
(op0 != _enter_lu_pred && op0 != _stale_lu_index)) { 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); return kill_block(sp+1, ap);
} else { } else {
/* decrease number of clauses */ /* 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 _retry:
case _try_clause: case _try_clause:
/* kill block and replace by this single clause */ /* kill block and replace by this single clause */
if (!IN_BETWEEN(bg, codep->u.ld.d, lt)) { if (codep->u.ld.d != FAILCODE) {
path_stack_entry *nsp = sp; 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); while ((--nsp)->flag != block_entry);
*sp->u.cle.entry_code = codep->u.ld.d; *sp->u.cle.entry_code = codep->u.ld.d;
Yap_kill_iblock(sp->u.cle.block, nsp->u.cle.block, ap); 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); codep = NEXTOP(codep,ld);
} }
break; break;
case _retry_killed:
case _trust_killed:
codep = NEXTOP(codep, ld);
break;
case _trust_logical_pred: case _trust_logical_pred:
codep = NEXTOP(codep, l); codep = NEXTOP(codep, l);
break; 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 /* just mark the clause as dead and the code as unreachable, but
don't do anything else 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); 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; 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); 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 * 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) 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); op_numbers op = Yap_op_from_opcode(ocodep->opc);
switch (op) { switch (op) {
case _try_clause: case _try_clause:
case _retry:
if (ocodep->u.ld.d == FAILCODE) { if (ocodep->u.ld.d == FAILCODE) {
ocodep = NEXTOP(ocodep, ld); ocodep = NEXTOP(ocodep, ld);
break; break;
} }
do_retry: case _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 _trust: case _trust:
if (i < ncls-1) goto do_retry; {
do_trust: /* set up a try_clause */
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) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d); LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
LOCK(tgl->ClLock); if (tgl->ClFlags & ErasedMask) {
tgl->ClRefCount--; clean_ref_to_clause(tgl, op, compact_mode);
if (tgl->ClFlags & ErasedMask && ocodep = NEXTOP(ocodep, ld);
!(tgl->ClRefCount) && break;
!(tgl->ClFlags & InUseMask)) { } else if (i == 0) {
/* last ref to the clause */ codep->opc = Yap_opcode(_try_clause);
UNLOCK(tgl->ClLock); codep = copy_ld(codep, ocodep, ap, ocodep->u.ld.d, FALSE);
Yap_ErLogUpdCl(tgl); } 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 { } 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); ocodep = NEXTOP(ocodep, ld);
break; break;
case _trust_logical_pred: case _trust_logical_pred:
@ -4860,25 +4853,33 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
static yamop * static yamop *
replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has_cut) replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has_cut)
{ {
yamop *codep, *start, *ocodep = blk->ClCode->u.Ill.l1; yamop *begin = blk->ClCode, *codep, *start, *ocodep;
UInt ncls, xcls; yamop *nbegin;
UInt ncls, xcls, jnvs = 0;
UInt sz, i; UInt sz, i;
LogUpdIndex *ncl, *pcl; LogUpdIndex *ncl, *pcl;
int count_reds = ap->PredFlags & CountPredFlag; int count_reds = ap->PredFlags & CountPredFlag;
int profiled = ap->PredFlags & ProfiledPredFlag; 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 */ /* add half the current space plus 1, and also the extra clause */
if (flag == RECORDA || flag == RECORDZ) { if (flag == RECORDA || flag == RECORDZ) {
/* we are still introducing a clause */ /* we are still introducing a clause */
ncls = ++(blk->ClCode->u.Ill.s); ncls = ++(begin->u.Ill.s);
xcls = ncls+ncls/2+2; xcls = ncls+ncls/2+2;
} else { } else {
ncls = blk->ClCode->u.Ill.s; ncls = begin->u.Ill.s;
xcls = ncls; xcls = ncls;
} }
sz = sizeof(LogUpdIndex)+ sz = sizeof(LogUpdIndex)+
xcls*((UInt)NEXTOP((yamop *)NULL,ld))+ xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,l))+
(UInt)NEXTOP((yamop *)NULL,Ill)+ (UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p); (UInt)NEXTOP((yamop *)NULL,p);
if (count_reds) sz += xcls*((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; return NULL;
} }
ncl->ClFlags = LogUpdMask|IndexedPredFlag|IndexMask; 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->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; ncl->ClSize = sz;
INIT_LOCK(ncl->ClLock); INIT_LOCK(ncl->ClLock);
INIT_CLREF_COUNT(ncl); 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 */ /* ok, we've allocated and set up things, now let's finish */
codep->opc = Yap_opcode(_enter_lu_pred); 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->u.Ill.I = ncl;
codep = NEXTOP(codep,Ill); codep = NEXTOP(codep,Ill);
ocodep = begin->u.Ill.l1;
if (flag == RECORDA) { if (flag == RECORDA) {
int j; int j;
@ -4924,17 +4945,21 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
start->u.Ill.l1 = codep; start->u.Ill.l1 = codep;
i = 0; 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 */ /* the copying has been done */
start->u.Ill.l2 = codep; start->u.Ill.l2 = codep;
/* insert ourselves into chain */ /* insert ourselves into chain */
pcl = blk->u.ParentIndex; if (blk->ClFlags & SwitchRootMask) {
ncl->SiblingIndex = pcl->ChildIndex; Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
pcl->ChildIndex = ncl; } else {
/* we have a new pointer to our clause */ pcl = blk->u.ParentIndex;
pcl->ClRefCount++; ncl->SiblingIndex = pcl->ChildIndex;
if (!(blk->ClFlags & ErasedMask)) { pcl->ChildIndex = ncl;
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap); /* we have a new pointer to our clause */
pcl->ClRefCount++;
if (!(blk->ClFlags & ErasedMask)) {
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
}
} }
return start; return start;
} }
@ -4948,11 +4973,18 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
if (blk->ClFlags & InUseMask) { if (blk->ClFlags & InUseMask) {
/* make a new block */ /* make a new block */
yamop *new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE); yamop *new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE);
*jlbl = new; if (jlbl)
*jlbl = new;
return new; return new;
} else { } else {
/* work on the current block */ /* 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; 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); op_numbers op = Yap_op_from_opcode(blk->ClCode->opc);
yamop *end, *last, *where, *next; yamop *end, *last, *where, *next;
UInt bsize; UInt bsize;
yamop *begin = blk->ClCode;
/* make sure this is something I can work with */ /* 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 (op != _enter_lu_pred && op != _stale_lu_index) {
if (blk->ClFlags & SwitchRootMask) { if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap); Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
@ -4977,7 +5014,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
similar */ similar */
bsize = blk->ClSize; bsize = blk->ClSize;
end = (yamop *)((CODEADDR)blk+bsize); 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 */ next = NEXTOP(NEXTOP(where, ld),p); /* trust logical followed by trust */
last = PREVOP(last, ld); last = PREVOP(last, ld);
/* follow profiling and counting instructions */ /* 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 */ /* we got space to put something in */
LogUpdClause *tgl = ClauseCodeToLogUpdClause(code); 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) { if (blk->ClFlags & InUseMask) {
blk->ClCode->opc = Yap_opcode(_stale_lu_index); begin->opc = Yap_opcode(_stale_lu_index);
} else { } else {
/* we need to rebuild the code */ /* we need to rebuild the code */
/* first, shift the last retry down, getting rid of the trust logical pred */ /* 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 #ifdef TABLING
where->u.ld.te = last->u.ld.te; where->u.ld.te = last->u.ld.te;
#endif /* TABLING */ #endif /* TABLING */
blk->ClCode->u.Ill.l2 = NEXTOP(where,ld); begin->u.Ill.l2 = NEXTOP(where,ld);
blk->ClCode->u.Ill.s++; begin->u.Ill.s++;
tgl->ClRefCount++; tgl->ClRefCount++;
return blk->ClCode; return begin;
} else { } else {
return replace_lu_block(blk, RECORDZ, ap, code, has_cut(code)); 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); op_numbers op = Yap_op_from_opcode(blk->ClCode->opc);
yamop *start, *next, *here; yamop *start, *next, *here;
yamop *begin = blk->ClCode;
/* make sure this is something I can work with */ /* 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 (op != _enter_lu_pred && op != _stale_lu_index) {
if (blk->ClFlags & SwitchRootMask) { if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap); 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 /* ok, we are in a sequence of try-retry-trust instructions, or something
similar */ 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) { 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; here->u.ld.d = code;
return blk->ClCode; return begin;
} }
start = NEXTOP(blk->ClCode,Ill); start = NEXTOP(begin,Ill);
here = PREVOP(here, ld); here = PREVOP(here, ld);
/* follow profiling and counting instructions */ /* follow profiling and counting instructions */
if (ap->PredFlags & ProfiledPredFlag) { if (ap->PredFlags & ProfiledPredFlag) {
@ -5072,15 +5115,11 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
} }
if (here >= start) { if (here >= start) {
/* we got space to put something in */ /* we got space to put something in */
op_numbers sop = Yap_op_from_opcode(next->opc); LogUpdClause *tgl = ClauseCodeToLogUpdClause(next->u.ld.d);
if (sop != _retry_killed) { next->opc = Yap_opcode(_retry);
LogUpdClause *tgl = ClauseCodeToLogUpdClause(next->u.ld.d); tgl->ClRefCount++;
begin->u.Ill.l1 = here;
next->opc = Yap_opcode(_retry); begin->u.Ill.s++;
tgl->ClRefCount++;
}
blk->ClCode->u.Ill.l1 = here;
blk->ClCode->u.Ill.s++;
here->opc = Yap_opcode(_try_clause); here->opc = Yap_opcode(_try_clause);
here->u.ld.s = next->u.ld.s; here->u.ld.s = next->u.ld.s;
here->u.ld.p = ap; 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->opc = Yap_opcode(_retry_profiled);
here->u.p.p = ap; here->u.p.p = ap;
} }
return blk->ClCode; return begin;
} else { } else {
return replace_lu_block(blk, RECORDA, ap, code, has_cut(code)); 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); ipc = pop_path(&sp, cls, ap);
break; break;
case _retry: case _retry:
case _retry_killed:
/* this clause had no indexing */ /* this clause had no indexing */
ipc = NEXTOP(ipc,ld); ipc = NEXTOP(ipc,ld);
break; break;
@ -5257,7 +5295,6 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
ipc = NEXTOP(ipc, l); ipc = NEXTOP(ipc, l);
break; break;
case _trust: case _trust:
case _trust_killed:
sp = expandz_block(sp, ap, cls, group1, alt, cint); sp = expandz_block(sp, ap, cls, group1, alt, cint);
ipc = pop_path(&sp, cls, ap); ipc = pop_path(&sp, cls, ap);
break; break;
@ -5660,6 +5697,8 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0); Yap_plwrite(t, Yap_DebugPutc, 0);
} else if (IsIntegerTerm(t)) {
Yap_plwrite(t, Yap_DebugPutc, 0);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
Atom At = NameOfFunctor(f); 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: case _trust_logical_pred:
ipc = NEXTOP(ipc,l); ipc = NEXTOP(ipc,l);
break; break;
case _trust_killed:
ipc = NEXTOP(ipc, ld);
case _trust: case _trust:
if (IN_BETWEEN(bg,ipc->u.ld.d,lt)) { if (IN_BETWEEN(bg,ipc->u.ld.d,lt)) {
sp = kill_clause(ipc, bg, lt, sp, ap); 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; break;
case _stale_lu_index: case _stale_lu_index:
case _enter_lu_pred: case _enter_lu_pred:
ipc = ipc->u.Ill.l1; sp = kill_clause(ipc, bg, lt, sp, ap);
ipc = pop_path(&sp, cls, ap);
break; break;
/* instructions type l */ /* instructions type l */
case _try_me: 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); sp = push_path(sp, &(ipc->u.ld.d), cls);
ipc = NEXTOP(ipc,ld); ipc = NEXTOP(ipc,ld);
break; break;
case _retry_killed:
case _profiled_trust_me: case _profiled_trust_me:
case _trust_me: case _trust_me:
case _count_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); ipc = NEXTOP(ipc,p);
break; break;
case _retry: case _retry:
case _retry_killed:
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc); update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
if (lu_pred) if (lu_pred)
return lu_clause(ipc->u.ld.d); 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); ipc = NEXTOP(ipc,ld);
break; break;
case _trust: case _trust:
case _trust_killed:
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to(B->cp_b); CUT_prune_to(B->cp_b);
#else #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 /* I am the last one using this clause, hence I don't need a lock
to dispose of it to dispose of it
*/ */
Yap_RemoveLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
} else { } else {
UNLOCK(cl->ClLock); UNLOCK(cl->ClLock);
} }
@ -6418,7 +6453,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
TR = --(B->cp_tr); TR = --(B->cp_tr);
/* next, recover space for the indexing code if it was erased */ /* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & ErasedMask) { if (cl->ClFlags & ErasedMask) {
Yap_RemoveLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
} }
} }
#endif #endif
@ -7114,6 +7149,9 @@ find_caller(PredEntry *ap, yamop *code) {
alt = NULL; alt = NULL;
} }
break; break;
case _stale_lu_index:
/* found myself */
return NULL;
default: default:
if (alt == NULL) { if (alt == NULL) {
Yap_Error(SYSTEM_ERROR,t,"Bug in Indexing Code"); Yap_Error(SYSTEM_ERROR,t,"Bug in Indexing Code");
@ -7126,15 +7164,12 @@ find_caller(PredEntry *ap, yamop *code) {
return NULL; return NULL;
} }
static int vsc_clup;
yamop * yamop *
Yap_CleanUpIndex(LogUpdIndex *blk) Yap_CleanUpIndex(LogUpdIndex *blk)
{ {
PredEntry *ap; PredEntry *ap;
LogUpdIndex *pblk = blk->u.ParentIndex, *tblk; LogUpdIndex *pblk = blk, *tblk;
vsc_clup++;
/* first, go up until findin'your pred */ /* first, go up until findin'your pred */
tblk = pblk; tblk = pblk;
while (!(tblk->ClFlags & SwitchRootMask)) while (!(tblk->ClFlags & SwitchRootMask))
@ -7146,21 +7181,31 @@ vsc_clup++;
yamop **caller, *new; yamop **caller, *new;
caller = find_caller(ap, blk->ClCode); caller = find_caller(ap, blk->ClCode);
while (TRUE) { 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 (new == NULL) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FAILCODE; return FAILCODE;
} }
} else {
return new;
} }
if (caller) {
*caller = new;
}
return new;
} }
} else { } else {
/* just compact the code */ /* 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->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; return start;
} }
} }

4
C/tracer.c
View File

@ -127,6 +127,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
} }
#endif #endif
vsc_count++; vsc_count++;
if (vsc_count < 5319900)
return;
if (vsc_count == 5319949)
vsc_xstop = 1;
#ifdef COMMENTED #ifdef COMMENTED
// if (vsc_count == 218280) // if (vsc_count == 218280)
// vsc_xstop = 1; // vsc_xstop = 1;

11
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h * * File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes * * comments: Central Table with all YAP opcodes *
* * * *
* Last rev: $Date: 2004-03-10 14:59:55 $ * * Last rev: $Date: 2004-03-19 11:35:42 $ *
* $Log: not supported by cvs2svn $ * * $Log: not supported by cvs2svn $
* Revision 1.21 2004/03/10 14:59:55 vsc
* optimise -> for type tests
* *
* * * *
*************************************************************************/ *************************************************************************/
OPCODE(Ystop ,e), OPCODE(Ystop ,e),
@ -151,7 +154,7 @@
OPCODE(trust ,ld), OPCODE(trust ,ld),
OPCODE(try_in ,l), OPCODE(try_in ,l),
OPCODE(jump_if_var ,l), OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,l), OPCODE(jump_if_nonvar ,xl),
OPCODE(switch_on_cons ,ssl), OPCODE(switch_on_cons ,ssl),
OPCODE(switch_on_type ,llll), OPCODE(switch_on_type ,llll),
OPCODE(switch_list_nl ,ollll), OPCODE(switch_list_nl ,ollll),
@ -264,8 +267,6 @@
OPCODE(alloc_for_logical_pred ,EC), OPCODE(alloc_for_logical_pred ,EC),
OPCODE(unify_idb_term ,e), OPCODE(unify_idb_term ,e),
OPCODE(copy_idb_term ,e), OPCODE(copy_idb_term ,e),
OPCODE(retry_killed ,ld),
OPCODE(trust_killed ,ld),
#if THREADS #if THREADS
OPCODE(thread_local ,e), OPCODE(thread_local ,e),
#endif #endif

54
H/absmi.h
View File

@ -1092,60 +1092,6 @@ Macros to check the limits of stacks
#define save_hb() #define save_hb()
#endif #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 #if IN_ABSMI_C || IN_UNIFY_C
static int static int

8
H/amiops.h
View File

@ -292,9 +292,10 @@ Binding Macros for Multiple Assignment Variables.
************************************************************/ ************************************************************/
#define DO_MATRAIL(VP, OLDV, D) \ #define DO_MATRAIL(VP, OLDV, D) \
{ TrailTerm(TR++) = OLDV; \ { TrailTerm(TR+1) = OLDV; \
TrailTerm(TR++) = AbsAppl(VP); \ TrailTerm(TR) = TrailTerm(TR+2) = AbsAppl(VP); \
TR += 2; \
} }
#define MATRAIL(VP,OLDV,D) if (OUTSIDE(HBREG,VP,B)) \ #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 Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
#define MaBind(VP,D) { MATRAIL((VP),*(VP),(D)); *(VP) = (D); } #define MaBind(VP,D) { MATRAIL((VP),*(VP),(D)); *(VP) = (D); }
#if defined(__GNUC__) && defined(i386) && !defined(TERM_EXTENSIONS) && !defined(TABLING) #if defined(__GNUC__) && defined(i386) && !defined(TERM_EXTENSIONS) && !defined(TABLING)

1
H/clause.h
View File

@ -173,7 +173,6 @@ wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
void STD_PROTO(Yap_InitComma,(void)); void STD_PROTO(Yap_InitComma,(void));
/* cdmgr.c */ /* cdmgr.c */
void STD_PROTO(Yap_RemoveLogUpdIndex,(LogUpdIndex *));
void STD_PROTO(Yap_IPred,(PredEntry *)); void STD_PROTO(Yap_IPred,(PredEntry *));
void STD_PROTO(Yap_addclause,(Term,yamop *,int,Term)); void STD_PROTO(Yap_addclause,(Term,yamop *,int,Term));
void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int)); void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int));

9
H/rheap.h
View File

@ -8,11 +8,12 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: rheap.c * * File: rheap.h *
* Last rev: *
* mods: *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "@(#)rheap.c 1.3 3/15/90"; static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
@ -559,9 +560,7 @@ restore_opcodes(yamop *pc)
case _retry_and_mark: case _retry_and_mark:
case _try_clause: case _try_clause:
case _retry: case _retry:
case _retry_killed:
case _trust: case _trust:
case _trust_killed:
#ifdef YAPOR #ifdef YAPOR
case _getwork: case _getwork:
case _getwork_seq: case _getwork_seq:

7
pl/checker.yap
View File

@ -9,9 +9,10 @@
************************************************************************** **************************************************************************
* * * *
* File: checker.yap * * File: checker.yap *
* Last rev: 8/2/88 * * comments: style checker for Prolog *
* mods: * * *
* comments: style checker Prolog * * Last rev: $Date: 2004-03-19 11:35:42 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* * * *
*************************************************************************/ *************************************************************************/