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

fixes to support threads and assert correctly, even if inefficiently. 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2030 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2007-11-26 23:43:10 +00:00
parent 5941606d19
commit 3beda27d14
32 changed files with 813 additions and 860 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

262
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2007-11-08 15:52:15 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:07 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.230 2007/11/08 15:52:15 vsc
* fix some bugs in new dbterm code.
*
* Revision 1.229 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
@ -1042,26 +1045,24 @@ Yap_absmi(int inp)
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
LOCK(ap->PELock);
PP = ap;
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
B->cp_tr--;
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) {
saveregs();
@ -1073,8 +1074,6 @@ Yap_absmi(int inp)
setregs();
}
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
@ -1367,25 +1366,23 @@ Yap_absmi(int inp)
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
LOCK(ap->PELock);
PP = ap;
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) {
saveregs();
@ -1397,8 +1394,6 @@ Yap_absmi(int inp)
setregs();
}
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
@ -1462,16 +1457,13 @@ Yap_absmi(int inp)
/* only meaningful with THREADS on! */
/* lock logical updates predicate. */
Op(lock_lu, p);
Op(lock_lu, e);
#if defined(YAPOR) || defined(THREADS)
PP = PREG->u.p.p;
READ_LOCK(PP->PRWLock);
if (PP->cs.p_code.TrueCodeOfPred != PREG) {
PREG = PP->cs.p_code.TrueCodeOfPred;
READ_UNLOCK(PP->PRWLock);
PP = NULL;
if (PP) {
GONext();
}
PP = PREG->u.p.p;
LOCK(PP->PELock);
#endif
PREG = NEXTOP(PREG, p);
GONext();
@ -1480,13 +1472,11 @@ Yap_absmi(int inp)
/* only meaningful with THREADS on! */
/* lock logical updates predicate. */
Op(unlock_lu, e);
PREG = NEXTOP(PREG, e);
#if defined(YAPOR) || defined(THREADS)
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
UNLOCK(PP->PELock);
PP = NULL;
#endif
PREG = NEXTOP(PREG, e);
GONext();
ENDOp();
@ -1499,16 +1489,13 @@ Yap_absmi(int inp)
#if defined(YAPOR) || defined(THREADS)
{
LogUpdClause *cl = PREG->u.EC.ClBase;
PredEntry *ap = PREG->u.EC.p;
LOCK(cl->ClLock);
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
UNLOCK(ap->PELock);
PP = NULL;
}
#else
{
@ -1539,12 +1526,20 @@ Yap_absmi(int inp)
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
FAIL();
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gc(3, ENV, CP)) {
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
FAIL();
}
@ -1552,24 +1547,28 @@ Yap_absmi(int inp)
}
if (!Yap_IUnify(ARG2, t)) {
setregs();
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
setregs();
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
setregs();
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
UNLOCK(PP->PELock);
PP = NULL;
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
@ -1598,10 +1597,18 @@ Yap_absmi(int inp)
saveregs();
if (!Yap_IUnify(ARG2, cl->ClSource->Entry)) {
setregs();
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
setregs();
UNLOCK(PP->PELock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
setregs();
@ -1609,15 +1616,11 @@ Yap_absmi(int inp)
/* say that an environment is using this clause */
/* we have our own copy for the clause */
#if defined(YAPOR) || defined(THREADS)
LOCK(cl->ClLock);
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
if (PP) {
READ_UNLOCK(PP->PRWLock);
PP = NULL;
}
UNLOCK(PP->PELock);
PP = NULL;
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
@ -1638,18 +1641,15 @@ Yap_absmi(int inp)
ENDBOp();
/*****************************************************************
* try and retry of dynamic predicates *
*****************************************************************/
/* spy_or_trymark */
BOp(spy_or_trymark, ld);
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
LOCK(((PredEntry *)(PREG->u.ld.p))->PELock);
PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
UNLOCK(((PredEntry *)(PREG->u.ld.p))->PELock);
goto dospy;
ENDBOp();
@ -1661,13 +1661,17 @@ Yap_absmi(int inp)
/* The flags I check here should never change during execution */
CUT_wait_leftmost();
#endif /* YAPOR */
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
if (PREG->u.ld.p->PredFlags & LogUpdatePredFlag) {
LOCK(PREG->u.ld.p->PELock);
PP = PREG->u.ld.p;
}
if (PREG->u.ld.p->CodeOfPred != PREG) {
/* oops, someone changed the procedure under our feet,
fortunately this is no big deal because we haven't done
anything yet */
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
PP = NULL;
PREG = PREG->u.ld.p->CodeOfPred;
UNLOCK(PREG->u.ld.p->PELock);
/* for profiler */
save_pc();
JMPNext();
@ -1681,7 +1685,7 @@ Yap_absmi(int inp)
*/
LOCK(DynamicLock(PREG));
/* one can now mess around with the predicate */
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
UNLOCK(((PredEntry *)(PREG->u.ld.p))->PELock);
BEGD(d1);
d1 = PREG->u.ld.s;
store_args(d1);
@ -1741,11 +1745,11 @@ Yap_absmi(int inp)
CUT_wait_leftmost();
#endif /* YAPOR */
/* need to make the DB stable until I get the new clause */
READ_LOCK(PREG->u.ld.p->PRWLock);
LOCK(PREG->u.ld.p->PELock);
CACHE_Y(B);
PREG = PREG->u.ld.d;
LOCK(DynamicLock(PREG));
READ_UNLOCK(PREG->u.ld.p->PRWLock);
UNLOCK(PREG->u.ld.p->PELock);
restore_yaam_regs(PREG);
restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS
@ -1820,7 +1824,7 @@ Yap_absmi(int inp)
register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
READ_UNLOCK(PP->PRWLock);
UNLOCK(PP->PELock);
PP = NULL;
}
#endif
@ -2013,11 +2017,11 @@ Yap_absmi(int inp)
if (flags & IndexMask) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase;
PredEntry *ap = cl->ClPred;
LOCK(cl->ClLock);
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
saveregs();
/* at this point,
@ -2033,14 +2037,15 @@ Yap_absmi(int inp)
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
PredEntry *ap = cl->ClPred;
LOCK(cl->ClLock);
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
saveregs();
/* at this point,
@ -2049,11 +2054,12 @@ Yap_absmi(int inp)
Yap_ErLogUpdCl(cl);
setregs();
}
UNLOCK(ap->PELock);
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase;
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
@ -2193,12 +2199,12 @@ Yap_absmi(int inp)
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
PredEntry *ap = cl->ClPred;
LOCK(cl->ClLock);
LOCK(ap->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(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 */
@ -2209,6 +2215,7 @@ Yap_absmi(int inp)
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
@ -2294,11 +2301,10 @@ Yap_absmi(int inp)
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
LOCK(cl->ClLock);
LOCK(cl->ClPred->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (DirtyMask|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 */
@ -2309,6 +2315,7 @@ Yap_absmi(int inp)
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(cl->ClPred->PELock);
} else {
TrailTerm(pt0) = d1;
pt0++;
@ -2670,11 +2677,6 @@ Yap_absmi(int inp)
BOp(call, sla);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
extern long long int vsc_count;
if (vsc_count == 165491LL) {
fprintf(stderr,"%p:%p\n",PREG,PREG->u.sla.sla_u.p);
}
low_level_trace(enter_pred,PREG->u.sla.sla_u.p,XREGS+1);
}
#endif /* LOW_LEVEL_TRACER */
@ -2686,6 +2688,11 @@ Yap_absmi(int inp)
#ifndef NO_CHECKING
check_stack(NoStackCall, H);
#endif
if (pt->PredFlags & LogUpdatePredFlag) {
if (pt->OpcodeOfPred != LOCKPRED_OPCODE &&
pt->ModuleOfPred != IDB_MODULE && pt->OpcodeOfPred != UNDEF_OPCODE)
fprintf(stderr,"OOPS\n");
}
ENV = ENV_YREG;
/* Try to preserve the environment */
ENV_YREG = (CELL *) (((char *) ENV_YREG) + PREG->u.sla.s);
@ -7745,21 +7752,56 @@ Yap_absmi(int inp)
* support instructions *
\************************************************************************/
BOp(lock_pred, e);
#if defined(YAPOR) || defined(THREADS)
{
PredEntry *ap = PredFromDefCode(PREG);
LOCK(ap->PELock);
PP = ap;
if (!ap->cs.p_code.NOfClauses) {
FAIL();
}
/*
we do not lock access to the predicate,
we must take extra care here
*/
if (ap->cs.p_code.NOfClauses > 1 &&
!(ap->PredFlags & IndexedPredFlag)) {
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
saveregs();
Yap_IPred(ap, 0);
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
CACHE_A1();
/* for profiler */
save_pc();
}
PREG = ap->cs.p_code.TrueCodeOfPred;
}
#endif
JMPNext();
ENDBOp();
BOp(index_pred, e);
{
PredEntry *ap = PredFromDefCode(PREG);
WRITE_LOCK(ap->PRWLock);
#if defined(YAPOR) || defined(THREADS)
/*
we do not lock access to the predicate,
we must take extra care here
*/
if (!PP) {
LOCK(ap->PELock);
}
if (ap->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
WRITE_UNLOCK(ap->PRWLock);
JMPNext();
}
#endif
@ -7776,7 +7818,11 @@ Yap_absmi(int inp)
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
WRITE_UNLOCK(ap->PRWLock);
#if defined(YAPOR) || defined(THREADS)
if (!PP)
#endif
UNLOCK(ap->PELock);
}
JMPNext();
ENDBOp();
@ -7805,37 +7851,25 @@ Yap_absmi(int inp)
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
#if defined(YAPOR) || defined(THREADS)
if (PP == NULL) {
READ_LOCK(pe->PRWLock);
PP = pe;
if (!PP) {
LOCK(pe->PELock);
}
LOCK(pe->PELock);
if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR;
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
}
UNLOCK(pe->PELock);
if (!PP)
UNLOCK(pe->PELock);
JMPNext();
}
#endif
saveregs();
{
static yamop *opppp;
opppp= PREG;
}
pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */
setregs();
UNLOCK(pe->PELock);
PREG = pt0;
#if defined(YAPOR) || defined(THREADS)
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
}
if (!PP)
#endif
UNLOCK(pe->PELock);
JMPNext();
}
ENDBOp();
@ -7852,17 +7886,13 @@ Yap_absmi(int inp)
}
#if defined(YAPOR) || defined(THREADS)
if (PP == NULL) {
READ_LOCK(pe->PRWLock);
PP = pe;
LOCK(pe->PELock);
}
LOCK(pe->PELock);
if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR;
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
if (!PP) {
UNLOCK(pe->PELock);
}
UNLOCK(pe->PELock);
JMPNext();
}
#endif
@ -7873,9 +7903,8 @@ Yap_absmi(int inp)
UNLOCK(pe->PELock);
PREG = pt0;
#if defined(YAPOR) || defined(THREADS)
if (pe->PredFlags & (ThreadLocalPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
PP = NULL;
if (!PP) {
UNLOCK(pe->PELock);
}
#endif
JMPNext();
@ -7887,14 +7916,16 @@ Yap_absmi(int inp)
{
PredEntry *pe = PredFromDefCode(PREG);
BEGD(d0);
READ_LOCK(pe->PRWLock);
/* avoid trouble with undefined dynamic procedures */
if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
READ_UNLOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
UNLOCK(pe->PELock);
FAIL();
}
d0 = pe->ArityOfPE;
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
if (d0 == 0) {
H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
}
@ -7953,7 +7984,7 @@ Yap_absmi(int inp)
{
PredEntry *pe = PredFromDefCode(PREG);
BEGD(d0);
WRITE_LOCK(pe->PRWLock);
LOCK(pe->PELock);
if (!(pe->PredFlags & IndexedPredFlag) &&
pe->cs.p_code.NOfClauses > 1) {
/* update ASP before calling IPred */
@ -7966,7 +7997,7 @@ Yap_absmi(int inp)
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
}
WRITE_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
d0 = pe->ArityOfPE;
/* save S for ModuleName */
if (d0 == 0) {
@ -8244,7 +8275,6 @@ Yap_absmi(int inp)
*--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 */
@ -8255,14 +8285,6 @@ Yap_absmi(int inp)
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();
@ -8304,6 +8326,10 @@ Yap_absmi(int inp)
UInt timestamp;
CACHE_Y(B);
#if defined(YAPOR) || defined(THREADS)
PP = PREG->u.lld.d->ClPred;
#endif
LOCK(PP->PELock);
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)) {
@ -8335,28 +8361,29 @@ Yap_absmi(int inp)
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
/* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->u.lld.d->ClCode);*/
LOCK(ap->PELock);
if (!VALID_TIMESTAMP(timestamp, lcl)) {
/* jump to next alternative */
PREG = FAILCODE;
} else {
PREG = lcl->ClCode;
#if defined(YAPOR) || defined(THREADS)
PP = ap;
#endif
}
/* 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 */
B->cp_tr--;
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 */
@ -8364,7 +8391,6 @@ Yap_absmi(int inp)
TRAIL_CLREF(lcl);
B->cp_tr = TR;
}
UNLOCK(lcl->ClLock);
}
if (cl->ClFlags & ErasedMask) {
saveregs();
@ -8376,8 +8402,6 @@ Yap_absmi(int inp)
setregs();
}
save_pc();
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&

3
C/adtdefs.c
View File

@ -637,7 +637,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
fe->PropsOfFE = AbsPredProp(p);
p->NextOfPE = NIL;
}
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = fe->ArityOfFE;
@ -692,7 +691,6 @@ Yap_NewThreadPred(PredEntry *ap)
{
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = ap->ArityOfPE;
@ -742,7 +740,6 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
/* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(cur_mod))->StrOfAE, ae->StrOfAE); */
INIT_RWLOCK(p->PRWLock);
INIT_LOCK(p->PELock);
p->KindOfPE = PEProp;
p->ArityOfPE = 0;

20
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2007-11-07 09:25:27 $ *
* Last rev: $Date: 2007-11-26 23:43:07 $ *
* $Log: not supported by cvs2svn $
* Revision 1.97 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
* Revision 1.96 2007/11/06 17:02:09 vsc
* compile ground terms away.
*
@ -481,6 +484,9 @@ a_cle(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
code_p->u.EC.ClENV = 0;
code_p->u.EC.ClRefs = 0;
code_p->u.EC.ClBase = cl;
#if defined(THREADS) || defined(YAPOR)
code_p->u.EC.p = cip->CurrentPred;
#endif
cl->ClExt = code_p;
cl->ClFlags |= LogUpdRuleMask;
}
@ -2821,16 +2827,6 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
}
code_p = cl_u->lui.ClCode;
*entry_codep = code_p;
#if defined(YAPOR) || defined(THREADS)
if (assembling == ASSEMBLING_INDEX &&
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag)) {
if (pass_no) {
code_p->opc = opcode(_lock_lu);
code_p->u.p.p = cip->CurrentPred;
}
GONEXT(p);
}
#endif
} else {
if (pass_no) {
cl_u->si.ClSize = size;
@ -3114,7 +3110,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
else
if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag))
code_p = a_e(_unlock_lu, code_p, pass_no);
code_p = a_e(_unlock_lu, code_p, pass_no);
#endif
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
#ifdef YAPOR

