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
2004-03-19 11:35:42 +00:00
parent 5d79688b6b
commit 4242efb73f
11 changed files with 359 additions and 372 deletions

135
C/cdmgr.c
View File

@@ -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