small fixes on threaded implementation.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1700 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-10-10 14:08:17 +00:00
parent 7b29ef1552
commit 13080439a6
25 changed files with 1928 additions and 2302 deletions

654
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2006-09-28 16:15:54 $,$Author: vsc $ *
* Last rev: $Date: 2006-10-10 14:08:15 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.205 2006/09/28 16:15:54 vsc
* make GMPless version compile.
*
* Revision 1.204 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
@ -897,6 +900,135 @@ Yap_absmi(int inp)
GONext();
ENDOp();
BOp(profiled_retry_logical, lld);
check_trail(TR);
{
UInt timestamp;
CACHE_Y(B);
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.lld.t.s]);
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next instruction */
PREG=PREG->u.lld.n;
JMPNext();
}
restore_yaam_regs(PREG->u.lld.n);
restore_at_least_one_arg(PREG->u.lld.t.s);
LOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG->u.lld.d->ClPred->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG = PREG->u.lld.d->ClCode;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) 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();
}
JMPNext();
ENDBOp();
BOp(profiled_trust_logical, ld);
CACHE_Y(B);
{
LogUpdIndex *cl = PREG->u.lld.t.block;
PredEntry *ap = cl->ClPred;
LogUpdClause *lcl = PREG->u.lld.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next alternative */
PREG = FAILCODE;
} else {
PredEntry *pe = PREG->u.lld.d->ClPred;
LOCK(pe->StatisticsForPred.lock);
pe->StatisticsForPred.NOfRetries++;
UNLOCK(pe->StatisticsForPred.lock);
PREG = PREG->u.lld.d->ClCode;
}
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
TR = --(B->cp_tr);
/* actually get rid of the code */
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
UNLOCK(cl->ClLock);
if (PREG != FAILCODE) {
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
LOCK(lcl->ClLock);
if (lcl->ClRefCount == 1) {
/* make sure the clause isn't destroyed */
/* always add an extra reference */
INC_CLREF_COUNT(lcl);
TRAIL_CLREF(lcl);
}
UNLOCK(lcl->ClLock);
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr != B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
TR = --B->cp_tr;
/* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
if (PREG != FAILCODE) {
/* make sure we don't erase the clause we are jumping too */
if (lcl->ClRefCount == 1 && !(lcl->ClFlags & InUseMask)) {
lcl->ClFlags |= InUseMask;
TRAIL_CLREF(lcl);
}
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
}
}
#endif
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(ap->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#else
S_YREG++;
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(ap->ArityOfPE);
S_YREG--;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
JMPNext();
}
ENDBOp();
/*****************************************************************
* Call count instructions *
*****************************************************************/
@ -1055,6 +1187,163 @@ Yap_absmi(int inp)
PREG = NEXTOP(PREG, ld);
GONext();
ENDOp();
BOp(count_retry_logical, lld);
check_trail(TR);
{
UInt timestamp;
CACHE_Y(B);
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.lld.t.s]);
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next instruction */
PREG=PREG->u.lld.n;
JMPNext();
}
restore_yaam_regs(PREG->u.lld.n);
restore_at_least_one_arg(PREG->u.lld.t.s);
RetriesCounter--;
if (RetriesCounter == 0) {
saveregs();
Yap_Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0) {
saveregs();
Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
LOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG->u.lld.d->ClPred->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG = PREG->u.lld.d->ClCode;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) 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();
}
JMPNext();
ENDBOp();
BOp(count_trust_logical, ld);
CACHE_Y(B);
{
LogUpdIndex *cl = PREG->u.lld.t.block;
PredEntry *ap = cl->ClPred;
LogUpdClause *lcl = PREG->u.lld.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next alternative */
PREG = FAILCODE;
} else {
RetriesCounter--;
if (RetriesCounter == 0) {
saveregs();
Yap_Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
PredEntriesCounter--;
if (PredEntriesCounter == 0) {
saveregs();
Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
setregs();
JMPNext();
}
LOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG->u.lld.d->ClPred->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.lld.d->ClPred->StatisticsForPred.lock);
PREG = PREG->u.lld.d->ClCode;
}
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
TR = --(B->cp_tr);
/* actually get rid of the code */
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
UNLOCK(cl->ClLock);
if (PREG != FAILCODE) {
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
LOCK(lcl->ClLock);
if (lcl->ClRefCount == 1) {
/* make sure the clause isn't destroyed */
/* always add an extra reference */
INC_CLREF_COUNT(lcl);
TRAIL_CLREF(lcl);
}
UNLOCK(lcl->ClLock);
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr != B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
TR = --B->cp_tr;
/* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
if (PREG != FAILCODE) {
/* make sure we don't erase the clause we are jumping too */
if (lcl->ClRefCount == 1 && !(lcl->ClFlags & InUseMask)) {
lcl->ClFlags |= InUseMask;
TRAIL_CLREF(lcl);
}
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
}
}
#endif
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(ap->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#else
S_YREG++;
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(ap->ArityOfPE);
S_YREG--;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
JMPNext();
}
ENDBOp();
/*****************************************************************
* enter a logical semantics dynamic predicate *
@ -1091,137 +1380,6 @@ Yap_absmi(int inp)
ENDOp();
/* enter logical pred */
BOp(stale_lu_index, Ill);
{
yamop *ipc;
#if defined(YAPOR) || defined(THREADS)
PredEntry *pe = PREG->u.Ill.p;
#endif
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
saveregs();
#if defined(YAPOR) || defined(THREADS)
LOCK(pe->PELock);
if (PP) {
/* PP would be NULL for local preds */
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR;
UNLOCK(pe->PELock);
JMPNext();
}
#endif
ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
setregs();
UNLOCK(pe->PELock);
/* restart index */
if (ipc == NULL) FAIL();
PREG = ipc;
save_pc();
CACHE_A1();
JMPNext();
}
ENDBOp();
/* enter logical pred */
BOp(enter_lu_pred, Ill);
/* mark the indexing code */
{
LogUpdIndex *cl = PREG->u.Ill.I;
PREG = PREG->u.Ill.l1;
LOCK(cl->ClLock);
/* indicate the indexing code is being used */
#if defined(YAPOR) || defined(THREADS)
/* just store a reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
UNLOCK(cl->ClLock);
#if defined(YAPOR) || defined(THREADS)
if (PP) {
/* PP would be NULL for local preds */
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#endif
}
GONext();
ENDBOp();
/* trust a logical pred, that is, release the code */
BOp(trust_logical_pred, l);
/* unmark the indexing code */
/* mark the indexing code */
{
LogUpdIndex *cl = (LogUpdIndex *)PREG->u.l.l;
PREG = NEXTOP(PREG, l);
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
TR = --(B->cp_tr);
/* actually get rid of the code */
if (cl->ClRefCount == 0 && cl->ClFlags & ErasedMask) {
yamop *next = PREG->u.ld.d;
UNLOCK(cl->ClLock);
if (next != FAILCODE) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(next);
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
LOCK(lcl->ClLock);
if (lcl->ClRefCount == 1) {
/* make sure the clause isn't destroyed */
/* always add an extra reference */
INC_CLREF_COUNT(lcl);
TRAIL_CLREF(lcl);
}
UNLOCK(lcl->ClLock);
}
PREG = Yap_ErLogUpdIndex(cl, PREG);
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr != B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
TR = --B->cp_tr;
/* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & ErasedMask) {
yamop *next = PREG->u.ld.d;
if (next != FAILCODE) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(next);
/* make sure we don't erase the clause we are jumping too */
if (lcl->ClRefCount == 1 && !(lcl->ClFlags & InUseMask)) {
lcl->ClFlags |= InUseMask;
TRAIL_CLREF(lcl);
}
}
PREG = Yap_ErLogUpdIndex(cl, PREG);
save_pc();
}
}
#endif
}
GONext();
ENDBOp();
/* enter logical pred */
BOp(alloc_for_logical_pred, EC);
/* say that an environment is using this clause */
@ -1608,7 +1766,6 @@ Yap_absmi(int inp)
case _retry2:
case _retry3:
case _retry4:
case _trust_logical_pred:
ipc = NEXTOP(ipc,l);
go_on = TRUE;
break;
@ -1637,6 +1794,15 @@ Yap_absmi(int inp)
case _trust:
low_level_trace(retry_pred, ipc->u.ld.p, B->cp_args);
break;
case _try_logical:
case _retry_logical:
case _profiled_retry_logical:
case _count_retry_logical:
case _trust_logical:
case _profiled_trust_logical:
case _count_trust_logical:
low_level_trace(retry_pred, ipc->u.lld.d->ClPred, B->cp_args);
break;
case _Nstop:
case _Ystop:
low_level_trace(retry_pred, NULL, B->cp_args);
@ -1735,7 +1901,14 @@ Yap_absmi(int inp)
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl, NULL);
Yap_ErLogUpdIndex(cl);
setregs();
} else if (cl->ClFlags & DirtyMask) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_CleanUpIndex(cl);
setregs();
}
} else {
@ -1776,7 +1949,7 @@ Yap_absmi(int inp)
#else
ResetFlag(InUseMask, flags);
*pt1 = flags;
if (FlagOn(ErasedMask, flags)) {
if (FlagOn((ErasedMask|DirtyMask), flags)) {
if (FlagOn(DBClMask, flags)) {
saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
@ -1785,7 +1958,11 @@ Yap_absmi(int inp)
saveregs();
if (flags & LogUpdMask) {
if (flags & IndexMask) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1), NULL);
if (FlagOn(ErasedMask, flags)) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else {
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
}
} else {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
}
@ -1896,7 +2073,7 @@ Yap_absmi(int inp)
/* 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, NULL);
Yap_ErLogUpdIndex(cl);
setregs();
}
} else {
@ -1986,7 +2163,7 @@ Yap_absmi(int inp)
/* 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, NULL);
Yap_ErLogUpdIndex(cl);
setregs();
}
} else {
@ -7759,6 +7936,207 @@ Yap_absmi(int inp)
ENDBOp();
/************************************************************************\
* Logical Updates *
\************************************************************************/
/* enter logical pred */
BOp(enter_lu_pred, Ill);
/* mark the indexing code */
{
LogUpdIndex *cl = PREG->u.Ill.I;
PredEntry *ap = cl->ClPred;
if (ap->LastCallOfPred != LUCALL_EXEC) {
/*
only increment time stamp if we are working on current time
stamp
*/
ap->TimeStampOfPred++;
ap->LastCallOfPred = LUCALL_EXEC;
/* fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
}
*--YENV = MkIntegerTerm(ap->TimeStampOfPred);
/* fprintf(stderr,"> %p/%p %d %d\n",cl,ap,ap->TimeStampOfPred,PREG->u.Ill.s);*/
PREG = PREG->u.Ill.l1;
LOCK(cl->ClLock);
/* indicate the indexing code is being used */
#if defined(YAPOR) || defined(THREADS)
/* just store a reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
UNLOCK(cl->ClLock);
#if defined(YAPOR) || defined(THREADS)
if (PP) {
/* PP would be NULL for local preds */
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
#endif
}
GONext();
ENDBOp();
BOp(try_logical, lld);
check_trail(TR);
{
UInt timestamp;
CACHE_Y(YREG);
timestamp = IntegerOfTerm(S_YREG[0]);
/* fprintf(stderr,"+ %p/%p %d %d %d--%u\n",PREG,PREG->u.lld.d->ClPred,timestamp,PREG->u.lld.d->ClPred->TimeStampOfPred,PREG->u.lld.d->ClTimeStart,PREG->u.lld.d->ClTimeEnd);*/
/* Point AP to the code that follows this instruction */
/* always do this, even if we are not going to use it */
store_at_least_one_arg(PREG->u.lld.t.s);
store_yaam_regs(PREG->u.lld.n, 0);
set_cut(S_YREG, B);
B = B_YREG;
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next alternative */
PREG=PREG->u.lld.n;
} else {
PREG = PREG->u.lld.d->ClCode;
}
SET_BB(B_YREG);
ENDCACHE_Y();
}
JMPNext();
ENDBOp();
BOp(retry_logical, lld);
check_trail(TR);
{
UInt timestamp;
CACHE_Y(B);
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.lld.t.s]);
/* fprintf(stderr,"^ %p/%p %d %d %d--%u\n",PREG,PREG->u.lld.d->ClPred,timestamp,PREG->u.lld.d->ClPred->TimeStampOfPred,PREG->u.lld.d->ClTimeStart,PREG->u.lld.d->ClTimeEnd);*/
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next instruction */
PREG=PREG->u.lld.n;
JMPNext();
}
restore_yaam_regs(PREG->u.lld.n);
restore_at_least_one_arg(PREG->u.lld.t.s);
PREG = PREG->u.lld.d->ClCode;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) 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();
}
JMPNext();
ENDBOp();
BOp(trust_logical, ld);
CACHE_Y(B);
{
LogUpdIndex *cl = PREG->u.lld.t.block;
PredEntry *ap = cl->ClPred;
LogUpdClause *lcl = PREG->u.lld.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
/*fprintf(stderr,"- %p/%p %d %d %d--%u\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->u.lld.d->ClTimeStart,PREG->u.lld.d->ClTimeEnd);*/
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
/* jump to next alternative */
PREG = FAILCODE;
} else {
PREG = PREG->u.lld.d->ClCode;
}
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
TR = --(B->cp_tr);
/* actually get rid of the code */
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
UNLOCK(cl->ClLock);
if (PREG != FAILCODE) {
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
LOCK(lcl->ClLock);
if (lcl->ClRefCount == 1) {
/* make sure the clause isn't destroyed */
/* always add an extra reference */
INC_CLREF_COUNT(lcl);
TRAIL_CLREF(lcl);
}
UNLOCK(lcl->ClLock);
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr != B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
TR = --B->cp_tr;
/* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
if (PREG != FAILCODE) {
/* make sure we don't erase the clause we are jumping too */
if (lcl->ClRefCount == 1 && !(lcl->ClFlags & InUseMask)) {
lcl->ClFlags |= InUseMask;
TRAIL_CLREF(lcl);
}
}
if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl);
else
Yap_CleanUpIndex(cl);
save_pc();
}
}
#endif
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(ap->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#else
S_YREG++;
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(ap->ArityOfPE);
S_YREG--;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
JMPNext();
}
ENDBOp();
/************************************************************************\
* Indexing in ARG1 *

View File

@ -538,6 +538,8 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->OpcodeOfPred = UNDEF_OPCODE;
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
p->TimeStampOfPred = 0L;
p->LastCallOfPred = LUCALL_ASSERT;
if (cur_mod == TermProlog)
p->ModuleOfPred = 0L;
else
@ -595,6 +597,8 @@ Yap_NewThreadPred(PredEntry *ap)
p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
p->ModuleOfPred = ap->ModuleOfPred;
p->NextPredOfModule = NULL;
p->TimeStampOfPred = 0L;
p->LastCallOfPred = LUCALL_ASSERT;
INIT_LOCK(p->StatisticsForPred.lock);
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
@ -650,6 +654,8 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
p->TimeStampOfPred = 0L;
p->LastCallOfPred = LUCALL_ASSERT;
#ifdef TABLING
p->TableOfPred = NULL;
#endif /* TABLING */