2
C/analyst.c
View File

@ -270,6 +270,7 @@ p_show_op_counters()
print_instruction(_pop_n);
print_instruction(_trust_fail);
print_instruction(_index_pred);
print_instruction(_lock_pred);
#if THREADS
print_instruction(_thread_local);
#endif
@ -632,6 +633,7 @@ p_show_ops_by_group(void)
Yap_opcount[_Ystop] +
Yap_opcount[_Nstop] +
Yap_opcount[_index_pred] +
Yap_opcount[_lock_pred] +
#if THREADS
Yap_opcount[_thread_local] +
#endif

658
C/cdmgr.c
View File

File diff suppressed because it is too large Load Diff

63
C/compiler.c
View File

@ -11,8 +11,11 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2007-11-06 17:02:11 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.85 2007/11/06 17:02:11 vsc
* compile ground terms away.
*
* Revision 1.84 2007/03/27 13:48:51 vsc
* fix number of overflows (comments by Bart Demoen).
*
@ -722,12 +725,12 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
pop_code(level, cglobs);
}
} else if (IsRefTerm(t)) {
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) {
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
FAIL("can not compile data base reference",TYPE_ERROR_CALLABLE,t);
} else {
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
cglobs->hasdbrefs = TRUE;
if (level == 0)
Yap_emit((cglobs->onhead ? get_atom_op : put_atom_op), (CELL) t, argno, &cglobs->cint);
@ -1385,14 +1388,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
return;
@ -1406,7 +1409,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
/* never a problem here with a -> b, !, c ; d */
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) {
Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint);
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
@ -1417,7 +1420,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit_3ops(cutexit_op, Zero, Zero, Zero, &cglobs->cint);
}
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
else {
@ -1454,14 +1457,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(label_op, l2, Zero, &cglobs->cint);
if (cglobs->onlast) {
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
else
@ -1687,14 +1690,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
return;
@ -1711,14 +1714,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
return;
@ -1739,14 +1742,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
return;
@ -1820,14 +1823,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
return;
@ -1855,14 +1858,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
}
@ -1884,14 +1887,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
cglobs->or_found = TRUE;
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
}
@ -1899,7 +1902,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) {
cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint);
@ -1909,7 +1912,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
#endif /* TABLING */
Yap_emit(execute_op, (CELL) p0, Zero, &cglobs->cint);
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
else {
@ -2695,7 +2698,7 @@ c_layout(compiler_struct *cglobs)
cglobs->cint.cpc->op = nop_op;
} else {
#ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock);
LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred))
cglobs->cint.cpc->op = nop_op;
else
@ -2703,7 +2706,7 @@ c_layout(compiler_struct *cglobs)
if (cglobs->goalno == 1 && !cglobs->or_found && nperm == 0)
cglobs->cint.cpc->op = nop_op;
#ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock);
UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif
}
break;
@ -3243,7 +3246,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
cglobs.cint.CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head),mod));
}
/* insert extra instructions to count calls */
READ_LOCK(cglobs.cint.CurrentPred->PRWLock);
LOCK(cglobs.cint.CurrentPred->PELock);
if ((cglobs.cint.CurrentPred->PredFlags & ProfiledPredFlag) ||
(PROFILING && (cglobs.cint.CurrentPred->cs.p_code.FirstClause == NIL))) {
profiling = TRUE;
@ -3256,7 +3259,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
profiling = FALSE;
call_counting = FALSE;
}
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock);
UNLOCK(cglobs.cint.CurrentPred->PELock);
}
cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue));
/* phase 1 : produce skeleton code and variable information */
@ -3265,14 +3268,14 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
if (cglobs.is_a_fact && !cglobs.vtable) {
#ifdef TABLING
READ_LOCK(cglobs.cint.CurrentPred->PRWLock);
LOCK(cglobs.cint.CurrentPred->PELock);
if (is_tabled(cglobs.cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs.cint.CurrentPred->ArityOfPE, &cglobs.cint);
else
#endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs.cint);
#ifdef TABLING
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock);
UNLOCK(cglobs.cint.CurrentPred->PELock);
#endif
/* ground term, do not need much more work */
if (cglobs.cint.BlobsStart != NULL) {

9
C/computils.c
View File

@ -11,8 +11,11 @@
* File: computils.c *
* comments: some useful routines for YAP's compiler *
* *
* Last rev: $Date: 2007-11-06 17:02:12 $ *
* Last rev: $Date: 2007-11-26 23:43:08 $ *
* $Log: not supported by cvs2svn $
* Revision 1.31 2007/11/06 17:02:12 vsc
* compile ground terms away.
*
* Revision 1.30 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
@ -666,6 +669,10 @@ static char *opformat[] =
"fetch_reg1_reg2\t%N,%N",
"fetch_constant_reg\t%l,%N",
"fetch_reg_constant\t%l,%N",
"fetch_constant_reg\t%l,%N",
"fetch_reg_constant\t%l,%N",
"fetch_integer_reg\t%d,%N",
"fetch_reg_integer\t%d,%N",
"function_to_var\t%v,%B",
"function_to_al\t%v,%B",
"enter_profiling\t\t%g",

353
C/dbase.c
View File

File diff suppressed because it is too large Load Diff

18
C/errors.c
View File

@ -67,12 +67,12 @@ legal_env (CELL *ep)
return (FALSE);
ps = *((CELL *) (Addr (cp) - CellSize));
pe = (PredEntry *) (ps - sizeof (OPREG) - sizeof (Prop));
READ_LOCK(pe->PRWLock);
LOCK(pe->PELock);
if (!ONHEAP (pe) || Unsigned (pe) & 3 || pe->KindOfPE & 0xff00) {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
return (FALSE);
}
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
return (TRUE);
}
@ -100,9 +100,9 @@ DumpActiveGoals (void)
pe = EnvPreg(cp);
if (!ONHEAP (pe) || Unsigned (pe) & (sizeof(CELL)-1))
break;
READ_LOCK(pe->PRWLock);
LOCK(pe->PELock);
if (pe->KindOfPE & 0xff00) {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
break;
}
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag))
@ -110,7 +110,7 @@ DumpActiveGoals (void)
Functor f;
Term mod = TermProlog;
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
f = pe->FunctorOfPred;
if (pe->KindOfPE && hidden (NameOfFunctor (f)))
goto next;
@ -128,7 +128,7 @@ DumpActiveGoals (void)
}
Yap_DebugPutc (Yap_c_error_stream,'\n');
} else {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
}
next:
ep = (CELL *) ep[E_E];
@ -142,7 +142,7 @@ DumpActiveGoals (void)
if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL)
break;
pe = Yap_PredForChoicePt(b_ptr);
READ_LOCK(pe->PRWLock);
LOCK(pe->PELock);
{
Functor f;
Term mod = PROLOG_MODULE;
@ -168,7 +168,7 @@ DumpActiveGoals (void)
}
Yap_DebugPutc (Yap_c_error_stream,'\n');
}
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
b_ptr = b_ptr->cp_b;
}
}

