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.

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

20
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * 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 $ * $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 * Revision 1.96 2007/11/06 17:02:09 vsc
* compile ground terms away. * 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.ClENV = 0;
code_p->u.EC.ClRefs = 0; code_p->u.EC.ClRefs = 0;
code_p->u.EC.ClBase = cl; code_p->u.EC.ClBase = cl;
#if defined(THREADS) || defined(YAPOR)
code_p->u.EC.p = cip->CurrentPred;
#endif
cl->ClExt = code_p; cl->ClExt = code_p;
cl->ClFlags |= LogUpdRuleMask; 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; code_p = cl_u->lui.ClCode;
*entry_codep = code_p; *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 { } else {
if (pass_no) { if (pass_no) {
cl_u->si.ClSize = size; cl_u->si.ClSize = size;
@ -3114,7 +3110,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
else else
if (cip->CurrentPred->PredFlags & LogUpdatePredFlag && if (cip->CurrentPred->PredFlags & LogUpdatePredFlag &&
!(cip->CurrentPred->PredFlags & ThreadLocalPredFlag)) !(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 #endif
code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no); code_p = a_pl(_procceed, cip->CurrentPred, code_p, pass_no);
#ifdef YAPOR #ifdef YAPOR

2
C/analyst.c
View File

@ -270,6 +270,7 @@ p_show_op_counters()
print_instruction(_pop_n); print_instruction(_pop_n);
print_instruction(_trust_fail); print_instruction(_trust_fail);
print_instruction(_index_pred); print_instruction(_index_pred);
print_instruction(_lock_pred);
#if THREADS #if THREADS
print_instruction(_thread_local); print_instruction(_thread_local);
#endif #endif
@ -632,6 +633,7 @@ p_show_ops_by_group(void)
Yap_opcount[_Ystop] + Yap_opcount[_Ystop] +
Yap_opcount[_Nstop] + Yap_opcount[_Nstop] +
Yap_opcount[_index_pred] + Yap_opcount[_index_pred] +
Yap_opcount[_lock_pred] +
#if THREADS #if THREADS
Yap_opcount[_thread_local] + Yap_opcount[_thread_local] +
#endif #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 * * File: compiler.c *
* comments: Clause compiler * * 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 $ * $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 * Revision 1.84 2007/03/27 13:48:51 vsc
* fix number of overflows (comments by Bart Demoen). * 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); pop_code(level, cglobs);
} }
} else if (IsRefTerm(t)) { } else if (IsRefTerm(t)) {
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { 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); FAIL("can not compile data base reference",TYPE_ERROR_CALLABLE,t);
} else { } else {
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
cglobs->hasdbrefs = TRUE; cglobs->hasdbrefs = TRUE;
if (level == 0) if (level == 0)
Yap_emit((cglobs->onhead ? get_atom_op : put_atom_op), (CELL) t, argno, &cglobs->cint); 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) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
return; return;
@ -1406,7 +1409,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
/* never a problem here with a -> b, !, c ; d */ /* never a problem here with a -> b, !, c ; d */
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) { if (is_tabled(cglobs->cint.CurrentPred)) {
Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint); Yap_emit_3ops(cut_op, Zero, Zero, Zero, &cglobs->cint);
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &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); Yap_emit_3ops(cutexit_op, Zero, Zero, Zero, &cglobs->cint);
} }
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
else { else {
@ -1454,14 +1457,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(label_op, l2, Zero, &cglobs->cint); Yap_emit(label_op, l2, Zero, &cglobs->cint);
if (cglobs->onlast) { if (cglobs->onlast) {
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
else else
@ -1687,14 +1690,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
return; return;
@ -1711,14 +1714,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
return; return;
@ -1739,14 +1742,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
return; return;
@ -1820,14 +1823,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
return; return;
@ -1855,14 +1858,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
} }
@ -1884,14 +1887,14 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
cglobs->or_found = TRUE; cglobs->or_found = TRUE;
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint); Yap_emit(table_new_answer_op, Zero, cglobs->cint.CurrentPred->ArityOfPE, &cglobs->cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs->cint); Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
} }
@ -1899,7 +1902,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
if (cglobs->onlast) { if (cglobs->onlast) {
Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint); Yap_emit(deallocate_op, Zero, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) { if (is_tabled(cglobs->cint.CurrentPred)) {
cglobs->needs_env = TRUE; cglobs->needs_env = TRUE;
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero, &cglobs->cint); 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 */ #endif /* TABLING */
Yap_emit(execute_op, (CELL) p0, Zero, &cglobs->cint); Yap_emit(execute_op, (CELL) p0, Zero, &cglobs->cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
else { else {
@ -2695,7 +2698,7 @@ c_layout(compiler_struct *cglobs)
cglobs->cint.cpc->op = nop_op; cglobs->cint.cpc->op = nop_op;
} else { } else {
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs->cint.CurrentPred->PRWLock); LOCK(cglobs->cint.CurrentPred->PELock);
if (is_tabled(cglobs->cint.CurrentPred)) if (is_tabled(cglobs->cint.CurrentPred))
cglobs->cint.cpc->op = nop_op; cglobs->cint.cpc->op = nop_op;
else else
@ -2703,7 +2706,7 @@ c_layout(compiler_struct *cglobs)
if (cglobs->goalno == 1 && !cglobs->or_found && nperm == 0) if (cglobs->goalno == 1 && !cglobs->or_found && nperm == 0)
cglobs->cint.cpc->op = nop_op; cglobs->cint.cpc->op = nop_op;
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs->cint.CurrentPred->PRWLock); UNLOCK(cglobs->cint.CurrentPred->PELock);
#endif #endif
} }
break; 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)); cglobs.cint.CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head),mod));
} }
/* insert extra instructions to count calls */ /* insert extra instructions to count calls */
READ_LOCK(cglobs.cint.CurrentPred->PRWLock); LOCK(cglobs.cint.CurrentPred->PELock);
if ((cglobs.cint.CurrentPred->PredFlags & ProfiledPredFlag) || if ((cglobs.cint.CurrentPred->PredFlags & ProfiledPredFlag) ||
(PROFILING && (cglobs.cint.CurrentPred->cs.p_code.FirstClause == NIL))) { (PROFILING && (cglobs.cint.CurrentPred->cs.p_code.FirstClause == NIL))) {
profiling = TRUE; profiling = TRUE;
@ -3256,7 +3259,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
profiling = FALSE; profiling = FALSE;
call_counting = FALSE; call_counting = FALSE;
} }
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock); UNLOCK(cglobs.cint.CurrentPred->PELock);
} }
cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue)); cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue));
/* phase 1 : produce skeleton code and variable information */ /* 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) { if (cglobs.is_a_fact && !cglobs.vtable) {
#ifdef TABLING #ifdef TABLING
READ_LOCK(cglobs.cint.CurrentPred->PRWLock); LOCK(cglobs.cint.CurrentPred->PELock);
if (is_tabled(cglobs.cint.CurrentPred)) if (is_tabled(cglobs.cint.CurrentPred))
Yap_emit(table_new_answer_op, Zero, cglobs.cint.CurrentPred->ArityOfPE, &cglobs.cint); Yap_emit(table_new_answer_op, Zero, cglobs.cint.CurrentPred->ArityOfPE, &cglobs.cint);
else else
#endif /* TABLING */ #endif /* TABLING */
Yap_emit(procceed_op, Zero, Zero, &cglobs.cint); Yap_emit(procceed_op, Zero, Zero, &cglobs.cint);
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(cglobs.cint.CurrentPred->PRWLock); UNLOCK(cglobs.cint.CurrentPred->PELock);
#endif #endif
/* ground term, do not need much more work */ /* ground term, do not need much more work */
if (cglobs.cint.BlobsStart != NULL) { if (cglobs.cint.BlobsStart != NULL) {

9
C/computils.c
View File

@ -11,8 +11,11 @@
* File: computils.c * * File: computils.c *
* comments: some useful routines for YAP's compiler * * 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 $ * $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 * Revision 1.30 2006/09/20 20:03:51 vsc
* improve indexing on floats * improve indexing on floats
* fix sending large lists to DB * fix sending large lists to DB
@ -666,6 +669,10 @@ static char *opformat[] =
"fetch_reg1_reg2\t%N,%N", "fetch_reg1_reg2\t%N,%N",
"fetch_constant_reg\t%l,%N", "fetch_constant_reg\t%l,%N",
"fetch_reg_constant\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_var\t%v,%B",
"function_to_al\t%v,%B", "function_to_al\t%v,%B",
"enter_profiling\t\t%g", "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); return (FALSE);
ps = *((CELL *) (Addr (cp) - CellSize)); ps = *((CELL *) (Addr (cp) - CellSize));
pe = (PredEntry *) (ps - sizeof (OPREG) - sizeof (Prop)); pe = (PredEntry *) (ps - sizeof (OPREG) - sizeof (Prop));
READ_LOCK(pe->PRWLock); LOCK(pe->PELock);
if (!ONHEAP (pe) || Unsigned (pe) & 3 || pe->KindOfPE & 0xff00) { if (!ONHEAP (pe) || Unsigned (pe) & 3 || pe->KindOfPE & 0xff00) {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
return (FALSE); return (FALSE);
} }
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
return (TRUE); return (TRUE);
} }
@ -100,9 +100,9 @@ DumpActiveGoals (void)
pe = EnvPreg(cp); pe = EnvPreg(cp);
if (!ONHEAP (pe) || Unsigned (pe) & (sizeof(CELL)-1)) if (!ONHEAP (pe) || Unsigned (pe) & (sizeof(CELL)-1))
break; break;
READ_LOCK(pe->PRWLock); LOCK(pe->PELock);
if (pe->KindOfPE & 0xff00) { if (pe->KindOfPE & 0xff00) {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
break; break;
} }
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag)) if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag))
@ -110,7 +110,7 @@ DumpActiveGoals (void)
Functor f; Functor f;
Term mod = TermProlog; Term mod = TermProlog;
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
f = pe->FunctorOfPred; f = pe->FunctorOfPred;
if (pe->KindOfPE && hidden (NameOfFunctor (f))) if (pe->KindOfPE && hidden (NameOfFunctor (f)))
goto next; goto next;
@ -128,7 +128,7 @@ DumpActiveGoals (void)
} }
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugPutc (Yap_c_error_stream,'\n');
} else { } else {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
} }
next: next:
ep = (CELL *) ep[E_E]; ep = (CELL *) ep[E_E];
@ -142,7 +142,7 @@ DumpActiveGoals (void)
if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL) if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL)
break; break;
pe = Yap_PredForChoicePt(b_ptr); pe = Yap_PredForChoicePt(b_ptr);
READ_LOCK(pe->PRWLock); LOCK(pe->PELock);
{ {
Functor f; Functor f;
Term mod = PROLOG_MODULE; Term mod = PROLOG_MODULE;
@ -168,7 +168,7 @@ DumpActiveGoals (void)
} }
Yap_DebugPutc (Yap_c_error_stream,'\n'); Yap_DebugPutc (Yap_c_error_stream,'\n');
} }
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
b_ptr = b_ptr->cp_b; 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) if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1); low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
READ_LOCK(pen->PRWLock);
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pen->ModuleOfPred) { if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0)) { if (DEPTH == MkIntTerm(0)) {
READ_UNLOCK(pen->PRWLock); UNLOCK(pen->PELock);
return FALSE; return FALSE;
} }
else DEPTH = RESET_DEPTH(); else DEPTH = RESET_DEPTH();
@ -73,7 +72,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
CP = P; CP = P;
P = code; P = code;
/* vsc: increment reduction counter at meta-call entry */ /* vsc: increment reduction counter at meta-call entry */
READ_UNLOCK(pen->PRWLock);
if (pen->PredFlags & ProfiledPredFlag) { if (pen->PredFlags & ProfiledPredFlag) {
LOCK(pen->StatisticsForPred.lock); LOCK(pen->StatisticsForPred.lock);
pen->StatisticsForPred.NOfEntries++; pen->StatisticsForPred.NOfEntries++;
@ -1552,15 +1550,15 @@ Yap_execute_goal(Term t, int nargs, Term mod)
if (pe == NIL) { if (pe == NIL) {
return(CallMetaCall(mod)); return(CallMetaCall(mod));
} }
READ_LOCK(ppe->PRWLock); LOCK(ppe->PELock);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
CodeAdr = RepPredProp (pe)->CodeOfPred; CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock); UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, 0, pt, FALSE); out = do_goal(t, CodeAdr, 0, pt, FALSE);
} else { } else {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
CodeAdr = RepPredProp (pe)->CodeOfPred; CodeAdr = RepPredProp (pe)->CodeOfPred;
READ_UNLOCK(ppe->PRWLock); UNLOCK(ppe->PELock);
out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE); 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 */ /* we must always start the emulator with Prolog code */
return FALSE; return FALSE;
} }
READ_LOCK(ppe->PRWLock); LOCK(ppe->PELock);
CodeAdr = ppe->CodeOfPred; CodeAdr = ppe->CodeOfPred;
READ_UNLOCK(ppe->PRWLock); UNLOCK(ppe->PELock);
#if !USE_SYSTEM_MALLOC #if !USE_SYSTEM_MALLOC
if (Yap_TrailTop - HeapTop < 2048) { if (Yap_TrailTop - HeapTop < 2048) {
Yap_PrologMode = BootMode; 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) { if (flags & IndexMask) {
LogUpdIndex *indx = ClauseFlagsToLogUpdIndex(pt0); LogUpdIndex *indx = ClauseFlagsToLogUpdIndex(pt0);
int erase; int erase;
LOCK(indx->ClPred->PELock);
DEC_CLREF_COUNT(indx); DEC_CLREF_COUNT(indx);
indx->ClFlags &= ~InUseMask; indx->ClFlags &= ~InUseMask;
erase = (indx->ClFlags & ErasedMask erase = (indx->ClFlags & ErasedMask
@ -2407,10 +2408,12 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
no one is accessing the clause */ no one is accessing the clause */
Yap_ErLogUpdIndex(indx); Yap_ErLogUpdIndex(indx);
} }
UNLOCK(indx->ClPred->PELock);
} else { } else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0); LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt0);
int erase; int erase;
LOCK(cl->ClPred->PELock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
erase = ((cl->ClFlags & ErasedMask) && !cl->ClRefCount); 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 */ no one is accessing the clause */
Yap_ErLogUpdCl(cl); Yap_ErLogUpdCl(cl);
} }
UNLOCK(cl->ClPred->PELock);
} }
} else { } else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt0); DynamicClause *cl = ClauseFlagsToDynamicClause(pt0);