View File

@ -142,6 +142,7 @@ AtomAdjust(Atom a)
#define PtoLocAdjust(P) (P)
#define PtoHeapCellAdjust(P) (P)
#define PtoOpAdjust(P) (P)
#define PtoLUClauseAdjust(P) (P)
#define PtoPredAdjust(P) (P)
#define PropAdjust(P) (P)
#define TrailAddrAdjust(P) (P)

160
C/amasm.c
View File

@ -11,8 +11,12 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2006-09-20 20:03:51 $ *
* Last rev: $Date: 2006-10-10 14:08:16 $ *
* $Log: not supported by cvs2svn $
* Revision 1.88 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
*
* Revision 1.87 2006/03/24 17:13:41 rslopes
* New update to BEAM engine.
* BEAM now uses YAP Indexing (JITI)
@ -174,7 +178,6 @@ STATIC_PROTO(Functor emit_f, (CELL));
STATIC_PROTO(CELL emit_c, (CELL));
STATIC_PROTO(COUNT emit_count, (CELL));
STATIC_PROTO(OPCODE emit_op, (op_numbers));
STATIC_PROTO(yamop *a_cl, (op_numbers, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_cle, (op_numbers, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_e, (op_numbers, yamop *, int));
STATIC_PROTO(yamop *a_ue, (op_numbers, op_numbers, yamop *, int));
@ -200,13 +203,13 @@ STATIC_PROTO(yamop *a_hx, (op_numbers, union clause_obj *, int, yamop *, int, st
STATIC_PROTO(yamop *a_if, (op_numbers, union clause_obj *, int, yamop *, int, struct intermediates *cip));
STATIC_PROTO(yamop *a_cut, (clause_info *,yamop *, int, struct intermediates *));
#ifdef YAPOR
STATIC_PROTO(yamop *a_try, (op_numbers, CELL, CELL, *clause_info, int, int, yamop *, int));
STATIC_PROTO(yamop *a_try, (op_numbers, CELL, CELL, int, int, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_either, (op_numbers, CELL, CELL, int, int, yamop *, int, struct intermediates *));
#else
STATIC_PROTO(yamop *a_try, (op_numbers, CELL, CELL, clause_info *, yamop *, int));
STATIC_PROTO(yamop *a_try, (op_numbers, CELL, CELL, yamop *, int, struct intermediates *));
STATIC_PROTO(yamop *a_either, (op_numbers, CELL, CELL, yamop *, int, struct intermediates *));
#endif /* YAPOR */
STATIC_PROTO(yamop *a_gl, (op_numbers, clause_info *, yamop *, int, struct PSEUDO *));
STATIC_PROTO(yamop *a_gl, (op_numbers, yamop *, int, struct PSEUDO *, struct intermediates *));
STATIC_PROTO(yamop *a_bfunc, (CELL, clause_info *, yamop *, int, struct intermediates *));
STATIC_PROTO(wamreg compile_cmp_flags, (char *));
STATIC_PROTO(yamop *a_igl, (CELL, op_numbers, yamop *, int, struct intermediates *));
@ -417,24 +420,12 @@ add_clref(CELL clause_code, int pass_no)
}
static yamop *
a_cl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = cip->code_addr;
}
GONEXT(l);
return code_p;
}
static yamop *
a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
a_lucl(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip, clause_info *cla)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.Ill.I = (LogUpdIndex *)cip->code_addr;
code_p->u.Ill.l1 = emit_ilabel(cip->cpc->rnd1, cip);
code_p->u.Ill.l2 = emit_ilabel(cip->cpc->rnd2, cip);
cip->current_try_lab = &code_p->u.Ill.l1;
code_p->u.Ill.s = cip->cpc->rnd3;
#if defined(YAPOR) || defined(THREADS)
code_p->u.Ill.p = cip->CurrentPred;
@ -1678,11 +1669,61 @@ a_cut(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip
static yamop *
#ifdef YAPOR
a_try(op_numbers opcode, CELL lab, CELL opr, clause_info *clinfo, int nofalts, int hascut, yamop *code_p, int pass_no)
a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *code_p, int pass_no, struct intermediates *cip)
#else
a_try(op_numbers opcode, CELL lab, CELL opr, clause_info *clinfo, yamop *code_p, int pass_no)
a_try(op_numbers opcode, CELL lab, CELL opr, yamop *code_p, int pass_no, struct intermediates *cip)
#endif /* YAPOR */
{
PredEntry *ap = cip->CurrentPred;
/* if predicates are logical do it in a different way */
if (ap->PredFlags & LogUpdatePredFlag) {
yamop *newcp;
/* emit a special instruction and then a label for backpatching */
if (pass_no) {
UInt size = (UInt)NEXTOP((yamop *)NULL,lld);
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
/* OOOPS, got in trouble, must do a longjmp and recover space */
save_machine_regs();
longjmp(cip->CompilerBotch,2);
}
if (opcode == try_op) {
/*
use the last n field to keep a chain with all
try-retry-trust
instructions allocated in this run
*/
newcp->u.lld.n = cip->try_instructions;
cip->try_instructions = newcp;
} else {
newcp->u.lld.n = *cip->current_try_lab;
*cip->current_try_lab = newcp;
}
if (opcode == _try_clause) {
newcp->opc = emit_op(_try_logical);
newcp->u.lld.t.s = emit_count(opr);
} else if (opcode == _retry) {
if (ap->PredFlags & CountPredFlag)
newcp->opc = emit_op(_count_retry_logical);
else if (ap->PredFlags & ProfiledPredFlag)
newcp->opc = emit_op(_profiled_retry_logical);
else
newcp->opc = emit_op(_retry_logical);
newcp->u.lld.t.s = emit_count(opr);
} else {
if (ap->PredFlags & CountPredFlag)
newcp->opc = emit_op(_count_trust_logical);
else if (ap->PredFlags & ProfiledPredFlag)
newcp->opc = emit_op(_profiled_trust_logical);
else
newcp->opc = emit_op(_trust_logical);
newcp->u.lld.t.block = (LogUpdIndex *)(cip->code_addr);
}
newcp->u.lld.d = ClauseCodeToLogUpdClause(emit_a(lab));
cip->current_try_lab = &(newcp->u.lld.n);
}
return code_p;
}
switch (opr) {
case 2:
if (opcode == _try_clause) {
@ -1737,15 +1778,15 @@ a_try(op_numbers opcode, CELL lab, CELL opr, clause_info *clinfo, yamop *code_p,
code_p->opc = emit_op(opcode);
code_p->u.ld.d = emit_a(lab);
code_p->u.ld.s = emit_count(opr);
code_p->u.ld.p = clinfo->CurrentPred;
code_p->u.ld.p = ap;
#ifdef TABLING
code_p->u.ld.te = clinfo->CurrentPred->TableOfPred;
code_p->u.ld.te = ap->TableOfPred;
#endif
#ifdef YAPOR
INIT_YAMOP_LTT(code_p, nofalts);
if (hascut)
PUT_YAMOP_CUT(code_p);
if (clinfo->CurrentPred->PredFlags & SequentialPredFlag)
if (ap->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p);
#endif /* YAPOR */
}
@ -1783,12 +1824,12 @@ a_either(op_numbers opcode, CELL opr, CELL lab, yamop *code_p, int pass_no, stru
}
static yamop *
a_gl(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct PSEUDO *cpc)
a_gl(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc, struct intermediates *cip)
{
#ifdef YAPOR
return a_try(opcode, cpc->rnd1, IPredArity, clinfo, cpc->rnd2 >> 1, cpc->rnd2 & 1, code_p, pass_no);
return a_try(opcode, cpc->rnd1, IPredArity, cpc->rnd2 >> 1, cpc->rnd2 & 1, code_p, pass_no, cip);
#else
return a_try(opcode, cpc->rnd1, IPredArity, clinfo, code_p, pass_no);
return a_try(opcode, cpc->rnd1, IPredArity, code_p, pass_no, cip);
#endif /* YAPOR */
}
@ -2548,11 +2589,11 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
}
#ifdef YAPOR
#define TRYCODE(G,P) a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no)
#define TABLE_TRYCODE(G) a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no)
#define TRYCODE(G,P) a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no, cip)
#define TABLE_TRYCODE(G) a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, cip->cpc->rnd2 >> 1, cip->cpc->rnd2 & 1, code_p, pass_no, cip)
#else
#define TRYCODE(G,P) a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, &clinfo, code_p, pass_no)
#define TABLE_TRYCODE(G) a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, &clinfo, code_p, pass_no)
#define TRYCODE(G,P) a_try((G), Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1], IPredArity, code_p, pass_no, cip)
#define TABLE_TRYCODE(G) a_try((G), (CELL)emit_ilabel(cip->cpc->rnd1, cip), IPredArity, code_p, pass_no, cip)
#endif /* YAPOR */
static yamop *
@ -2581,6 +2622,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
clinfo.dealloc_found = FALSE;
clinfo.commit_lab = 0L;
clinfo.CurrentPred = cip->CurrentPred;
cip->current_try_lab = NULL;
cip->try_instructions = NULL;
cmp_info.c_type = TYPE_XX;
cmp_info.cl_info = &clinfo;
do_not_optimise_uatom = FALSE;
@ -2597,22 +2640,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->luc.ClRefCount = 0;
cl_u->luc.ClPred = cip->CurrentPred;
cl_u->luc.ClSize = size;
/*
Support for timestamps, stalled for now.
if (cip->CurrentPred->PredFlags & ThreadLocalPredFlag) {
LOCK(LocalTimeStampLock);
cl_u->luc.ClTimeStart = LocalTimeStamp;
LocalTimeStamp++;
cl_u->luc.ClTimeEnd = LocalTimeStamp;
UNLOCK(LocalTimeStampLock);
} else {
LOCK(GlobalTimeStampLock);
cl_u->luc.ClTimeStart = GlobalTimeStamp;
GlobalTimeStamp++;
cl_u->luc.ClTimeEnd = GlobalTimeStamp;
UNLOCK(GlobalTimeStampLock);
/* Support for timestamps */
if (cip->CurrentPred->LastCallOfPred != LUCALL_ASSERT) {
++cip->CurrentPred->TimeStampOfPred;
/* fprintf(stderr,"+ %x--%d--%ul\n",cip->CurrentPred,cip->CurrentPred->TimeStampOfPred,cip->CurrentPred->ArityOfPE);*/
cip->CurrentPred->LastCallOfPred = LUCALL_ASSERT;
}
*/
cl_u->luc.ClTimeStart = cip->CurrentPred->TimeStampOfPred;
cl_u->luc.ClTimeEnd = ~0L;
if (*clause_has_blobsp) {
cl_u->luc.ClFlags |= HasBlobsMask;
}
@ -2655,14 +2690,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
*entry_codep = code_p;
if (tabled) {
#if TABLING
code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p,ld), IPredArity, &clinfo, code_p, pass_no);
code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p,ld), IPredArity, code_p, pass_no, cip);
#endif
}
if (dynamic) {
#ifdef YAPOR
code_p = a_try(_try_me, 0, IPredArity, &clinfo, 1, 0, code_p, pass_no);
code_p = a_try(_try_me, 0, IPredArity, 1, 0, code_p, pass_no, cip);
#else
code_p = a_try(_try_me, 0, IPredArity, &clinfo, code_p, pass_no);
code_p = a_try(_try_me, 0, IPredArity, code_p, pass_no, cip);
#endif /* YAPOR */
}
} else {
@ -2711,7 +2746,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
switch ((int) cip->cpc->op) {
#ifdef YAPOR
case sync_op:
code_p = a_try(_sync, cip->cpc->rnd1, cip->cpc->rnd2, 1, Zero, code_p);
code_p = a_try(_sync, cip->cpc->rnd1, cip->cpc->rnd2, 1, Zero, cip);
break;
#endif /* YAPOR */
#ifdef TABLING
@ -2719,7 +2754,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_n(_table_new_answer, (int) cip->cpc->rnd2, code_p, pass_no);
break;
case table_try_single_op:
code_p = a_gl(_table_try_single, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_table_try_single, code_p, pass_no, cip->cpc, cip);
break;
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
@ -2983,11 +3018,6 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = TRYCODE(_retry_me, _retry_me0);
break;
case trustme_op:
if (log_update &&
(assembling == ASSEMBLING_INDEX ||
assembling == ASSEMBLING_EINDEX)) {
code_p = a_cl(_trust_logical_pred, code_p, pass_no, cip);
}
#ifdef TABLING
if (tabled)
code_p = TABLE_TRYCODE(_table_trust_me);
@ -2996,15 +3026,18 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = TRYCODE(_trust_me, _trust_me0);
break;
case enter_lu_op:
code_p = a_lucl(_enter_lu_pred, code_p, pass_no, cip);
code_p = a_lucl(_enter_lu_pred, code_p, pass_no, cip, &clinfo);
break;
case try_op:
if (log_update) {
add_clref(cip->cpc->rnd1, pass_no);
}
#ifdef TABLING
if (tabled)
code_p = a_gl(_table_try, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_table_try, code_p, pass_no, cip->cpc, cip);
else
#endif
code_p = a_gl(_try_clause, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_try_clause, code_p, pass_no, cip->cpc, cip);
break;
case retry_op:
if (log_update) {
@ -3012,22 +3045,21 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
}
#ifdef TABLING
if (tabled)
code_p = a_gl(_table_retry, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_table_retry, code_p, pass_no, cip->cpc, cip);
else
#endif
code_p = a_gl(_retry, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_retry, code_p, pass_no, cip->cpc, cip);
break;
case trust_op:
if (log_update) {
add_clref(cip->cpc->rnd1, pass_no);
code_p = a_cl(_trust_logical_pred, code_p, pass_no, cip);
}
#ifdef TABLING
if (tabled)
code_p = a_gl(_table_trust, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_table_trust, code_p, pass_no, cip->cpc, cip);
else
#endif
code_p = a_gl(_trust, &clinfo, code_p, pass_no, cip->cpc);
code_p = a_gl(_trust, code_p, pass_no, cip->cpc, cip);
break;
case try_in_op:
code_p = a_il(cip->cpc->rnd1, _try_in, code_p, pass_no, cip);

112
C/cdmgr.c
View File

@ -11,8 +11,12 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
* Last rev: $Date: 2006-10-10 14:08:16 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.191 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
*
* Revision 1.190 2006/08/07 18:51:44 vsc
* fix garbage collector not to try to garbage collect when we ask for large
* chunks of stack in a single go.
@ -414,6 +418,14 @@ PredForChoicePt(yamop *p_code) {
case _retry_me:
case _trust_me:
return p_code->u.ld.p;
case _try_logical:
case _retry_logical:
case _trust_logical:
case _count_retry_logical:
case _count_trust_logical:
case _profiled_retry_logical:
case _profiled_trust_logical:
return p_code->u.lld.d->ClPred;
#ifdef TABLING
case _trie_retry_null:
case _trie_trust_null:
@ -457,7 +469,6 @@ PredForChoicePt(yamop *p_code) {
return p_code->u.p.p;
#endif /* YAPOR */
break;
case _trust_logical_pred:
case _count_retry_me:
case _retry_profiled:
case _retry2:
@ -537,6 +548,7 @@ static_in_use(PredEntry *p, int check_everything)
#define PtoPredAdjust(X) (X)
#define PtoOpAdjust(X) (X)
#define PtoLUClauseAdjust(P) (P)
#define XAdjust(X) (X)
#define YAdjust(X) (X)
#define AtomTermAdjust(X) (X)
@ -908,14 +920,29 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
case _count_trust_me:
ipc = NEXTOP(ipc,ld);
break;
case _try_logical:
case _retry_logical:
case _count_retry_logical:
case _profiled_retry_logical:
{
yamop *oipc = ipc;
decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code);
ipc = ipc->u.lld.n;
Yap_FreeCodeSpace((ADDR)oipc);
}
break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code);
Yap_FreeCodeSpace((ADDR)ipc);
return;
case _enter_lu_pred:
case _stale_lu_index:
if (ipc->u.Ill.s)
end = ipc->u.Ill.l2;
if (ipc->u.Ill.I->ClFlags & InUseMask)
return;
ipc = ipc->u.Ill.l1;
break;
case _try_in:
case _trust_logical_pred:
case _jump:
case _jump_if_var:
release_wcls(ipc->u.l.l, ecs);
@ -1002,13 +1029,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
return;
}
op = Yap_op_from_opcode(beg->opc);
if ((op == _enter_lu_pred ||
op == _stale_lu_index) &&
beg->u.Ill.l1 != beg->u.Ill.l2) {
end = beg->u.Ill.l2;
} else {
end = (yamop *)((CODEADDR)c+c->ClSize);
}
ipc = beg;
cleanup_dangling_indices(ipc, beg, end, suspend_code);
}
@ -1200,47 +1221,22 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap)
This predicate is supposed to be called with a
lock on the current predicate
*/
yamop *
Yap_ErLogUpdIndex(LogUpdIndex *clau, yamop *ipc)
void
Yap_ErLogUpdIndex(LogUpdIndex *clau)
{
LogUpdIndex *c = clau;
yamop *codep;
if (ipc) {
op_numbers op = Yap_op_from_opcode(ipc->opc);
codep = TrustLUCode;
if (op == _trust) {
codep->opc = ipc->opc;
codep->u.ld.s = ipc->u.ld.s;
codep->u.ld.p = ipc->u.ld.p;
codep->u.ld.d = ipc->u.ld.d;
#ifdef YAPOR
codep->u.ld.or_arg = ipc->u.ld.or_arg;
#endif /* YAPOR */
#ifdef TABLING
codep->u.ld.te = ipc->u.ld.te;
#endif /* TABLING */
} else {
Yap_Error(SYSTEM_ERROR,TermNil,"Expected To Find trust, found %d", op);
codep = ipc;
}
} else {
codep = NULL;
}
if (clau->ClFlags & ErasedMask) {
if (!c->ClRefCount) {
if (c->ClFlags & SwitchRootMask) {
kill_off_lu_block(clau, NULL, c->ClPred);
if (!clau->ClRefCount) {
if (clau->ClFlags & SwitchRootMask) {
kill_off_lu_block(clau, NULL, clau->ClPred);
} else {
kill_off_lu_block(clau, clau->ParentIndex, clau->ClPred);
}
}
/* otherwise, nothing I can do, I have been erased already */
return codep;
return;
}
if (c->ClFlags & SwitchRootMask) {
kill_first_log_iblock(clau, NULL, c->ClPred);
if (clau->ClFlags & SwitchRootMask) {
kill_first_log_iblock(clau, NULL, clau->ClPred);
} else {
#if defined(THREADS) || defined(YAPOR)
LOCK(clau->ParentIndex->ClLock);
@ -1256,7 +1252,6 @@ Yap_ErLogUpdIndex(LogUpdIndex *clau, yamop *ipc)
UNLOCK(clau->ParentIndex->ClLock);
#endif
}
return codep;
}
/* Routine used when wanting to remove the indexation */
@ -3701,8 +3696,17 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
pp = pc->u.ld.p;
pc = NEXTOP(pc,ld);
break;
case _try_logical:
case _retry_logical:
case _trust_logical:
case _count_retry_logical:
case _count_trust_logical:
case _profiled_retry_logical:
case _profiled_trust_logical:
pp = pc->u.lld.d->ClPred;
pc = pc->u.lld.n;
break;
case _enter_lu_pred:
case _stale_lu_index:
pc = pc->u.Ill.l2;
break;
/* instructions type p */
@ -3733,7 +3737,6 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
pp = pc->u.pp.p0;
pc = NEXTOP(pc,pp);
break;
case _trust_logical_pred:
case _jump:
case _move_back:
case _skip:
@ -4885,7 +4888,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
Terms[0] = th;
Terms[1] = tb;
Terms[2] = TermNil;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,l), cp_ptr);
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
/* don't do this!! I might have stored a choice-point and changed ASP
@ -5497,6 +5500,16 @@ p_choicepoint_info(void)
pe = UndefCode;
t = MkVarTerm();
break;
case _try_logical:
case _retry_logical:
case _trust_logical:
case _count_retry_logical:
case _count_trust_logical:
case _profiled_retry_logical:
case _profiled_trust_logical:
pe = ipc->u.lld.n->ClPred;
t = BuildActivePred(pe, cptr->cp_args);
break;
#endif /* TABLING */
case _or_else:
pe = ipc->u.sla.p0;
@ -5509,7 +5522,6 @@ p_choicepoint_info(void)
case _retry2:
case _retry3:
case _retry4:
case _trust_logical_pred:
pe = NULL;
t = TermNil;
ipc = NEXTOP(ipc,l);

View File

@ -1801,6 +1801,14 @@ new_lu_db_entry(Term t, PredEntry *pe)
cl->ClExt = NULL;
cl->ClPrev = cl->ClNext = NULL;
cl->ClSize = ((CODEADDR)&(x->Contents)-(CODEADDR)cl)+x->NOfCells*sizeof(CELL);
/* Support for timestamps */
if (pe->LastCallOfPred != LUCALL_ASSERT) {
++pe->TimeStampOfPred;
/* fprintf(stderr,"+ %x--%d--%ul\n",pe,pe->TimeStampOfPred,pe->ArityOfPE);*/
pe->LastCallOfPred = LUCALL_ASSERT;
}
cl->ClTimeStart = pe->TimeStampOfPred;
cl->ClTimeEnd = ~0L;
#if defined(YAPOR) || defined(THREADS)
INIT_LOCK(cl->ClLock);
INIT_CLREF_COUNT(cl);
@ -4009,6 +4017,20 @@ EraseLogUpdCl(LogUpdClause *clau)
/* we are holding a reference to the clause */
clau->ClRefCount++;
if (ap) {
/* mark it as erased */
if (ap->LastCallOfPred != LUCALL_RETRACT) {
if (ap->cs.p_code.NOfClauses > 1) {
++ap->TimeStampOfPred;
/* fprintf(stderr,"- %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
ap->LastCallOfPred = LUCALL_RETRACT;
} else {
/* OK, there's noone left */
ap->TimeStampOfPred = 0L;
/* fprintf(stderr,"- %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
ap->LastCallOfPred = LUCALL_ASSERT;
}
}
clau->ClTimeEnd = ap->TimeStampOfPred;
UNLOCK(clau->ClLock);
Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */

View File

@ -186,7 +186,7 @@ NewArena(UInt size, UInt arity, CELL *where)
{
Term t;
if (where == NULL) {
if (where == NULL || where == H) {
while (H+size > ASP-1024) {
if (!Yap_gcl(size*sizeof(CELL), arity, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
@ -827,7 +827,7 @@ FindGlobalEntry(Atom at)
GlobalEntry *pe = RepGlobalProp(p0);
if ( pe->KindOfPE == GlobalProperty
#if THREADS
&& pe->owner_id == current_thread
&& pe->owner_id == worker_id
#endif
) {
READ_UNLOCK(ae->ARWLock);
@ -853,7 +853,7 @@ GetGlobalEntry(Atom at)
GlobalEntry *pe = RepGlobalProp(p0);
if ( pe->KindOfPE == GlobalProperty
#if THREADS
&& pe->owner_id == current_thread
&& pe->owner_id == worker_id
#endif
) {
WRITE_UNLOCK(ae->ARWLock);
@ -865,7 +865,7 @@ GetGlobalEntry(Atom at)
INIT_RWLOCK(new->GRWLock);
new->KindOfPE = GlobalProperty;
#if THREADS
new->owner_id = current_thread;
new->owner_id = worker_id;
#endif
new->NextGE = GlobalVariables;
GlobalVariables = new;

View File

@ -1877,7 +1877,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
case _trust_logical_pred:
case _retry_profiled:
case _count_retry:
rtp = NEXTOP(rtp,l);
@ -2014,6 +2013,19 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _retry4:
nargs = 4;
break;
case _try_logical:
case _retry_logical:
case _count_retry_logical:
case _profiled_retry_logical:
/* mark timestamp */
nargs = rtp->u.lld.t.s+1;
break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
/* mark timestamp */
nargs = rtp->u.lld.d->ClPred->ArityOfPE+1;
break;
#ifdef DEBUG
case _retry_me:
case _trust_me:
@ -2296,7 +2308,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
if (erase) {
/* at this point,
no one is accessing the clause */
Yap_ErLogUpdIndex(indx, NULL);
Yap_ErLogUpdIndex(indx);
}
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0);
@ -2619,7 +2631,6 @@ sweep_choicepoints(choiceptr gc_B)
#endif
);
break;
case _trust_logical_pred:
case _retry_profiled:
case _count_retry:
rtp = NEXTOP(rtp,l);
@ -2801,6 +2812,18 @@ sweep_choicepoints(choiceptr gc_B)
}
break;
#endif /* TABLING */
case _try_logical:
case _retry_logical:
case _count_retry_logical:
case _profiled_retry_logical:
/* sweep timestamp */
sweep_b(gc_B, rtp->u.lld.t.s+1);
break;
case _trust_logical:
case _count_trust_logical:
case _profiled_trust_logical:
sweep_b(gc_B, rtp->u.lld.d->ClPred->ArityOfPE+1);
break;
case _retry2:
sweep_b(gc_B, 2);
break;

1590
C/index.c

File diff suppressed because it is too large Load Diff

View File

@ -1223,8 +1223,8 @@ InitCodes(void)
Yap_heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_heap_regs->atom_meta_call,4),PROLOG_MODULE));
Yap_heap_regs->pred_dollar_catch = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$catch"),3),PROLOG_MODULE));
Yap_heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$recorded_with_key"),3),PROLOG_MODULE));
Yap_heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause"),5),PROLOG_MODULE));
Yap_heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause"),4),PROLOG_MODULE));
Yap_heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause"),6),PROLOG_MODULE));
Yap_heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause0"),6),PROLOG_MODULE));
Yap_heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_static_clause"),5),PROLOG_MODULE));
Yap_heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,PROLOG_MODULE));
Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$handle_throw"),3),PROLOG_MODULE));

View File

@ -1624,13 +1624,16 @@ UnmarkTrEntries(void)
flags = *ent;
ResetFlag(InUseMask, flags);
*ent = flags;
if (FlagOn(ErasedMask, flags)) {
if (FlagOn((DirtyMask|ErasedMask), flags)) {
if (FlagOn(DBClMask, flags)) {
Yap_ErDBE(DBStructFlagsToDBStruct(ent));
} else {
if (flags & LogUpdMask) {
if (flags & IndexMask) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(ent), NULL);
if (FlagOn(ErasedMask, flags))
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(ent));
else
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(ent));
} else {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(ent));
}

View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2006-09-15 19:32:47 $,$Author: vsc $ *
* Last rev: $Date: 2006-10-10 14:08:17 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.109 2006/09/15 19:32:47 vsc
* ichanges for QSAR
*
* Revision 1.108 2006/09/01 20:14:42 vsc
* more fixes for global data-structures.
* statistics on atom space.
@ -2525,7 +2528,7 @@ p_statistics_atom_info(void)
for (i =0; i < AtomHashTableSize; i++) {
Atom catom;
READ_LOCK(HashChain[i].aeAERWLock);
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
if (catom != NIL) {
READ_LOCK(RepAtom(catom)->ARWLock);

View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.105 2006-09-20 20:03:51 vsc Exp $ *
* version: $Id: Heap.h,v 1.106 2006-10-10 14:08:17 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -165,10 +165,6 @@ typedef struct worker_local_struct {
struct global_entry *global_variables;
Term global_arena;
Term global_delay_arena;
UInt local_timestamp;
#if defined(YAPOR) || defined(THREADS)
lockvar local_timestamp_lock;
#endif
yamop trust_lu_code[3];
} worker_local;
@ -216,10 +212,6 @@ typedef struct various_codes {
worker_local wl[MAX_WORKERS];
#else
worker_local wl;
#endif
UInt global_timestamp;
#if defined(YAPOR) || defined(THREADS)
lockvar global_timestamp_lock;
#endif
#ifdef BEAM
yamop beam_retry_code;
@ -570,8 +562,6 @@ struct various_codes *Yap_heap_regs;
#define HeapMax Yap_heap_regs->heap_max
#define HeapTop Yap_heap_regs->heap_top
#define HeapLim Yap_heap_regs->heap_lim
#define GlobalTimeStamp Yap_heap_regs->global_timestamp
#define GlobalTimeStampLock Yap_heap_regs->global_timestamp_lock
#ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def
#define GETWORK (&(Yap_heap_regs->getwork_code))
@ -903,8 +893,6 @@ struct various_codes *Yap_heap_regs;
#define GlobalVariables Yap_heap_regs->WL.global_variables
#define GlobalArena Yap_heap_regs->WL.global_arena
#define GlobalDelayArena Yap_heap_regs->WL.global_delay_arena
#define LocalTimeStamp Yap_heap_regs->WL.local_timestamp
#define LocalTimeStampLock Yap_heap_regs->WL.local_timestamp_lock
#define profiling Yap_heap_regs->compiler_profiling
#define call_counting Yap_heap_regs->compiler_call_counting
#define compile_arrays Yap_heap_regs->compiler_compile_arrays

View File

@ -11,8 +11,12 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2006-09-20 20:03:51 $ *
* Last rev: $Date: 2006-10-10 14:08:17 $ *
* $Log: not supported by cvs2svn $
* Revision 1.39 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
*
* Revision 1.38 2006/04/27 14:13:24 rslopes
* *** empty log message ***
*
@ -245,6 +249,14 @@
OPCODE(retry4 ,l),
OPCODE(trust ,ld),
OPCODE(try_in ,l),
OPCODE(enter_lu_pred ,Ill),
OPCODE(try_logical ,lld),
OPCODE(retry_logical ,lld),
OPCODE(trust_logical ,lld),
OPCODE(count_retry_logical ,lld),
OPCODE(count_trust_logical ,lld),
OPCODE(profiled_retry_logical ,lld),
OPCODE(profiled_trust_logical ,lld),
OPCODE(jump_if_var ,l),
OPCODE(jump_if_nonvar ,xll),
OPCODE(switch_on_cons ,sssl),
@ -358,9 +370,6 @@
OPCODE(count_retry_and_mark ,ld),
OPCODE(lock_lu ,p),
OPCODE(unlock_lu ,e),
OPCODE(enter_lu_pred ,Ill),
OPCODE(stale_lu_index ,Ill),
OPCODE(trust_logical_pred ,l),
OPCODE(alloc_for_logical_pred ,EC),
OPCODE(unify_idb_term ,e),
OPCODE(copy_idb_term ,e),

View File

@ -603,6 +603,12 @@ typedef struct
#endif
} profile_data;
typedef enum {
LUCALL_EXEC,
LUCALL_ASSERT,
LUCALL_RETRACT
} timestamp_type;
typedef struct pred_entry
{
Prop NextOfPE; /* used to chain properties */
@ -642,6 +648,8 @@ typedef struct pred_entry
struct Predicates *beamTable;
#endif
Term ModuleOfPred; /* module for this definition */
UInt TimeStampOfPred;
timestamp_type LastCallOfPred;
/* This must be at an odd number of cells, otherwise it
will not be aligned on RISC machines */
profile_data StatisticsForPred; /* enable profiling for predicate */
@ -721,7 +729,8 @@ typedef enum
DBClMask = 0x0800, /* informs this is a data base structure */
LogUpdRuleMask = 0x0400, /* informs the code is for a log upd rule with env */
LogUpdMask = 0x0200, /* informs this is a logic update index. */
StaticMask = 0x0100 /* dealing with static predicates */
StaticMask = 0x0100, /* dealing with static predicates */
DirtyMask = 0x0080 /* LUIndices */
/* other flags belong to DB */
} dbentry_flags;

File diff suppressed because it is too large Load Diff

View File

@ -78,14 +78,19 @@ typedef struct logic_upd_clause {
struct logic_upd_clause *ClPrev, *ClNext;
/* parent pointer */
PredEntry *ClPred;
/*
support for timers, stalled for now.
UInt ClTimeStart, ClTimeEnd;
*/
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];
} LogUpdClause;
inline EXTERN int VALID_TIMESTAMP(UInt, struct logic_upd_clause *);
inline EXTERN int
VALID_TIMESTAMP(UInt timestamp, struct logic_upd_clause *cl)
{
return IN_BETWEEN(cl->ClTimeStart, timestamp, cl->ClTimeEnd);
}
typedef struct dynamic_clause {
/* A set of flags describing info on the clause */
CELL ClFlags;
@ -198,7 +203,7 @@ ClauseUnion *STD_PROTO(Yap_find_owner_index,(yamop *, PredEntry *));
/* dbase.c */
void STD_PROTO(Yap_ErCl,(DynamicClause *));
void STD_PROTO(Yap_ErLogUpdCl,(LogUpdClause *));
yamop *STD_PROTO(Yap_ErLogUpdIndex,(LogUpdIndex *, yamop *));
void STD_PROTO(Yap_ErLogUpdIndex,(LogUpdIndex *));
Int STD_PROTO(Yap_Recordz,(Atom, Term));
/* exec.c */
@ -207,7 +212,7 @@ Term STD_PROTO(Yap_cp_as_integer,(choiceptr));
/* index.c */
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *, UInt));
yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *, UInt));
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
void STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));