14
C/exec.c
View File

@ -57,12 +57,11 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
READ_LOCK(pen->PRWLock);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0)) {
READ_UNLOCK(pen->PRWLock);
UNLOCK(pen->PELock);
return FALSE;
}
else DEPTH = RESET_DEPTH();
@ -73,7 +72,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
CP = P;
P = code;
/* vsc: increment reduction counter at meta-call entry */
READ_UNLOCK(pen->PRWLock);
if (pen->PredFlags & ProfiledPredFlag) {
LOCK(pen->StatisticsForPred.lock);
pen->StatisticsForPred.NOfEntries++;
@ -1552,15 +1550,15 @@ Yap_execute_goal(Term t, int nargs, Term mod)
if (pe == NIL) {
return(CallMetaCall(mod));
}
READ_LOCK(ppe->PRWLock);
LOCK(ppe->PELock);
if (IsAtomTerm(t)) {
CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock);
UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, 0, pt, FALSE);
} else {
Functor f = FunctorOfTerm(t);
CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock);
UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE);
}
@ -1697,9 +1695,9 @@ Yap_RunTopGoal(Term t)
/* we must always start the emulator with Prolog code */
return FALSE;
}
READ_LOCK(ppe->PRWLock);
LOCK(ppe->PELock);
CodeAdr = ppe->CodeOfPred;
READ_UNLOCK(ppe->PRWLock);
UNLOCK(ppe->PELock);
#if !USE_SYSTEM_MALLOC
if (Yap_TrailTop - HeapTop < 2048) {
Yap_PrologMode = BootMode;

4
C/heapgc.c
View File

@ -2398,6 +2398,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
if (flags & IndexMask) {
LogUpdIndex *indx = ClauseFlagsToLogUpdIndex(pt0);
int erase;
LOCK(indx->ClPred->PELock);
DEC_CLREF_COUNT(indx);
indx->ClFlags &= ~InUseMask;
erase = (indx->ClFlags & ErasedMask
@ -2407,10 +2408,12 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
no one is accessing the clause */
Yap_ErLogUpdIndex(indx);
}
UNLOCK(indx->ClPred->PELock);
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0);
int erase;
LOCK(cl->ClPred->PELock);
DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask;
erase = ((cl->ClFlags & ErasedMask) && !cl->ClRefCount);
@ -2419,6 +2422,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
no one is accessing the clause */
Yap_ErLogUpdCl(cl);
}
UNLOCK(cl->ClPred->PELock);
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt0);

