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

many fixes

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@940 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-12-01 17:27:42 +00:00
parent d6207a55f9
commit 678ff0df82
15 changed files with 174 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/absmi.c
View File

@ -6359,9 +6359,11 @@ Yap_absmi(int inp)
to be executed when to be executed when
running a procedure from within the file that defines it. running a procedure from within the file that defines it.
*/ */
/* THIS SHOULD BE AN ERROR !!!!! */
if (PredFromDefCode(PREG)->OpcodeOfPred != INDEX_OPCODE) { if (PredFromDefCode(PREG)->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */ /* someone was here before we were */
PREG = PredFromDefCode(PREG)->CodeOfPred; Yap_Error(SYSTEM_ERROR,TermNil,"Bad locking");
PREG = FAILCODE;
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock); WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
JMPNext(); JMPNext();
} }
@ -6376,6 +6378,7 @@ Yap_absmi(int inp)
setregs(); setregs();
CACHED_A1() = ARG1; CACHED_A1() = ARG1;
PREG = PredFromDefCode(PREG)->CodeOfPred; PREG = PredFromDefCode(PREG)->CodeOfPred;
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -6390,7 +6393,9 @@ Yap_absmi(int inp)
ASP = (CELL *) B; ASP = (CELL *) B;
} }
saveregs(); saveregs();
WRITE_LOCK(pe->PRWLock);
pt0 = Yap_ExpandIndex(pe); pt0 = Yap_ExpandIndex(pe);
WRITE_UNLOCK(pe->PRWLock);
/* restart index */ /* restart index */
setregs(); setregs();
PREG = pt0; PREG = pt0;

36
C/adtdefs.c
View File

@ -143,35 +143,50 @@ LookupAtom(char *atom)
{ /* lookup atom in atom table */ { /* lookup atom in atom table */
register CELL hash; register CELL hash;
register unsigned char *p; register unsigned char *p;
Atom a; Atom a, na;
AtomEntry *ae; AtomEntry *ae;
/* compute hash */ /* compute hash */
p = (unsigned char *)atom; p = (unsigned char *)atom;
hash = HashFunction(p) % AtomHashTableSize; hash = HashFunction(p) % AtomHashTableSize;
WRITE_LOCK(HashChain[hash].AERWLock); /* we'll start by holding a read lock in order to avoid contention */
READ_LOCK(HashChain[hash].AERWLock);
a = HashChain[hash].Entry; a = HashChain[hash].Entry;
/* search atom in chain */ /* search atom in chain */
a = SearchAtom((unsigned char *)atom, a); na = SearchAtom((unsigned char *)atom, a);
if (a != NIL) { if (na != NIL) {
WRITE_UNLOCK(HashChain[hash].AERWLock); READ_UNLOCK(HashChain[hash].AERWLock);
return(a); return(na);
} }
READ_UNLOCK(HashChain[hash].AERWLock);
/* we need a write lock */
WRITE_LOCK(HashChain[hash].AERWLock);
/* concurrent version of Yap, need to take care */
#if defined(YAPOR) || defined(THREADS)
if (a != HashChain[hash].Entry) {
a = HashChain[hash].Entry;
na = SearchAtom((unsigned char *)atom, a);
if (na != NIL) {
WRITE_UNLOCK(HashChain[hash].AERWLock);
return(na);
}
}
#endif
NOfAtoms++; NOfAtoms++;
/* add new atom to start of chain */ /* add new atom to start of chain */
ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1); ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1);
a = AbsAtom(ae); na = AbsAtom(ae);
ae->PropsOfAE = NIL; ae->PropsOfAE = NIL;
if (ae->StrOfAE != atom) if (ae->StrOfAE != atom)
strcpy(ae->StrOfAE, atom); strcpy(ae->StrOfAE, atom);
ae->NextOfAE = HashChain[hash].Entry; ae->NextOfAE = a;
HashChain[hash].Entry = a; HashChain[hash].Entry = na;
INIT_RWLOCK(ae->ARWLock); INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock); WRITE_UNLOCK(HashChain[hash].AERWLock);
if (NOfAtoms > 2*AtomHashTableSize) { if (NOfAtoms > 2*AtomHashTableSize) {
CreepFlag = Unsigned(LCL0+1); CreepFlag = Unsigned(LCL0+1);
} }
return (a); return na;
} }
Atom Atom
@ -454,6 +469,7 @@ Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
return (p0); return (p0);
} }
/* fe is supposed to be locked */
Prop Prop
Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod) Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
{ {

4
C/amasm.c
View File

@ -2637,7 +2637,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
return NULL; return NULL;
} }
pass_no = 1; pass_no = 1;
YAPEnterCriticalSection();
{ {
size = size =
(CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode),ld),sla),e); (CELL)NEXTOP(NEXTOP(NEXTOP((yamop *)(((DynamicClause *)NULL)->ClCode),ld),sla),e);
@ -2695,6 +2694,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
t = ARG1; t = ARG1;
h0 = H; h0 = H;
H = (CELL *)freep; H = (CELL *)freep;
break;
default: default:
return NULL; return NULL;
} }
@ -2705,7 +2705,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
entry_code = do_pass(); entry_code = do_pass();
/* make sure we copy after second pass */ /* make sure we copy after second pass */
cl->usc.ClSource = x; cl->usc.ClSource = x;
YAPLeaveCriticalSection();
#ifdef LOW_PROF #ifdef LOW_PROF
Yap_prof_end=code_p; Yap_prof_end=code_p;
#endif #endif
@ -2719,7 +2718,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
} }
} }
entry_code = do_pass(); entry_code = do_pass();
YAPLeaveCriticalSection();
#ifdef LOW_PROF #ifdef LOW_PROF
Yap_prof_end=code_p; Yap_prof_end=code_p;
#endif #endif