86
C/index.c
View File

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

25
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c * * File: stdpreds.c *
* comments: General-purpose C implemented system predicates * * 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 $ * $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 * Revision 1.122 2007/10/18 08:24:16 vsc
* fix global variables * fix global variables
* *
@ -540,10 +543,10 @@ FindAtom(codeToFind, arity)
pp = RepPredProp(pp->NextOfPE); pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) { if (pp != NIL) {
CODEADDR *out; CODEADDR *out;
READ_LOCK(pp->PRWLock); LOCK(pp->PELock);
out = &(pp->CodeOfPred) out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE; *arityp = pp->ArityOfPE;
READ_UNLOCK(pp->PRWLock); UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
return (out); return (out);
} }
@ -565,10 +568,10 @@ FindAtom(codeToFind, arity)
pp = RepPredProp(pp->NextOfPE); pp = RepPredProp(pp->NextOfPE);
if (pp != NIL) { if (pp != NIL) {
CODEADDR *out; CODEADDR *out;
READ_LOCK(pp->PRWLock); LOCK(pp->PELock);
out = &(pp->CodeOfPred) out = &(pp->CodeOfPred)
*arityp = pp->ArityOfPE; *arityp = pp->ArityOfPE;
READ_UNLOCK(pp->PRWLock); UNLOCK(pp->PELock);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
return (out); return (out);
} }
@ -2909,14 +2912,14 @@ p_flags(void)
return (FALSE); return (FALSE);
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return (FALSE); return (FALSE);
READ_LOCK(pe->PRWLock); LOCK(pe->PELock);
if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) { if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
return(FALSE); return(FALSE);
} }
ARG4 = Deref(ARG4); ARG4 = Deref(ARG4);
if (IsVarTerm(ARG4)) { if (IsVarTerm(ARG4)) {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
return (TRUE); return (TRUE);
} else if (!IsIntegerTerm(ARG4)) { } else if (!IsIntegerTerm(ARG4)) {
union arith_ret v; union arith_ret v;
@ -2924,15 +2927,15 @@ p_flags(void)
if (Yap_Eval(ARG4, &v) == long_int_e) { if (Yap_Eval(ARG4, &v) == long_int_e) {
newFl = v.Int; newFl = v.Int;
} else { } else {
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags"); Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");
return(FALSE); return(FALSE);
} }
} else } else
newFl = IntegerOfTerm(ARG4); newFl = IntegerOfTerm(ARG4);
pe->PredFlags = (CELL)newFl; pe->PredFlags = (CELL)newFl;
READ_UNLOCK(pe->PRWLock); UNLOCK(pe->PELock);
return (TRUE); return TRUE;
} }
static int static int

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * 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 */ /* information that can be stored in Code Space */
@ -312,6 +312,7 @@ typedef struct various_codes {
char prompt[MAX_PROMPT]; char prompt[MAX_PROMPT];
OPCODE undef_op; OPCODE undef_op;
OPCODE index_op; OPCODE index_op;
OPCODE lockpred_op;
OPCODE fail_op; OPCODE fail_op;
yamop *retry_recorded_k_code, yamop *retry_recorded_k_code,
*retry_c_recordedp_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 yap_flags Yap_heap_regs->yap_flags_field
#define UNDEF_OPCODE Yap_heap_regs->undef_op #define UNDEF_OPCODE Yap_heap_regs->undef_op
#define INDEX_OPCODE Yap_heap_regs->index_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 #define FAIL_OPCODE Yap_heap_regs->fail_op
#ifdef THREADS #ifdef THREADS
#define ThreadHandlesLock Yap_heap_regs->thread_handles_lock #define ThreadHandlesLock Yap_heap_regs->thread_handles_lock

6
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h * * File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes * * comments: Central Table with all YAP opcodes *
* * * *
* Last rev: $Date: 2007-11-07 09:25:27 $ * * Last rev: $Date: 2007-11-26 23:43:09 $ *
* $Log: not supported by cvs2svn $ * $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 * Revision 1.41 2007/11/06 17:02:12 vsc
* compile ground terms away. * compile ground terms away.
* *
@ -282,6 +285,7 @@
OPCODE(index_blob ,e), OPCODE(index_blob ,e),
OPCODE(trust_fail ,e), OPCODE(trust_fail ,e),
OPCODE(index_pred ,e), OPCODE(index_pred ,e),
OPCODE(lock_pred ,e),
OPCODE(expand_index ,e), OPCODE(expand_index ,e),
OPCODE(expand_clauses ,sp), OPCODE(expand_clauses ,sp),
OPCODE(save_b_x ,x), 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 */ struct mfile *file_srcs; /* for multifile predicates */
} src; } src;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t PRWLock; /* a simple lock to protect this entry */
lockvar PELock; /* a simple lock to protect expansion */ lockvar PELock; /* a simple lock to protect expansion */
#endif #endif
#ifdef TABLING #ifdef TABLING