86
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2007-11-08 15:52:15 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.191 2007/11/08 15:52:15 vsc
* fix some bugs in new dbterm code.
*
* Revision 1.190 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
@ -945,6 +948,7 @@ has_cut(yamop *pc)
#endif /* !YAPOR */
case _pop:
case _index_pred:
case _lock_pred:
#if THREADS
case _thread_local:
#endif
@ -2366,6 +2370,9 @@ add_info(ClauseDef *clause, UInt regno)
}
cl = NEXTOP(cl,ycx);
break;
case _lock_lu:
cl = NEXTOP(cl,p);
break;
case _call_bfunc_xx:
cl = NEXTOP(cl,llxx);
break;
@ -2425,7 +2432,6 @@ add_info(ClauseDef *clause, UInt regno)
case _skip:
case _jump_if_var:
case _try_in:
case _lock_lu:
case _unlock_lu:
case _try_clause2:
case _try_clause3:
@ -2454,6 +2460,7 @@ add_info(ClauseDef *clause, UInt regno)
#endif /* !YAPOR */
case _pop:
case _index_pred:
case _lock_pred:
#if THREADS
case _thread_local:
#endif
@ -4790,7 +4797,9 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots)
}
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Yap_LockStream(Yap_c_error_stream);
Yap_ShowCode(&cint);
Yap_UnLockStream(Yap_c_error_stream);
}
#endif
/* globals for assembler */
@ -5818,8 +5827,18 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
Yap_kill_iblock((ClauseUnion *)ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred),NULL, ap);
}
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)
if (ap->PredFlags & LogUpdatePredFlag &&
ap->ModuleOfPred != IDB_MODULE) {
ap->OpcodeOfPred = LOCKPRED_OPCODE;
ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
#endif
ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)
}
#endif
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return FAILCODE;
}
@ -5851,7 +5870,12 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ap->ModuleOfPred;
Yap_LockStream(Yap_c_error_stream);
if (!tmod) tmod = TermProlog;
#if THREADS
Yap_plwrite(MkIntegerTerm(worker_id), Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,' ');
#endif
Yap_DebugPutc(Yap_c_error_stream,'>');
Yap_DebugPutc(Yap_c_error_stream,'\t');
Yap_plwrite(tmod, Yap_DebugPutc, 0);
@ -5880,8 +5904,14 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
Yap_DebugPutc(Yap_c_error_stream,'/');
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
}
Yap_UnLockStream(Yap_c_error_stream);
}
Yap_DebugPutc(Yap_c_error_stream,'\n');
#if THREADS
Yap_plwrite(MkIntegerTerm(worker_id), Yap_DebugPutc, 0);
Yap_DebugPutc(Yap_c_error_stream,' ');
#endif
Yap_UnLockStream(Yap_c_error_stream);
}
#endif
if ((labp = expand_index(&cint)) == NULL) {
@ -5900,7 +5930,9 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
}
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Yap_LockStream(Yap_c_error_stream);
Yap_ShowCode(&cint);
Yap_UnLockStream(Yap_c_error_stream);
}
#endif
/* globals for assembler */
@ -6284,16 +6316,12 @@ expand_ftable(yamop *pc, ClauseUnion *blk, struct intermediates *cint, Functor f
static void
clean_ref_to_clause(LogUpdClause *tgl)
{
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);
}
}
@ -7250,6 +7278,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ap->ModuleOfPred;
Yap_LockStream(Yap_c_error_stream);
if (!tmod) tmod = TermProlog;
Yap_DebugPutc(Yap_c_error_stream,'+');
Yap_DebugPutc(Yap_c_error_stream,'\t');
@ -7281,6 +7310,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
}
}
Yap_DebugPutc(Yap_c_error_stream,'\n');
Yap_UnLockStream(Yap_c_error_stream);
}
#endif
stack = (path_stack_entry *)TR;
@ -7334,6 +7364,13 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
if (ap->PredFlags & SpiedPredFlag) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS)
} else if (ap->PredFlags & LogUpdatePredFlag &&
ap->ModuleOfPred != IDB_MODULE) {
ap->cs.p_code.TrueCodeOfPred = FAILCODE;
ap->OpcodeOfPred = LOCKPRED_OPCODE;
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#endif
} else {
ap->OpcodeOfPred = ap->cs.p_code.FirstClause->opc;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
@ -7730,6 +7767,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
Term tmod = ap->ModuleOfPred;
if (!tmod) tmod = TermProlog;
Yap_LockStream(Yap_c_error_stream);
Yap_DebugPutc(Yap_c_error_stream,'-');
Yap_DebugPutc(Yap_c_error_stream,'\t');
Yap_plwrite(tmod, Yap_DebugPutc, 0);
@ -7761,6 +7799,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
}
}
Yap_DebugPutc(Yap_c_error_stream,'\n');
Yap_UnLockStream(Yap_c_error_stream);
}
#endif
stack = (path_stack_entry *)TR;
@ -7776,8 +7815,19 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
sp = push_path(stack, NULL, &cl, &cint);
if (ap->cs.p_code.NOfClauses == 0) {
/* there was no indexing code */
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = FAILCODE;
ap->OpcodeOfPred = Yap_opcode(_op_fail);
#if defined(YAPOR) || defined(THREADS)
if (ap->PredFlags & LogUpdatePredFlag &&
ap->ModuleOfPred != IDB_MODULE) {
ap->cs.p_code.TrueCodeOfPred = FAILCODE;
ap->OpcodeOfPred = LOCKPRED_OPCODE;
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else {
#endif
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = FAILCODE;
ap->OpcodeOfPred = Yap_opcode(_op_fail);
#if defined(YAPOR) || defined(THREADS)
}
#endif
} else {
remove_from_index(ap, sp, &cl, beg, last, &cint);
}
@ -7859,7 +7909,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
/* try to refine the interval using the indexing code */
while (ipc != NULL) {
op_numbers op = Yap_op_from_opcode(ipc->opc);
switch(op) {
case _try_in:
update_clause_choice_point(NEXTOP(ipc,l), ap_pc);
@ -8006,7 +8055,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
ap->LastCallOfPred = LUCALL_EXEC;
}
*--ASP = MkIntegerTerm(ap->TimeStampOfPred);
LOCK(cl->ClLock);
/* indicate the indexing code is being used */
#if defined(YAPOR) || defined(THREADS)
/* just store a reference */
@ -8018,7 +8066,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
TRAIL_CLREF(cl);
}
#endif
UNLOCK(cl->ClLock);
}
ipc = ipc->u.Ill.l1;
break;
@ -8070,11 +8117,9 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
#if defined(YAPOR) || defined(THREADS)
B->cp_tr--;
TR--;
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
/* actually get rid of the code */
if (cl->ClRefCount == 0 && cl->ClFlags & (ErasedMask|DirtyMask)) {
UNLOCK(cl->ClLock);
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
@ -8083,8 +8128,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
} else {
Yap_CleanUpIndex(cl);
}
} else {
UNLOCK(cl->ClLock);
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
@ -8296,16 +8339,13 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
XREGS[ap->ArityOfPE+3] = Terms[0];
XREGS[ap->ArityOfPE+4] = Terms[1];
XREGS[ap->ArityOfPE+5] = Terms[2];
LOCK(ap->PELock);
#if defined(YAPOR) || defined(THREADS)
if (!same_lu_block(jlbl, ipc)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
#endif
ipc = ExpandIndex(ap, 5);
UNLOCK(ap->PELock);
s_reg = (CELL *)XREGS[ap->ArityOfPE+1];
t = XREGS[ap->ArityOfPE+2];
Terms[0] = XREGS[ap->ArityOfPE+3];
@ -8327,6 +8367,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
break;
#endif
case _spy_pred:
case _lock_pred:
if ((ap->PredFlags & IndexedPredFlag) ||
ap->cs.p_code.NOfClauses <= 1) {
ipc = ap->cs.p_code.TrueCodeOfPred;
@ -8572,19 +8613,18 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _expand_index:
case _expand_clauses:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jlbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
#endif
ipc = ExpandIndex(ap, 0);
UNLOCK(ap->PELock);
break;
case _op_fail:
ipc = alt;
break;
case _lock_pred:
case _index_pred:
case _spy_pred:
Yap_IPred(ap, 0);

1
C/init.c
View File

@ -933,6 +933,7 @@ InitCodes(void)
Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop);

15
C/iopreds.c
View File

@ -3019,6 +3019,21 @@ Yap_CheckStream (Term arg, int kind, char *msg)
return CheckStream(arg, kind, msg);
}
#if defined(YAPOR) || defined(THREADS)
void
Yap_LockStream (int sno)
{
LOCK(Stream[sno].streamlock);
}
void
Yap_UnLockStream (int sno)
{
UNLOCK(Stream[sno].streamlock);
}
#endif
static Int
p_check_stream (void)
{ /* '$check_stream'(Stream,Mode) */

25
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:08 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.123 2007/11/06 17:02:12 vsc
* compile ground terms away.
*
* Revision 1.122 2007/10/18 08:24:16 vsc
* fix global variables
*
@ -540,10 +543,10 @@ FindAtom(codeToFind, arity)
pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) {
CODEADDR *out;
READ_LOCK(pp->PRWLock);
LOCK(pp->PELock);
out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE;
READ_UNLOCK(pp->PRWLock);
UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock);
return (out);
}
@ -565,10 +568,10 @@ FindAtom(codeToFind, arity)
pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) {
CODEADDR *out;
READ_LOCK(pp->PRWLock);
LOCK(pp->PELock);
out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE;
READ_UNLOCK(pp->PRWLock);
UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock);
return (out);
}
@ -2909,14 +2912,14 @@ p_flags(void)
return (FALSE);
if (EndOfPAEntr(pe))
return (FALSE);
READ_LOCK(pe->PRWLock);
LOCK(pe->PELock);
if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
return(FALSE);
}
ARG4 = Deref(ARG4);
if (IsVarTerm(ARG4)) {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
return (TRUE);
} else if (!IsIntegerTerm(ARG4)) {
union arith_ret v;
@ -2924,15 +2927,15 @@ p_flags(void)
if (Yap_Eval(ARG4, &v) == long_int_e) {
newFl = v.Int;
} else {
READ_UNLOCK(pe->PRWLock);
UNLOCK(pe->PELock);
Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");
return(FALSE);
}
} else
newFl = IntegerOfTerm(ARG4);
pe->PredFlags = (CELL)newFl;
READ_UNLOCK(pe->PRWLock);
return (TRUE);
UNLOCK(pe->PELock);
return TRUE;
}
static int

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.120 2007-11-07 09:25:27 vsc Exp $ *
* version: $Id: Heap.h,v 1.121 2007-11-26 23:43:08 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -312,6 +312,7 @@ typedef struct various_codes {
char prompt[MAX_PROMPT];
OPCODE undef_op;
OPCODE index_op;
OPCODE lockpred_op;
OPCODE fail_op;
yamop *retry_recorded_k_code,
*retry_c_recordedp_code;
@ -640,6 +641,7 @@ struct various_codes *Yap_heap_regs;
#define yap_flags Yap_heap_regs->yap_flags_field
#define UNDEF_OPCODE Yap_heap_regs->undef_op
#define INDEX_OPCODE Yap_heap_regs->index_op
#define LOCKPRED_OPCODE Yap_heap_regs->lockpred_op
#define FAIL_OPCODE Yap_heap_regs->fail_op
#ifdef THREADS
#define ThreadHandlesLock Yap_heap_regs->thread_handles_lock

6
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2007-11-07 09:25:27 $ *
* Last rev: $Date: 2007-11-26 23:43:09 $ *
* $Log: not supported by cvs2svn $
* Revision 1.42 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
* Revision 1.41 2007/11/06 17:02:12 vsc
* compile ground terms away.
*
@ -282,6 +285,7 @@
OPCODE(index_blob ,e),
OPCODE(trust_fail ,e),
OPCODE(index_pred ,e),
OPCODE(lock_pred ,e),
OPCODE(expand_index ,e),
OPCODE(expand_clauses ,sp),
OPCODE(save_b_x ,x),

1
H/Yatom.h
View File

@ -720,7 +720,6 @@ typedef struct pred_entry
struct mfile *file_srcs; /* for multifile predicates */
} src;
#if defined(YAPOR) || defined(THREADS)
rwlock_t PRWLock; /* a simple lock to protect this entry */
lockvar PELock; /* a simple lock to protect expansion */
#endif
#ifdef TABLING