47
C/cdmgr.c
View File

@ -145,7 +145,7 @@ static_in_use(PredEntry *p, int check_everything)
#define ByteAdr(X) ((Int) &(X)) #define ByteAdr(X) ((Int) &(X))
/* Index a prolog pred, given its predicate entry */ /* Index a prolog pred, given its predicate entry */
/* ap is already locked, but IPred is the one who gets rid of the lock. */ /* ap is already locked. */
static void static void
IPred(PredEntry *ap) IPred(PredEntry *ap)
{ {
@ -192,7 +192,6 @@ IPred(PredEntry *ap)
#endif #endif
/* Do not try to index a dynamic predicate or one whithout args */ /* Do not try to index a dynamic predicate or one whithout args */
if (is_dynamic(ap)) { if (is_dynamic(ap)) {
WRITE_UNLOCK(ap->PRWLock);
Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate"); Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate");
return; return;
} }
@ -207,7 +206,6 @@ IPred(PredEntry *ap)
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc; ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
} }
WRITE_UNLOCK(ap->PRWLock);
#ifdef DEBUG #ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) if (Yap_Option['i' - 'a' + 1])
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugPutc(Yap_c_error_stream,'\n');
@ -347,8 +345,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
ipc = NEXTOP(ipc,sl); ipc = NEXTOP(ipc,sl);
break; break;
default: default:
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code"); Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code: opcode %d", op);
ipc = NULL;
} }
} }
} }
@ -1379,12 +1376,15 @@ p_compile(void)
return (FALSE); return (FALSE);
if (IsVarTerm(t3) || !IsAtomTerm(t3)) if (IsVarTerm(t3) || !IsAtomTerm(t3))
return (FALSE); return (FALSE);
mod = Yap_LookupModule(t3); mod = Yap_LookupModule(t3);
YAPEnterCriticalSection();
codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments
to cclause in case there is overflow */ to cclause in case there is overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */
if (!Yap_ErrorMessage) if (!Yap_ErrorMessage)
addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod); addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod);
YAPLeaveCriticalSection();
if (Yap_ErrorMessage) { if (Yap_ErrorMessage) {
if (IntOfTerm(t1) & 4) { if (IntOfTerm(t1) & 4) {
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_Error(Yap_Error_TYPE, Yap_Error_Term,
@ -1413,6 +1413,7 @@ p_compile_dynamic(void)
old_optimize = optimizer_on; old_optimize = optimizer_on;
optimizer_on = FALSE; optimizer_on = FALSE;
mod = Yap_LookupModule(t3); mod = Yap_LookupModule(t3);
YAPEnterCriticalSection();
code_adr = Yap_cclause(t, 3, mod, Deref(ARG3)); /* vsc: give the number of arguments to code_adr = Yap_cclause(t, 3, mod, Deref(ARG3)); /* vsc: give the number of arguments to
cclause() in case there is a overflow */ cclause() in case there is a overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */
@ -1425,8 +1426,10 @@ p_compile_dynamic(void)
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage);
} else } else
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
YAPLeaveCriticalSection();
return (FALSE); return (FALSE);
} }
YAPLeaveCriticalSection();
return Yap_unify(ARG5, t); return Yap_unify(ARG5, t);
} }
@ -1508,9 +1511,8 @@ end_consult(void)
if (pred->OpcodeOfPred == INDEX_OPCODE) { if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred(pred); IPred(pred);
/* IPred does the unlocking */ /* IPred does the unlocking */
} else {
WRITE_UNLOCK(pred->PRWLock);
} }
WRITE_UNLOCK(pred->PRWLock);
} }
#endif #endif
ConsultSp = ConsultBase; ConsultSp = ConsultBase;
@ -1648,8 +1650,8 @@ p_setspy(void)
} else { } else {
return (FALSE); return (FALSE);
} }
restart_spy:
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
restart_spy:
if (pred->PredFlags & (CPredFlag | SafePredFlag)) { if (pred->PredFlags & (CPredFlag | SafePredFlag)) {
WRITE_UNLOCK(pred->PRWLock); WRITE_UNLOCK(pred->PRWLock);
return (FALSE); return (FALSE);
@ -2990,11 +2992,14 @@ get_pred(Term t1, Term tmod, char *command)
static Int static Int
fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
{ {
LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr); LogUpdClause *cl;
Term rtn; Term rtn;
if (cl == NULL) cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
if (cl == NULL) {
WRITE_UNLOCK(pe->PRWLock);
return FALSE; return FALSE;
}
rtn = MkDBRefTerm((DBRef)cl); rtn = MkDBRefTerm((DBRef)cl);
#if defined(OR) || defined(THREADS) #if defined(OR) || defined(THREADS)
LOCK(cl->ClLock); LOCK(cl->ClLock);
@ -3007,6 +3012,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
TRAIL_CLREF(cl); /* So that fail will erase it */ TRAIL_CLREF(cl); /* So that fail will erase it */
} }
#endif #endif
WRITE_UNLOCK(pe->PRWLock);
if (cl->ClFlags & FactMask) { if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
!Yap_unify(tr, rtn)) !Yap_unify(tr, rtn))
@ -3026,7 +3032,9 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
YENV = ASP; YENV = ASP;
YENV[E_CB] = (CELL) B; YENV[E_CB] = (CELL) B;
} }
READ_LOCK(pe->PRWLock);
P = cl->ClCode; P = cl->ClCode;
READ_UNLOCK(pe->PRWLock);
} }
return TRUE; return TRUE;
} else { } else {
@ -3060,6 +3068,7 @@ p_log_update_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) { if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe); IPred(pe);
} }
@ -3072,16 +3081,20 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE); return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
} }
static Int static Int
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
{ {
LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr); LogUpdClause *cl;
if (cl == NULL) cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
WRITE_UNLOCK(pe->PRWLock);
if (cl == NULL) {
return FALSE; return FALSE;
}
if (cl->ClFlags & FactMask) { if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue))) if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
return FALSE; return FALSE;
@ -3100,7 +3113,9 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
YENV = ASP; YENV = ASP;
YENV[E_CB] = (CELL) B; YENV[E_CB] = (CELL) B;
} }
READ_LOCK(pe->PRWLock);
P = cl->ClCode; P = cl->ClCode;
READ_UNLOCK(pe->PRWLock);
} }
return TRUE; return TRUE;
} else { } else {
@ -3133,6 +3148,7 @@ p_log_update_clause0(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) { if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe); IPred(pe);
} }
@ -3145,15 +3161,18 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE); return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
} }
static Int static Int
fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
{ {
StaticClause *cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr); StaticClause *cl;
Term rtn; Term rtn;
cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
WRITE_UNLOCK(pe->PRWLock);
if (cl == NULL) if (cl == NULL)
return FALSE; return FALSE;
rtn = MkDBRefTerm((DBRef)cl); rtn = MkDBRefTerm((DBRef)cl);
@ -3211,6 +3230,7 @@ p_static_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) { if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe); IPred(pe);
} }
@ -3223,6 +3243,7 @@ p_continue_static_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE); return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
} }