View File

@ -246,6 +246,8 @@ typedef struct intermediates {
yamop *expand_block;
UInt i_labelno;
/* for expanding code */
yamop **current_try_lab;
yamop *try_instructions;
union {
struct static_index *si;
struct logic_upd_index *lui;

View File

@ -12,8 +12,12 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
* Last rev: $Date: 2006-10-10 14:08:17 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.16 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
*
* Revision 1.15 2006/04/27 14:13:24 rslopes
* *** empty log message ***
*
@ -164,8 +168,18 @@ restore_opcodes(yamop *pc)
pc->u.ld.d = PtoOpAdjust(pc->u.ld.d);
pc = NEXTOP(pc,ld);
break;
case _try_logical:
case _retry_logical:
case _trust_logical:
case _count_retry_logical:
case _count_trust_logical:
case _profiled_retry_logical:
case _profiled_trust_logical:
pc->u.lld.n = PtoOpAdjust(pc->u.lld.n);
pc->u.lld.d = PtoLUClauseAdjust(pc->u.lld.d);
pc = pc->u.lld.n;
break;
case _enter_lu_pred:
case _stale_lu_index:
pc->u.Ill.I = (LogUpdIndex *)PtoOpAdjust((yamop *)(pc->u.Ill.I));
pc->u.Ill.l1 = PtoOpAdjust(pc->u.Ill.l1);
pc->u.Ill.l2 = PtoOpAdjust(pc->u.Ill.l2);
@ -190,7 +204,6 @@ restore_opcodes(yamop *pc)
pc->u.pp.p0 = PtoPredAdjust(pc->u.pp.p0);
pc = NEXTOP(pc,pp);
break;
case _trust_logical_pred:
case _jump:
case _move_back:
case _skip:

View File

@ -459,7 +459,16 @@ inline EXTERN yamop *PtoOpAdjust (yamop *);
inline EXTERN yamop *
PtoOpAdjust (yamop * ptr)
{
return (yamop *) (((yamop *) (CharP (ptr) + HDiff)));
return (yamop *) (CharP (ptr) + HDiff);
}
inline EXTERN struct logic_upd_clause *PtoLUClauseAdjust (struct logic_upd_clause *);
inline EXTERN struct logic_upd_clause *
PtoLUClauseAdjust (struct logic_upd_clause * ptr)
{
return (struct logic_upd_clause *) (CharP (ptr) + HDiff);
}

View File

@ -16,6 +16,7 @@
<h2>Yap-5.1.2:</h2>
<ul>
<li> FIXED: first cut at using timestamps with logical updates.</li>
<li> FIXED: indexing on doubles wasn't working properly.</li>
<li> FIXED: sending large lists of atomics to DB was very, very slow.</li>
<li> FIXED: make library_directory/1 better protected.</li>

433
configure vendored

File diff suppressed because it is too large Load Diff

View File

@ -890,7 +890,7 @@ AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(arpa/inet.h ctype.h direct.h dirent.h dlfcn.h)
AC_CHECK_HEADERS(errno.h fcntl.h)
AC_CHECK_HEADERS(fenv.h fpu_control.h ieeefp.h io.h limits.h)
AC_CHECK_HEADERS(malloc.h math.h memory.h)
AC_CHECK_HEADERS(malloc.h math.h memory.h mpi.h)
AC_CHECK_HEADERS(netdb.h netinet/in.h regex.h)
AC_CHECK_HEADERS(siginfo.h signal.h stdarg.h string.h stropts.h)
AC_CHECK_HEADERS(sys/conf.h sys/file.h)

View File

@ -8,8 +8,11 @@
* *
**************************************************************************
* *
* $Id: sys.c,v 1.28 2006-05-25 16:28:28 vsc Exp $ *
* $Id: sys.c,v 1.29 2006-10-10 14:08:17 vsc Exp $ *
* mods: $Log: not supported by cvs2svn $
* mods: Revision 1.28 2006/05/25 16:28:28 vsc
* mods: include thread_sleep functionality.
* mods:
* mods: Revision 1.27 2006/05/17 18:38:11 vsc
* mods: make system library use true file name
* mods:
@ -81,6 +84,9 @@
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#if HAVE_MATH_H
#include <math.h>
#endif
#if HAVE_UNISTD_H
#include <unistd.h>
#endif

View File

@ -329,19 +329,20 @@ clause(V,Q,R) :-
clause(M:P,Q,R)).
% just create a choice-point
'$do_log_upd_clause'(_,_,_,_,_).
'$do_log_upd_clause'(A,B,C,D,E) :-
% the 6th argument marks the time-stamp.
'$do_log_upd_clause'(_,_,_,_,_,_).
'$do_log_upd_clause'(A,B,C,D,E,_) :-
'$continue_log_update_clause'(A,B,C,D,E).
'$do_log_upd_clause'(_,_,_,_,_).
'$do_log_upd_clause'(_,_,_,_,_,_).
:- '$do_log_upd_clause'(_,_,_,_,_), !.
:- '$do_log_upd_clause'(_,_,_,_,_,_), !.
'$do_log_upd_clause'(_,_,_,_).
'$do_log_upd_clause'(A,B,C,D) :-
'$do_log_upd_clause0'(_,_,_,_,_,_).
'$do_log_upd_clause0'(A,B,C,D,_,_) :-
'$continue_log_update_clause'(A,B,C,D).
'$do_log_upd_clause'(_,_,_,_).
'$do_log_upd_clause0'(_,_,_,_,_,_).
:- '$do_log_upd_clause'(_,_,_,_), !.
:- '$do_log_upd_clause0'(_,_,_,_,_,_), !.
'$do_static_clause'(_,_,_,_,_).
'$do_static_clause'(A,B,C,D,E) :-