8
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h *
* comments: Abstract machine peculiarities *
* *
* Last rev: $Date: 2006-10-10 14:08:17 $ *
* Last rev: $Date: 2007-11-26 23:43:09 $ *
* $Log: not supported by cvs2svn $
* Revision 1.32 2006/10/10 14:08:17 vsc
* small fixes on threaded implementation.
*
* Revision 1.31 2006/09/20 20:03:51 vsc
* improve indexing on floats
* fix sending large lists to DB
@ -233,6 +236,9 @@ typedef struct yami {
Int ClENV;
Int ClRefs;
struct logic_upd_clause *ClBase;
#if defined(THREADS) || defined(YAPOR)
struct pred_entry *p;
#endif
CELL next;
} EC;
struct {

9
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.20 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
* Revision 1.19 2007/11/06 17:02:12 vsc
* compile ground terms away.
*
@ -243,6 +246,9 @@ restore_opcodes(yamop *pc)
/* instructions type EC */
case _alloc_for_logical_pred:
pc->u.EC.ClBase = (struct logic_upd_clause *)PtoOpAdjust((yamop *)pc->u.EC.ClBase);
#if defined(THREADS) || defined(YAPOR)
pc->u.EC.p = PtoPredAdjust(pc->u.EC.p);
#endif
pc = NEXTOP(pc,EC);
break;
/* instructions type e */
@ -262,6 +268,7 @@ restore_opcodes(yamop *pc)
case _write_l_list:
case _pop:
case _index_pred:
case _lock_pred:
#ifdef BEAM
case _retry_eam:
#endif

6
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2007-11-07 09:35:53 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.80 2007/11/07 09:35:53 vsc
* small fix
*
* Revision 1.79 2007/11/07 09:25:27 vsc
* speedup meta-calls
*
@ -447,6 +450,7 @@ restore_codes(void)
Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop);
#ifdef YAPOR