53
C/dbase.c
View File

@ -253,12 +253,12 @@ STATIC_PROTO(DBProp find_int_key, (Int));
#if OS_HANDLES_TR_OVERFLOW #if OS_HANDLES_TR_OVERFLOW
#define db_check_trail(x) #define db_check_trail(x)
#else #else
#define db_check_trail(x) { \ #define db_check_trail(x) { \
if (Unsigned(Yap_TrailTop) == Unsigned(x)) { \ if (Unsigned(tofref) == Unsigned(x)) { \
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { \ if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { \
goto error_tr_overflow; \ goto error_tr_overflow; \
} \ } \
} \ } \
} }
#endif #endif
@ -370,7 +370,7 @@ int Yap_DBTrailOverflow(void)
return(FALSE); return(FALSE);
#endif #endif
#ifdef IDB_LINK_TABLE #ifdef IDB_LINK_TABLE
return((CELL *)lr > (CELL *)Yap_TrailTop - 1024); return((CELL *)lr > (CELL *)tofref - 2048);
#endif #endif
} }
@ -687,6 +687,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
dbentry->NOfRefsTo++; dbentry->NOfRefsTo++;
} }
*--tofref = dbentry; *--tofref = dbentry;
db_check_trail(lr);
/* just continue the loop */ /* just continue the loop */
++ pt0; ++ pt0;
continue; continue;
@ -1340,7 +1341,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
int NOfLinks = 0; int NOfLinks = 0;
#endif #endif
/* place DBRefs in ConsultStack */ /* place DBRefs in ConsultStack */
DBRef *TmpRefBase = (DBRef *)ConsultSp; DBRef *TmpRefBase = (DBRef *)Yap_TrailTop;
CELL *CodeAbs; /* how much code did we find */ CELL *CodeAbs; /* how much code did we find */
int vars_found; int vars_found;
@ -1788,8 +1789,10 @@ record_lu(PredEntry *pe, Term t, int position)
LogUpdClause *cl; LogUpdClause *cl;
int needs_vars = FALSE; int needs_vars = FALSE;
WRITE_LOCK(pe->PRWLock);
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e); ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) { if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) {
WRITE_UNLOCK(pe->PRWLock);
return NULL; /* crash */ return NULL; /* crash */
} }
cl = (LogUpdClause *)((ADDR)x-(UInt)ipc); cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
@ -1810,6 +1813,7 @@ record_lu(PredEntry *pe, Term t, int position)
else else
ipc->opc = Yap_opcode(_unify_idb_term); ipc->opc = Yap_opcode(_unify_idb_term);
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0)); Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
WRITE_UNLOCK(pe->PRWLock);
return cl; return cl;
} }
@ -1825,10 +1829,12 @@ p_rcda(void)
if (!IsVarTerm(Deref(ARG3))) if (!IsVarTerm(Deref(ARG3)))
return (FALSE); return (FALSE);
pe = find_lu_entry(t1); pe = find_lu_entry(t1);
WRITE_LOCK(pe->PRWLock);
restart_record: restart_record:
Yap_Error_Size = 0; Yap_Error_Size = 0;
if (pe) { if (pe) {
LogUpdClause *cl = record_lu(pe, t2, MkFirst); LogUpdClause *cl;
cl = record_lu(pe, t2, MkFirst);
if (cl != NULL) { if (cl != NULL) {
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
cl->ClFlags |= InUseMask; cl->ClFlags |= InUseMask;
@ -2560,6 +2566,7 @@ new_lu_int_key(Int key)
UInt hash_key = (CELL)key % INT_KEYS_SIZE; UInt hash_key = (CELL)key % INT_KEYS_SIZE;
PredEntry *p; PredEntry *p;
Prop p0; Prop p0;
Functor fe;
if (INT_LU_KEYS == NULL) { if (INT_LU_KEYS == NULL) {
init_int_lu_keys(); init_int_lu_keys();
@ -2570,7 +2577,9 @@ new_lu_int_key(Int key)
return NULL; return NULL;
} }
} }
p0 = Yap_NewPredPropByFunctor(Yap_MkFunctor(Yap_FullLookupAtom("$integer"),3),2); fe = Yap_MkFunctor(Yap_FullLookupAtom("$integer"),3);
WRITE_LOCK(fe->FRWLock);
p0 = Yap_NewPredPropByFunctor(fe,2);
p = RepPredProp(p0); p = RepPredProp(p0);
p->NextOfPE = INT_LU_KEYS[hash_key]; p->NextOfPE = INT_LU_KEYS[hash_key];
p->src.IndxId = key; p->src.IndxId = key;
@ -2591,10 +2600,15 @@ new_lu_entry(Term t)
if (IsApplTerm(t)) { if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
WRITE_LOCK(f->FRWLock);
p0 = Yap_NewPredPropByFunctor(f,2); p0 = Yap_NewPredPropByFunctor(f,2);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
p0 = Yap_NewPredPropByAtom(AtomOfTerm(t),2); Atom at = AtomOfTerm(t);
WRITE_LOCK(RepAtom(at)->ARWLock);
p0 = Yap_NewPredPropByAtom(at,2);
} else { } else {
WRITE_LOCK(f->FRWLock);
p0 = Yap_NewPredPropByFunctor(FunctorList,2); p0 = Yap_NewPredPropByFunctor(FunctorList,2);
} }
pe = RepPredProp(p0); pe = RepPredProp(p0);
@ -3808,6 +3822,8 @@ complete_lu_erase(LogUpdClause *clau)
static void static void
EraseLogUpdCl(LogUpdClause *clau) EraseLogUpdCl(LogUpdClause *clau)
{ {
PredEntry *ap = clau->ClPred;
WRITE_LOCK(ap->PRWLock);
/* no need to erase what has been erased */ /* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) { if (!(clau->ClFlags & ErasedMask)) {
@ -3818,22 +3834,22 @@ EraseLogUpdCl(LogUpdClause *clau)
if (clau->ClPrev != NULL) { if (clau->ClPrev != NULL) {
clau->ClPrev->ClNext = clau->ClNext; clau->ClPrev->ClNext = clau->ClNext;
} }
if (clau->ClCode == clau->ClPred->cs.p_code.FirstClause) { if (clau->ClCode == ap->cs.p_code.FirstClause) {
if (clau->ClNext == NULL) { if (clau->ClNext == NULL) {
clau->ClPred->cs.p_code.FirstClause = NULL; ap->cs.p_code.FirstClause = NULL;
} else { } else {
clau->ClPred->cs.p_code.FirstClause = clau->ClNext->ClCode; ap->cs.p_code.FirstClause = clau->ClNext->ClCode;
} }
} }
if (clau->ClCode == clau->ClPred->cs.p_code.LastClause) { if (clau->ClCode == ap->cs.p_code.LastClause) {
if (clau->ClPrev == NULL) { if (clau->ClPrev == NULL) {
clau->ClPred->cs.p_code.LastClause = NULL; ap->cs.p_code.LastClause = NULL;
} else { } else {
clau->ClPred->cs.p_code.LastClause = clau->ClPrev->ClCode; ap->cs.p_code.LastClause = clau->ClPrev->ClCode;
} }
} }
clau->ClFlags |= ErasedMask; clau->ClFlags |= ErasedMask;
clau->ClPred->cs.p_code.NOfClauses--; ap->cs.p_code.NOfClauses--;
#ifdef DEBUG #ifdef DEBUG
{ {
LogUpdClause *er_head = DBErasedList; LogUpdClause *er_head = DBErasedList;
@ -3849,11 +3865,12 @@ EraseLogUpdCl(LogUpdClause *clau)
#endif #endif
/* we are holding a reference to the clause */ /* we are holding a reference to the clause */
clau->ClRefCount++; clau->ClRefCount++;
Yap_RemoveClauseFromIndex(clau->ClPred, clau->ClCode); Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */ /* release the extra reference */
clau->ClRefCount--; clau->ClRefCount--;
} }
complete_lu_erase(clau); complete_lu_erase(clau);
WRITE_UNLOCK(ap->PRWLock);
} }
static void static void