8
H/amidefs.h
View File

@ -11,8 +11,11 @@
* File: amidefs.h * * File: amidefs.h *
* comments: Abstract machine peculiarities * * 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 $ * $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 * Revision 1.31 2006/09/20 20:03:51 vsc
* improve indexing on floats * improve indexing on floats
* fix sending large lists to DB * fix sending large lists to DB
@ -233,6 +236,9 @@ typedef struct yami {
Int ClENV; Int ClENV;
Int ClRefs; Int ClRefs;
struct logic_upd_clause *ClBase; struct logic_upd_clause *ClBase;
#if defined(THREADS) || defined(YAPOR)
struct pred_entry *p;
#endif
CELL next; CELL next;
} EC; } EC;
struct { struct {

9
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h * * File: rclause.h *
* comments: walk through a clause * * 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 $ * $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 * Revision 1.19 2007/11/06 17:02:12 vsc
* compile ground terms away. * compile ground terms away.
* *
@ -243,6 +246,9 @@ restore_opcodes(yamop *pc)
/* instructions type EC */ /* instructions type EC */
case _alloc_for_logical_pred: case _alloc_for_logical_pred:
pc->u.EC.ClBase = (struct logic_upd_clause *)PtoOpAdjust((yamop *)pc->u.EC.ClBase); 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); pc = NEXTOP(pc,EC);
break; break;
/* instructions type e */ /* instructions type e */
@ -262,6 +268,7 @@ restore_opcodes(yamop *pc)
case _write_l_list: case _write_l_list:
case _pop: case _pop:
case _index_pred: case _index_pred:
case _lock_pred:
#ifdef BEAM #ifdef BEAM
case _retry_eam: case _retry_eam:
#endif #endif

6
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * 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 $ * $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 * Revision 1.79 2007/11/07 09:25:27 vsc
* speedup meta-calls * speedup meta-calls
* *
@ -447,6 +450,7 @@ restore_codes(void)
Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop); Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p); Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
Yap_heap_regs->index_op = Yap_opcode(_index_pred); 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->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop); Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop);
#ifdef YAPOR #ifdef YAPOR