7
H/yapio.h
View File

@ -279,6 +279,13 @@ char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */
Int STD_PROTO(Yap_FirstLineInParse,(void));
int STD_PROTO(Yap_CheckIOStream,(Term, char *));
#if defined(YAPOR) || defined(THREADS)
void STD_PROTO(Yap_LockStream,(int));
void STD_PROTO(Yap_UnLockStream,(int));
#else
#define Yap_LockStream(X)
#define Yap_UnLockStream(X)
#endif
int STD_PROTO(Yap_GetStreamFd,(int));
void STD_PROTO(Yap_CloseStreams,(int));
void STD_PROTO(Yap_CloseStream,(int));

6
OPTYap/x86_locks.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: x86_locks.h
version: $Id: x86_locks.h,v 1.3 2005-05-31 08:24:24 ricroc Exp $
version: $Id: x86_locks.h,v 1.4 2007-11-26 23:43:09 vsc Exp $
**********************************************************************/
@ -25,10 +25,10 @@
#define TRY_LOCK(LOCK_VAR) (swap(1,(LOCK_VAR))==0)
#define INIT_LOCK(LOCK_VAR) ((LOCK_VAR) = 0)
#define LOCK(LOCK_VAR) do { \
#define LOCK(LOCK_VAR) do { \
if (TRY_LOCK(&(LOCK_VAR))) break; \
while (IS_LOCKED(LOCK_VAR)) continue; \
} while (1)
} while (1)
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
#define UNLOCK(LOCK_VAR) ((LOCK_VAR) = 0)