10
C/exec.c
View File

@ -42,21 +42,21 @@ Yap_cp_as_integer(choiceptr cp)
static inline Int static inline Int
CallPredicate(PredEntry *pen, choiceptr cut_pt) { CallPredicate(PredEntry *pen, choiceptr cut_pt) {
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
WRITE_LOCK(pen->PRWLock); WRITE_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))
return(FALSE); return FALSE;
else DEPTH = RESET_DEPTH(); else DEPTH = RESET_DEPTH();
} }
} else if (pen->ModuleOfPred) } else if (pen->ModuleOfPred)
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
CP = P; CP = P;
P = pen->CodeOfPred; P = pen->CodeOfPred;
/* vsc: increment reduction counter at meta-call entry */ /* vsc: increment reduction counter at meta-call entry */

9
C/index.c
View File

@ -4093,10 +4093,12 @@ ExpandIndex(PredEntry *ap) {
Yap_DebugPutc(Yap_c_error_stream,'\n'); Yap_DebugPutc(Yap_c_error_stream,'\n');
} }
#endif #endif
if ((labp = expand_index(ap)) == NULL) if ((labp = expand_index(ap)) == NULL) {
return NULL; return NULL;
if (*labp == FAILCODE) }
if (*labp == FAILCODE) {
return FAILCODE; return FAILCODE;
}
#ifdef DEBUG #ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) { if (Yap_Option['i' - 'a' + 1]) {
Yap_ShowCode(); Yap_ShowCode();
@ -4121,8 +4123,9 @@ ExpandIndex(PredEntry *ap) {
Yap_inform_profiler_of_clause(indx_out, Yap_prof_end, ap); Yap_inform_profiler_of_clause(indx_out, Yap_prof_end, ap);
} }
#endif #endif
if (indx_out == NULL) if (indx_out == NULL) {
return FAILCODE; return FAILCODE;
}
*labp = indx_out; *labp = indx_out;
if (ap->PredFlags & LogUpdatePredFlag) { if (ap->PredFlags & LogUpdatePredFlag) {
/* add to head of current code children */ /* add to head of current code children */

4
C/iopreds.c
View File

@ -2441,7 +2441,9 @@ Yap_CloseStreams (int loud)
Stream[sno].u.socket.domain); Stream[sno].u.socket.domain);
} }
#endif #endif
else if (!(Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f))) else if (Stream[sno].status & InMemory_Stream_f) {
Yap_FreeAtomSpace(Stream[sno].u.mem_string.buf);
} else if (!(Stream[sno].status & Null_Stream_f))
YP_fclose (Stream[sno].u.file.file); YP_fclose (Stream[sno].u.file.file);
else { else {
if (loud) if (loud)

16
C/stdpreds.c
View File

@ -2468,6 +2468,20 @@ p_set_yap_flags(void)
return(TRUE); return(TRUE);
} }
static Int
p_lock_system(void)
{
WRITE_LOCK(BGL);
return TRUE;
}
static Int
p_unlock_system(void)
{
WRITE_UNLOCK(BGL);
return TRUE;
}
#ifndef YAPOR #ifndef YAPOR
static Int static Int
p_default_sequential(void) { p_default_sequential(void) {
@ -2566,6 +2580,8 @@ Yap_InitCPreds(void)
Yap_InitCPred("halt", 1, p_halt, SyncPredFlag); Yap_InitCPred("halt", 1, p_halt, SyncPredFlag);
Yap_InitCPred("halt", 0, p_halt0, SyncPredFlag); Yap_InitCPred("halt", 0, p_halt0, SyncPredFlag);
Yap_InitCPred("$host_type", 1, p_host_type, SyncPredFlag); Yap_InitCPred("$host_type", 1, p_host_type, SyncPredFlag);
Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag);
Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag);
/* basic predicates for the prolog machine tracer */ /* basic predicates for the prolog machine tracer */
/* they are defined in analyst.c */ /* they are defined in analyst.c */
/* Basic predicates for the debugger */ /* Basic predicates for the debugger */