7
H/yapio.h
View File

@ -279,6 +279,13 @@ char STD_PROTO(*Yap_AllocScannerMemory,(unsigned int));
/* routines in iopreds.c */ /* routines in iopreds.c */
Int STD_PROTO(Yap_FirstLineInParse,(void)); Int STD_PROTO(Yap_FirstLineInParse,(void));
int STD_PROTO(Yap_CheckIOStream,(Term, char *)); 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)); int STD_PROTO(Yap_GetStreamFd,(int));
void STD_PROTO(Yap_CloseStreams,(int)); void STD_PROTO(Yap_CloseStreams,(int));
void STD_PROTO(Yap_CloseStream,(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 Copyright: R. Rocha and NCC - University of Porto, Portugal
File: x86_locks.h 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 TRY_LOCK(LOCK_VAR) (swap(1,(LOCK_VAR))==0)
#define INIT_LOCK(LOCK_VAR) ((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; \ if (TRY_LOCK(&(LOCK_VAR))) break; \
while (IS_LOCKED(LOCK_VAR)) continue; \ while (IS_LOCKED(LOCK_VAR)) continue; \
} while (1) } while (1)
#define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0) #define IS_LOCKED(LOCK_VAR) ((LOCK_VAR) != 0)
#define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0) #define IS_UNLOCKED(LOCK_VAR) ((LOCK_VAR) == 0)
#define UNLOCK(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> <h2>Yap-5.1.3:</h2>
<ul> <ul>
<li> FIXED: use safe locking to ensure that dynamic predicates
run correctly.</li>
<li> FIXED: use matrices to implement variavel elimination, also fix <li> FIXED: use matrices to implement variavel elimination, also fix
some overflow bugs with matrices.</li> some overflow bugs with matrices.</li>
<li> FIXED: Yap_shift_visit assumed we were using AUX DL_MALLOC (obs <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 ], [ --enable-threads support system threads ],
threads="$enableval", threads=no) threads="$enableval", threads=no)
AC_ARG_ENABLE(pthread-locking, 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) pthreadlocking="$enableval", pthreadlocking=no)
AC_ARG_ENABLE(max-performance, AC_ARG_ENABLE(max-performance,
[ --enable-max-performance try using the best flags for specific architecture ], [ --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), '$allocate_default_arena'(1024, 64),
'$enter_system_mode', '$enter_system_mode',
set_value(fileerrors,1), set_value(fileerrors,1),
'$init_consult',
set_value('$gc',on), set_value('$gc',on),
set_value('$lf_verbose',informational),
('$exit_undefp' -> true ; true), ('$exit_undefp' -> true ; true),
prompt(' ?- '), prompt(' ?- '),
nb_setval('$break',0), nb_setval('$break',0),
nb_setval('$if_level',0),
nb_setval('$endif',off),
% '$set_read_error_handler'(error), let the user do that % '$set_read_error_handler'(error), let the user do that
nb_setval('$debug',off), nb_setval('$debug',off),
nb_setval('$trace',off), nb_setval('$trace',off),
@ -82,6 +80,15 @@ true :- true.
'$startup_reconsult', '$startup_reconsult',
'$startup_goals'. '$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 % Start file for yap
/* I/O predicates */ /* I/O predicates */
@ -863,11 +870,12 @@ break :-
'$silent_bootstrap'(F) :- '$silent_bootstrap'(F) :-
'$allocate_default_arena'(1024, 64), '$allocate_default_arena'(1024, 64),
'$init_consult',
nb_setval('$if_level',0), nb_setval('$if_level',0),
get_value('$lf_verbose',OldSilent), nb_getval('$lf_verbose',OldSilent),
set_value('$lf_verbose',silent), nb_setval('$lf_verbose',silent),
bootstrap(F), bootstrap(F),
set_value('$lf_verbose', OldSilent). nb_setval('$lf_verbose', OldSilent).
bootstrap(F) :- bootstrap(F) :-
'$open'(F,'$csult',Stream,0,0), '$open'(F,'$csult',Stream,0,0),
@ -877,7 +885,7 @@ bootstrap(F) :-
getcwd(OldD), getcwd(OldD),
cd(Dir), cd(Dir),
( (
get_value('$lf_verbose',silent) nb_getval('$lf_verbose',silent)
-> ->
true true
; ;
@ -888,7 +896,7 @@ bootstrap(F) :-
cd(OldD), cd(OldD),
'$end_consult', '$end_consult',
( (
get_value('$lf_verbose',silent) nb_getval('$lf_verbose',silent)
-> ->
true true
; ;

11
pl/checker.yap
View File

@ -11,8 +11,11 @@
* File: checker.yap * * File: checker.yap *
* comments: style checker for Prolog * * 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 $ * $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 * Revision 1.21 2006/03/24 16:26:31 vsc
* code review * code review
* *
@ -153,7 +156,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
'$sv_warning'(SVs,T) :- '$sv_warning'(SVs,T) :-
'$current_module'(OM), '$current_module'(OM),
'$xtract_head'(T,OM,M,H,Name,Arity), '$xtract_head'(T,OM,M,H,Name,Arity),
( get_value('$consulting',false), ( nb_getval('$consulting',false),
'$first_clause_in_file'(Name,Arity, OM) -> '$first_clause_in_file'(Name,Arity, OM) ->
ClN = 1 ; ClN = 1 ;
'$number_of_clauses'(H,M,ClN0), '$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) :- '$handle_multiple'(F,A,M) :-
\+ '$first_clause_in_file'(F,A,M), !. \+ '$first_clause_in_file'(F,A,M), !.
'$handle_multiple'(_,_,_) :- '$handle_multiple'(_,_,_) :-
get_value('$consulting',true), !. nb_getval('$consulting',true), !.
'$handle_multiple'(F,A,M) :- '$handle_multiple'(F,A,M) :-
recorded('$predicate_defs','$predicate_defs'(F,A,M,Fil),_), !, recorded('$predicate_defs','$predicate_defs'(F,A,M,Fil),_), !,
'$multiple_has_been_defined'(Fil, F/A, M), !. '$multiple_has_been_defined'(Fil, F/A, M), !.
@ -252,7 +255,7 @@ discontiguous(F) :-
% %
'$check_multifile_pred'(Hd, M, _) :- '$check_multifile_pred'(Hd, M, _) :-
functor(Hd,Na,Ar), functor(Hd,Na,Ar),
get_value('$consulting_file',F), nb_getval('$consulting_file',F),
recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !. recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
% oops, we did not. % oops, we did not.
'$check_multifile_pred'(Hd, M, Fl) :- '$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). '$do_error'(domain_error(unimplemented_option,qcompile),Call).
'$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_,_,_,_). '$process_lf_opt'(qcompile(false),_,_,_,_,false,_,_,_,_,_,_,_,_).
'$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_,_,_) :- '$process_lf_opt'(silent(true),Silent,silent,_,_,_,_,_,_,_,_,_,_,_) :-
( get_value('$lf_verbose',Silent) -> true ; Silent = informational), ( nb_getval('$lf_verbose',Silent) -> true ; Silent = informational),
set_value('$lf_verbose',silent). nb_setval('$lf_verbose',silent).
'$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_). '$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_).
'$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_). '$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_).
'$process_lf_opt'(compilation_mode(compile),_,_,_,_,_,_,_,_,_,compile,_,_,_). '$process_lf_opt'(compilation_mode(compile),_,_,_,_,_,_,_,_,_,compile,_,_,_).
@ -148,7 +148,7 @@ load_files(Files,Opts) :-
'$close_lf'(Silent) :- '$close_lf'(Silent) :-
nonvar(Silent), !, nonvar(Silent), !,
set_value('$lf_verbose',Silent). nb_setval('$lf_verbose',Silent).
'$close_lf'(_). '$close_lf'(_).
ensure_loaded(Fs) :- ensure_loaded(Fs) :-
@ -211,14 +211,14 @@ use_module(M,F,Is) :-
'$record_loaded'(Stream, ContextModule), '$record_loaded'(Stream, ContextModule),
'$current_module'(OldModule,ContextModule), '$current_module'(OldModule,ContextModule),
getcwd(OldD), getcwd(OldD),
get_value('$consulting_file',OldF), nb_getval('$consulting_file',OldF),
'$set_consulting_file'(Stream), '$set_consulting_file'(Stream),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$current_stream'(File,_,Stream), '$current_stream'(File,_,Stream),
'$fetch_stream_alias'(OldStream,'$loop_stream'), '$fetch_stream_alias'(OldStream,'$loop_stream'),
'$change_alias_to_stream'('$loop_stream',Stream), '$change_alias_to_stream'('$loop_stream',Stream),
get_value('$consulting',Old), nb_getval('$consulting',Old),
set_value('$consulting',false), nb_setval('$consulting',false),
'$access_yap_flags'(18,GenerateDebug), '$access_yap_flags'(18,GenerateDebug),
'$consult_infolevel'(InfLevel), '$consult_infolevel'(InfLevel),
'$comp_mode'(OldCompMode, CompMode), '$comp_mode'(OldCompMode, CompMode),
@ -251,8 +251,8 @@ use_module(M,F,Is) :-
'$change_alias_to_stream'('$loop_stream',OldStream), '$change_alias_to_stream'('$loop_stream',OldStream),
'$set_yap_flags'(18,GenerateDebug), '$set_yap_flags'(18,GenerateDebug),
'$comp_mode'(_, OldCompMode), '$comp_mode'(_, OldCompMode),
set_value('$consulting',Old), nb_setval('$consulting',Old),
set_value('$consulting_file',OldF), nb_setval('$consulting_file',OldF),
cd(OldD), cd(OldD),
nb_setval('$if_level',OldIncludeLevel), nb_setval('$if_level',OldIncludeLevel),
% surely, we were in run mode or we would not have included the file! % 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) :- nonvar(InfoLevel), !.
'$consult_infolevel'(InfoLevel) :- '$consult_infolevel'(InfoLevel) :-
get_value('$lf_verbose',InfoLevel), InfoLevel \= [], !. nb_getval('$lf_verbose',InfoLevel), InfoLevel \= [], !.
'$consult_infolevel'(informational). '$consult_infolevel'(informational).
'$start_reconsulting'(F) :- '$start_reconsulting'(F) :-
@ -338,9 +338,10 @@ use_module(M,F,Is) :-
'$include'(F, Status), '$include'(F, Status),
'$include'(Fs, Status). '$include'(Fs, Status).
'$include'(X, Status) :- '$include'(X, Status) :-
get_value('$lf_verbose',Verbosity), nb_getval('$lf_verbose',Verbosity),
'$find_in_path'(X,Y,include(X)), '$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), '$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$default_encoding'(Encoding), '$default_encoding'(Encoding),
@ -352,7 +353,7 @@ use_module(M,F,Is) :-
), ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$print_message'(Verbosity, loaded(included, Y, Mod, T, H)), '$print_message'(Verbosity, loaded(included, Y, Mod, T, H)),
set_value('$included_file',OY). nb_setval('$included_file',OY).
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-
( '$access_yap_flags'(15, 0) -> ( '$access_yap_flags'(15, 0) ->
@ -374,13 +375,13 @@ use_module(M,F,Is) :-
prolog_load_context(_, _) :- prolog_load_context(_, _) :-
get_value('$consulting_file',[]), !, fail. nb_getval('$consulting_file',[]), !, fail.
prolog_load_context(directory, DirName) :- prolog_load_context(directory, DirName) :-
getcwd(DirName). getcwd(DirName).
prolog_load_context(file, FileName) :- prolog_load_context(file, FileName) :-
get_value('$included_file',IncFileName), nb_getval('$included_file',IncFileName),
( IncFileName = [] -> ( IncFileName = [] ->
get_value('$consulting_file',FileName) nb_getval('$consulting_file',FileName)
; ;
FileName FileName
= IncFileName = IncFileName
@ -388,7 +389,7 @@ prolog_load_context(file, FileName) :-
prolog_load_context(module, X) :- prolog_load_context(module, X) :-
'$current_module'(X). '$current_module'(X).
prolog_load_context(source, FileName) :- prolog_load_context(source, FileName) :-
get_value('$consulting_file',FileName). nb_getval('$consulting_file',FileName).
prolog_load_context(stream, Stream) :- prolog_load_context(stream, Stream) :-
'$fetch_stream_alias'(Stream,'$loop_stream'). '$fetch_stream_alias'(Stream,'$loop_stream').
prolog_load_context(term_position, Position) :- 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_predicate when we start consult
'$add_multifile'(Name,Arity,Module) :- '$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).
'$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'(_). '$remove_multifile_clauses'(_).
'$set_consulting_file'(user) :- !, '$set_consulting_file'(user) :- !,
set_value('$consulting_file',user_input). nb_setval('$consulting_file',user_input).
'$set_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) :- '$set_consulting_file'(Stream) :-
'$file_name'(Stream,F), '$file_name'(Stream,F),
set_value('$consulting_file',F), nb_setval('$consulting_file',F),
'$set_consulting_dir'(F). '$set_consulting_dir'(F).
% %

7
pl/errors.yap
View File

@ -11,8 +11,11 @@
* File: errors.yap * * File: errors.yap *
* comments: error messages for 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 $ * $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 * Revision 1.81 2007/09/27 15:25:34 vsc
* upgrade JPL * upgrade JPL
* *
@ -232,7 +235,7 @@ print_message(Level, Mss) :-
format(user_error, '~n', []). format(user_error, '~n', []).
'$output_error_location'(MsgCodes) :- '$output_error_location'(MsgCodes) :-
get_value('$consulting_file',FileName), nb_getval('$consulting_file',FileName),
FileName \= [], !, FileName \= [], !,
'$start_line'(LN), '$start_line'(LN),
'$show_consult_level'(LC), '$show_consult_level'(LC),

2
pl/modules.yap
View File

@ -77,7 +77,7 @@ module(N) :-
'$module_dec'(N,P) :- '$module_dec'(N,P) :-
'$current_module'(_,N), '$current_module'(_,N),
get_value('$consulting_file',F), nb_getval('$consulting_file',F),
'$add_module_on_file'(N, F, P). '$add_module_on_file'(N, F, P).
'$add_module_on_file'(Mod, F, Exports) :- '$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), '$head_and_body'(C0, H0, B0),
'$recordap'(Mod:Head,(H0 :- B0),R,CR), '$recordap'(Mod:Head,(H0 :- B0),R,CR),
( '$is_multifile'(Head, Mod) -> ( '$is_multifile'(Head, Mod) ->
get_value('$consulting_file',F), nb_getval('$consulting_file',F),
functor(H0, Na, Ar), functor(H0, Na, Ar),
recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _) 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. % do not try to run consult in the parallel system.
% %
'$parallelizable'(_) :- '$parallelizable'(_) :-
get_value('$consulting_file',S), S\=[], !, fail. nb_getval('$consulting_file',S), S\=[], !, fail.
'$parallelizable'((G1,G2)) :- !, '$parallelizable'((G1,G2)) :- !,
'$parallelizable'(G1), '$parallelizable'(G1),
'$parallelizable'(G2). '$parallelizable'(G2).