2
changes-5.1.html
View File

@ -17,6 +17,8 @@
<h2>Yap-5.1.3:</h2>
<ul>
<li> FIXED: use safe locking to ensure that dynamic predicates
run correctly.</li>
<li> FIXED: use matrices to implement variavel elimination, also fix
some overflow bugs with matrices.</li>
<li> FIXED: Yap_shift_visit assumed we were using AUX DL_MALLOC (obs

2
configure.in
View File

@ -43,7 +43,7 @@ AC_ARG_ENABLE(threads,
[ --enable-threads support system threads ],
threads="$enableval", threads=no)
AC_ARG_ENABLE(pthread-locking,
[ --pthread-locking use pthread locking primitives for internal locking (requires threads) ],
[ --enable-pthread-locking use pthread locking primitives for internal locking (requires threads) ],
pthreadlocking="$enableval", pthreadlocking=no)
AC_ARG_ENABLE(max-performance,
[ --enable-max-performance try using the best flags for specific architecture ],

24
pl/boot.yap
View File

@ -51,13 +51,11 @@ true :- true.
'$allocate_default_arena'(1024, 64),
'$enter_system_mode',
set_value(fileerrors,1),
'$init_consult',
set_value('$gc',on),
set_value('$lf_verbose',informational),
('$exit_undefp' -> true ; true),
prompt(' ?- '),
nb_setval('$break',0),
nb_setval('$if_level',0),
nb_setval('$endif',off),
% '$set_read_error_handler'(error), let the user do that
nb_setval('$debug',off),
nb_setval('$trace',off),
@ -82,6 +80,15 @@ true :- true.
'$startup_reconsult',
'$startup_goals'.
'$init_consult' :-
nb_setval('$lf_verbose',informational),
nb_setval('$if_level',0),
nb_setval('$endif',off),
nb_setval('$consulting_file',user_input),
nb_setval('$consulting',false),
nb_setval('$included_file','').
% Start file for yap
/* I/O predicates */
@ -863,11 +870,12 @@ break :-
'$silent_bootstrap'(F) :-
'$allocate_default_arena'(1024, 64),
'$init_consult',
nb_setval('$if_level',0),
get_value('$lf_verbose',OldSilent),
set_value('$lf_verbose',silent),
nb_getval('$lf_verbose',OldSilent),
nb_setval('$lf_verbose',silent),
bootstrap(F),
set_value('$lf_verbose', OldSilent).
nb_setval('$lf_verbose', OldSilent).
bootstrap(F) :-
'$open'(F,'$csult',Stream,0,0),
@ -877,7 +885,7 @@ bootstrap(F) :-
getcwd(OldD),
cd(Dir),
(
get_value('$lf_verbose',silent)
nb_getval('$lf_verbose',silent)
->
true
;
@ -888,7 +896,7 @@ bootstrap(F) :-
cd(OldD),
'$end_consult',
(
get_value('$lf_verbose',silent)
nb_getval('$lf_verbose',silent)
->
true
;

11
pl/checker.yap
View File

@ -11,8 +11,11 @@
* File: checker.yap *
* comments: style checker for Prolog *
* *
* Last rev: $Date: 2006-11-17 12:10:46 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:09 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.22 2006/11/17 12:10:46 vsc
* style_checker was failing on DCGs
*
* Revision 1.21 2006/03/24 16:26:31 vsc
* code review
*
@ -153,7 +156,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$sv_warning'(SVs,T) :-
'$current_module'(OM),
'$xtract_head'(T,OM,M,H,Name,Arity),
( get_value('$consulting',false),
( nb_getval('$consulting',false),
'$first_clause_in_file'(Name,Arity, OM) ->
ClN = 1 ;
'$number_of_clauses'(H,M,ClN0),
@ -184,7 +187,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$handle_multiple'(F,A,M) :-
\+ '$first_clause_in_file'(F,A,M), !.
'$handle_multiple'(_,_,_) :-
get_value('$consulting',true), !.
nb_getval('$consulting',true), !.
'$handle_multiple'(F,A,M) :-
recorded('$predicate_defs','$predicate_defs'(F,A,M,Fil),_), !,
'$multiple_has_been_defined'(Fil, F/A, M), !.
@ -252,7 +255,7 @@ discontiguous(F) :-
%
'$check_multifile_pred'(Hd, M, _) :-
functor(Hd,Na,Ar),
get_value('$consulting_file',F),
nb_getval('$consulting_file',F),
recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
% oops, we did not.
'$check_multifile_pred'(Hd, M, Fl) :-

41
pl/consult.yap
View File

@ -88,8 +88,8 @@ load_files(Files,Opts) :-
'$do_error'(domain_error(unimplemented_option,qcompile),Call).
'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_,_,_,_).
'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_,_,_) :-
( get_value('$lf_verbose',Silent) -> true ; Silent = informational),
set_value('$lf_verbose',silent).
( nb_getval('$lf_verbose',Silent) -> true ; Silent = informational),
nb_setval('$lf_verbose',silent).
'$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_).
'$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_).
'$process_lf_opt'(compilation_mode(compile),_,_,_,_,_,_,_,_,_,compile,_,_,_).
@ -148,7 +148,7 @@ load_files(Files,Opts) :-
'$close_lf'(Silent) :-
nonvar(Silent), !,
set_value('$lf_verbose',Silent).
nb_setval('$lf_verbose',Silent).
'$close_lf'(_).
ensure_loaded(Fs) :-
@ -211,14 +211,14 @@ use_module(M,F,Is) :-
'$record_loaded'(Stream, ContextModule),
'$current_module'(OldModule,ContextModule),
getcwd(OldD),
get_value('$consulting_file',OldF),
nb_getval('$consulting_file',OldF),
'$set_consulting_file'(Stream),
H0 is heapused, '$cputime'(T0,_),
'$current_stream'(File,_,Stream),
'$fetch_stream_alias'(OldStream,'$loop_stream'),
'$change_alias_to_stream'('$loop_stream',Stream),
get_value('$consulting',Old),
set_value('$consulting',false),
nb_getval('$consulting',Old),
nb_setval('$consulting',false),
'$access_yap_flags'(18,GenerateDebug),
'$consult_infolevel'(InfLevel),
'$comp_mode'(OldCompMode, CompMode),
@ -251,8 +251,8 @@ use_module(M,F,Is) :-
'$change_alias_to_stream'('$loop_stream',OldStream),
'$set_yap_flags'(18,GenerateDebug),
'$comp_mode'(_, OldCompMode),
set_value('$consulting',Old),
set_value('$consulting_file',OldF),
nb_setval('$consulting',Old),
nb_setval('$consulting_file',OldF),
cd(OldD),
nb_setval('$if_level',OldIncludeLevel),
% surely, we were in run mode or we would not have included the file!
@ -279,7 +279,7 @@ use_module(M,F,Is) :-
'$consult_infolevel'(InfoLevel) :- nonvar(InfoLevel), !.
'$consult_infolevel'(InfoLevel) :-
get_value('$lf_verbose',InfoLevel), InfoLevel \= [], !.
nb_getval('$lf_verbose',InfoLevel), InfoLevel \= [], !.
'$consult_infolevel'(informational).
'$start_reconsulting'(F) :-
@ -338,9 +338,10 @@ use_module(M,F,Is) :-
'$include'(F, Status),
'$include'(Fs, Status).
'$include'(X, Status) :-
get_value('$lf_verbose',Verbosity),
nb_getval('$lf_verbose',Verbosity),
'$find_in_path'(X,Y,include(X)),
'$values'('$included_file',OY,Y),
nb_getval('$included_file',OY),
nb_setval('$included_file', Y),
'$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_),
'$default_encoding'(Encoding),
@ -352,7 +353,7 @@ use_module(M,F,Is) :-
),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$print_message'(Verbosity, loaded(included, Y, Mod, T, H)),
set_value('$included_file',OY).
nb_setval('$included_file',OY).
'$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) ->
@ -374,13 +375,13 @@ use_module(M,F,Is) :-
prolog_load_context(_, _) :-
get_value('$consulting_file',[]), !, fail.
nb_getval('$consulting_file',[]), !, fail.
prolog_load_context(directory, DirName) :-
getcwd(DirName).
prolog_load_context(file, FileName) :-
get_value('$included_file',IncFileName),
nb_getval('$included_file',IncFileName),
( IncFileName = [] ->
get_value('$consulting_file',FileName)
nb_getval('$consulting_file',FileName)
;
FileName
= IncFileName
@ -388,7 +389,7 @@ prolog_load_context(file, FileName) :-
prolog_load_context(module, X) :-
'$current_module'(X).
prolog_load_context(source, FileName) :-
get_value('$consulting_file',FileName).
nb_getval('$consulting_file',FileName).
prolog_load_context(stream, Stream) :-
'$fetch_stream_alias'(Stream,'$loop_stream').
prolog_load_context(term_position, Position) :-
@ -465,7 +466,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
% add_multifile_predicate when we start consult
'$add_multifile'(Name,Arity,Module) :-
get_value('$consulting_file',File),
nb_getval('$consulting_file',File),
'$add_multifile'(File,Name,Arity,Module).
'$add_multifile'(File,Name,Arity,Module) :-
@ -494,12 +495,12 @@ remove_from_path(New) :- '$check_path'(New,Path),
'$remove_multifile_clauses'(_).
'$set_consulting_file'(user) :- !,
set_value('$consulting_file',user_input).
nb_setval('$consulting_file',user_input).
'$set_consulting_file'(user_input) :- !,
set_value('$consulting_file',user_input).
nb_setval('$consulting_file',user_input).
'$set_consulting_file'(Stream) :-
'$file_name'(Stream,F),
set_value('$consulting_file',F),
nb_setval('$consulting_file',F),
'$set_consulting_dir'(F).
%

7
pl/errors.yap
View File

@ -11,8 +11,11 @@
* File: errors.yap *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2007-09-27 23:02:00 $,$Author: vsc $ *
* Last rev: $Date: 2007-11-26 23:43:10 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.82 2007/09/27 23:02:00 vsc
* encoding/1
*
* Revision 1.81 2007/09/27 15:25:34 vsc
* upgrade JPL
*
@ -232,7 +235,7 @@ print_message(Level, Mss) :-
format(user_error, '~n', []).
'$output_error_location'(MsgCodes) :-
get_value('$consulting_file',FileName),
nb_getval('$consulting_file',FileName),
FileName \= [], !,
'$start_line'(LN),
'$show_consult_level'(LC),

2
pl/modules.yap
View File

@ -77,7 +77,7 @@ module(N) :-
'$module_dec'(N,P) :-
'$current_module'(_,N),
get_value('$consulting_file',F),
nb_getval('$consulting_file',F),
'$add_module_on_file'(N, F, P).
'$add_module_on_file'(Mod, F, Exports) :-

2
pl/preds.yap
View File

@ -192,7 +192,7 @@ assertz_static(C) :-
'$head_and_body'(C0, H0, B0),
'$recordap'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(Head, Mod) ->
get_value('$consulting_file',F),
nb_getval('$consulting_file',F),
functor(H0, Na, Ar),
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
;

2
pl/yapor.yap
View File

@ -104,7 +104,7 @@ default_sequential(_).
% do not try to run consult in the parallel system.
%
'$parallelizable'(_) :-
get_value('$consulting_file',S), S\=[], !, fail.
nb_getval('$consulting_file',S), S\=[], !, fail.
'$parallelizable'((G1,G2)) :- !,
'$parallelizable'(G1),
'$parallelizable'(G2).