2
C/tracer.c
View File

@ -115,8 +115,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
if (vsc_count < 340000LL)
return;
#ifdef COMMENTED #ifdef COMMENTED
if (port != enter_pred || if (port != enter_pred ||
!pred || !pred ||

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.48 2003-11-21 16:56:20 vsc Exp $ * * version: $Id: Heap.h,v 1.49 2003-12-01 17:27:41 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -45,6 +45,7 @@ typedef struct various_codes {
ADDR heap_top; ADDR heap_top;
struct FREEB *free_blocks; struct FREEB *free_blocks;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t bgl; /* protect long critical regions */
lockvar free_blocks_lock; /* protect the list of free blocks */ lockvar free_blocks_lock; /* protect the list of free blocks */
#endif #endif
#ifdef YAPOR #ifdef YAPOR
@ -587,6 +588,7 @@ typedef struct various_codes {
#define DeadClauses heap_regs->dead_clauses #define DeadClauses heap_regs->dead_clauses
#define SizeOfOverflow heap_regs->size_of_overflow #define SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime #define LastWtimePtr heap_regs->last_wtime
#define BGL heap_regs->bgl
#define FreeBlocks heap_regs->free_blocks #define FreeBlocks heap_regs->free_blocks
#ifdef COROUTINING #ifdef COROUTINING
#define WakeUpCode heap_regs->wake_up_code #define WakeUpCode heap_regs->wake_up_code

2
m4/Yatom.h.m4
View File

@ -514,7 +514,7 @@ PredPropByFunc(Functor f, SMALLUNSGN cur_mod)
PredEntry *p = RepPredProp(p0); PredEntry *p = RepPredProp(p0);
if (/* p->KindOfPE != 0 || only props */ if (/* p->KindOfPE != 0 || only props */
(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) { (p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
WRITE_UNLOCK(f->FRWLock); WRITE_UNLOCK(fe->FRWLock);
return (p0); return (p0);
} }
p0 = p->NextOfPE; p0 = p->NextOfPE;

26
pl/boot.yap
View File

@ -233,7 +233,7 @@ repeat :- '$repeat'.
'$execute_command'(C,VL,Con). '$execute_command'(C,VL,Con).
'$command'(C,VL,Con) :- '$command'(C,VL,Con) :-
( (Con = top ; var(C) ; C = [_|_]) -> ( (Con = top ; var(C) ; C = [_|_]) ->
'$execute_command'(C,VL,Con) ; '$execute_command'(C,VL,Con), ! ;
expand_term(C, EC), expand_term(C, EC),
'$execute_commands'(EC,VL,Con) '$execute_commands'(EC,VL,Con)
). ).
@ -421,7 +421,11 @@ repeat :- '$repeat'.
'$another', '$another',
!, fail ; !, fail ;
'$do_stop_creep', '$do_stop_creep',
'$present_answer'(_, no), ( '$undefined'('$print_message'(_,_),prolog) ->
'$present_answer'(user_error,"no~n", [])
;
print_message(help,no)
),
fail fail
). ).
@ -438,7 +442,11 @@ repeat :- '$repeat'.
fail. fail.
'$yes_no'(_,_) :- '$yes_no'(_,_) :-
'$do_stop_creep', '$do_stop_creep',
'$present_answer'(_, no), ( '$undefined'('$print_message'(_,_),prolog) ->
'$present_answer'(user_error,"no~n", [])
;
print_message(help,no)
),
fail. fail.
% make sure we have Prolog code to force running any delayed goals. % make sure we have Prolog code to force running any delayed goals.
@ -496,7 +504,11 @@ repeat :- '$repeat'.
fail fail
; ;
C== 10 -> '$add_nl_outside_console', C== 10 -> '$add_nl_outside_console',
'$format'(user_error,"yes~n", []) ( '$undefined'('$print_message'(_,_),prolog) ->
'$format'(user_error,"yes~n", [])
;
print_message(help,yes)
)
; ;
C== -1 -> halt C== -1 -> halt
; ;
@ -857,6 +869,7 @@ break :- get_value('$break',BL), NBL is BL+1,
'$consult'(X), '$consult'(X),
'$change_module'(M0). '$change_module'(M0).
'$consult'(X) :- '$consult'(X) :-
'$lock_system',
'$find_in_path'(X,Y,consult(X)), '$find_in_path'(X,Y,consult(X)),
'$open'(Y,'$csult',Stream,0), !, '$open'(Y,'$csult',Stream,0), !,
'$current_module'(OldModule), '$current_module'(OldModule),
@ -883,6 +896,7 @@ break :- get_value('$break',BL), NBL is BL+1,
get_value('$consulting',Old), get_value('$consulting',Old),
set_value('$consulting',true), set_value('$consulting',true),
recorda('$initialisation','$',_), recorda('$initialisation','$',_),
'$unlock_system',
( '$undefined'('$print_message'(_,_),prolog) -> ( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) -> ( get_value('$verbose',on) ->
'$format'(user_error, "~*|[ consulting ~w... ]~n", [LC,F]) '$format'(user_error, "~*|[ consulting ~w... ]~n", [LC,F])
@ -958,7 +972,7 @@ break :- get_value('$break',BL), NBL is BL+1,
prompt('| '), prompt(_,'| '), prompt('| '), prompt(_,'| '),
'$current_module'(OldModule), '$current_module'(OldModule),
'$system_catch'('$enter_command'(Stream,Status), OldModule, Error, '$system_catch'('$enter_command'(Stream,Status), OldModule, Error,
user:'$LoopError'(Error)), user:'$LoopError'(Error, Status)),
!. !.
'$enter_command'(Stream,Status) :- '$enter_command'(Stream,Status) :-
@ -1134,7 +1148,7 @@ throw(Ball) :-
erase(R), erase(R),
G \= '$', G \= '$',
'$current_module'(M), '$current_module'(M),
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error)), '$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
fail. fail.
'$exec_initialisation_goals'. '$exec_initialisation_goals'.

2
pl/directives.yap
View File

@ -44,7 +44,7 @@
'$exec_directive'(multifile(D), _, M) :- '$exec_directive'(multifile(D), _, M) :-
'$system_catch'('$multifile'(D, M), M, '$system_catch'('$multifile'(D, M), M,
Error, Error,
user:'$LoopError'(Error)). user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M) :- '$exec_directive'(discontiguous(D), _, M) :-
'$discontiguous'(D,M). '$discontiguous'(D,M).
'$exec_directive'(initialization(D), _, M) :- '$exec_directive'(initialization(D), _, M) :-

26
pl/errors.yap
View File

@ -20,26 +20,28 @@
throw(error(Type,[Message|local_sp(Message,Envs,CPs)])). throw(error(Type,[Message|local_sp(Message,Envs,CPs)])).
'$Error'(E) :- '$Error'(E) :-
'$LoopError'(E). '$LoopError'(E,top).
'$LoopError'(_) :- '$LoopError'(_, _) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
fail. fail.
'$LoopError'(Error) :- !, '$LoopError'(Error, Level) :- !,
'$process_error'(Error), '$process_error'(Error, Level),
fail. fail.
'$LoopError'(_) :- '$LoopError'(_, _) :-
current_stream(_, write, S), current_stream(_, write, S),
flush_all_streams, flush_all_streams,
fail. fail.
'$process_error'(abort) :- !, '$process_error'(abort, top) :- !,
'$format'(user_error,"[ Execution Aborted ]~n",[]). print_message(informational,abort(user)).
'$process_error'(error(Msg, Where)) :- !, '$process_error'(abort, _) :- !,
throw(abort).
'$process_error'(error(Msg, Where), _) :- !,
'$set_fpu_exceptions', '$set_fpu_exceptions',
'$print_message'(error,error(Msg, Where)). '$print_message'(error,error(Msg, Where)).
'$process_error'(Throw) :- '$process_error'(Throw, _) :-
print_message(error,Throw). print_message(error,Throw).
print_message(Level, Mss) :- print_message(Level, Mss) :-
@ -79,6 +81,8 @@ print_message(Level, Mss) :-
'$format'(user_error, "~n", []). '$format'(user_error, "~n", []).
'$do_informational_message'(abort(_)) :- !,
'$format'(user_error, "[ Execution Aborted ]~n", []).
'$do_informational_message'(loading(_,user)) :- !. '$do_informational_message'(loading(_,user)) :- !.
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !, '$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC), '$show_consult_level'(LC),
@ -94,6 +98,10 @@ print_message(Level, Mss) :-
'$format'(user_error," ]~n", []). '$format'(user_error," ]~n", []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'(no) :- !,
'$format'(user_error, "no~n", []).
'$do_print_message'(yes) :- !,
'$format'(user_error, "yes~n", []).
'$do_print_message'(debug(debug)) :- !, '$do_print_message'(debug(debug)) :- !,
'$format'(user_error,"Debug mode on.",[]). '$format'(user_error,"Debug mode on.",[]).
'$do_print_message'(debug(off)) :- !, '$do_print_message'(debug(off)) :- !,