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

36
C/adtdefs.c
View File

@ -143,35 +143,50 @@ LookupAtom(char *atom)
{ /* lookup atom in atom table */
register CELL hash;
register unsigned char *p;
Atom a;
Atom a, na;
AtomEntry *ae;
/* compute hash */
p = (unsigned char *)atom;
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;
/* search atom in chain */
a = SearchAtom((unsigned char *)atom, a);
if (a != NIL) {
WRITE_UNLOCK(HashChain[hash].AERWLock);
return(a);
na = SearchAtom((unsigned char *)atom, a);
if (na != NIL) {
READ_UNLOCK(HashChain[hash].AERWLock);
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++;
/* add new atom to start of chain */
ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1);
a = AbsAtom(ae);
na = AbsAtom(ae);
ae->PropsOfAE = NIL;
if (ae->StrOfAE != atom)
strcpy(ae->StrOfAE, atom);
ae->NextOfAE = HashChain[hash].Entry;
HashChain[hash].Entry = a;
ae->NextOfAE = a;
HashChain[hash].Entry = na;
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock);
if (NOfAtoms > 2*AtomHashTableSize) {
CreepFlag = Unsigned(LCL0+1);
}
return (a);
return na;
}
Atom
@ -454,6 +469,7 @@ Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
return (p0);
}
/* fe is supposed to be locked */
Prop
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;
}
pass_no = 1;
YAPEnterCriticalSection();
{
size =
(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;
h0 = H;
H = (CELL *)freep;
break;
default:
return NULL;
}
@ -2705,7 +2705,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
entry_code = do_pass();
/* make sure we copy after second pass */
cl->usc.ClSource = x;
YAPLeaveCriticalSection();
#ifdef LOW_PROF
Yap_prof_end=code_p;
#endif
@ -2719,7 +2718,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
}
}
entry_code = do_pass();
YAPLeaveCriticalSection();
#ifdef LOW_PROF
Yap_prof_end=code_p;
#endif

47
C/cdmgr.c
View File

@ -145,7 +145,7 @@ static_in_use(PredEntry *p, int check_everything)
#define ByteAdr(X) ((Int) &(X))
/* 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
IPred(PredEntry *ap)
{
@ -192,7 +192,6 @@ IPred(PredEntry *ap)
#endif
/* Do not try to index a dynamic predicate or one whithout args */
if (is_dynamic(ap)) {
WRITE_UNLOCK(ap->PRWLock);
Yap_Error(SYSTEM_ERROR,TermNil,"trying to index a dynamic predicate");
return;
}
@ -207,7 +206,6 @@ IPred(PredEntry *ap)
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
ap->OpcodeOfPred = ((yamop *)(ap->CodeOfPred))->opc;
}
WRITE_UNLOCK(ap->PRWLock);
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1])
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);
break;
default:
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code");
ipc = NULL;
Yap_Error(SYSTEM_ERROR,TermNil,"Bug in Indexing Code: opcode %d", op);
}
}
}
@ -1379,12 +1376,15 @@ p_compile(void)
return (FALSE);
if (IsVarTerm(t3) || !IsAtomTerm(t3))
return (FALSE);
mod = Yap_LookupModule(t3);
YAPEnterCriticalSection();
codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments
to cclause in case there is overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */
if (!Yap_ErrorMessage)
addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod);
YAPLeaveCriticalSection();
if (Yap_ErrorMessage) {
if (IntOfTerm(t1) & 4) {
Yap_Error(Yap_Error_TYPE, Yap_Error_Term,
@ -1413,6 +1413,7 @@ p_compile_dynamic(void)
old_optimize = optimizer_on;
optimizer_on = FALSE;
mod = Yap_LookupModule(t3);
YAPEnterCriticalSection();
code_adr = Yap_cclause(t, 3, mod, Deref(ARG3)); /* vsc: give the number of arguments to
cclause() in case there is a 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);
} else
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
YAPLeaveCriticalSection();
return (FALSE);
}
YAPLeaveCriticalSection();
return Yap_unify(ARG5, t);
}
@ -1508,9 +1511,8 @@ end_consult(void)
if (pred->OpcodeOfPred == INDEX_OPCODE) {
IPred(pred);
/* IPred does the unlocking */
} else {
WRITE_UNLOCK(pred->PRWLock);
}
WRITE_UNLOCK(pred->PRWLock);
}
#endif
ConsultSp = ConsultBase;
@ -1648,8 +1650,8 @@ p_setspy(void)
} else {
return (FALSE);
}
restart_spy:
WRITE_LOCK(pred->PRWLock);
restart_spy:
if (pred->PredFlags & (CPredFlag | SafePredFlag)) {
WRITE_UNLOCK(pred->PRWLock);
return (FALSE);
@ -2990,11 +2992,14 @@ get_pred(Term t1, Term tmod, char *command)
static Int
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;
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;
}
rtn = MkDBRefTerm((DBRef)cl);
#if defined(OR) || defined(THREADS)
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 */
}
#endif
WRITE_UNLOCK(pe->PRWLock);
if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
!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[E_CB] = (CELL) B;
}
READ_LOCK(pe->PRWLock);
P = cl->ClCode;
READ_UNLOCK(pe->PRWLock);
}
return TRUE;
} else {
@ -3060,6 +3068,7 @@ p_log_update_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
}
@ -3072,16 +3081,20 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
}
static Int
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;
}
if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
return FALSE;
@ -3100,7 +3113,9 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
READ_LOCK(pe->PRWLock);
P = cl->ClCode;
READ_UNLOCK(pe->PRWLock);
}
return TRUE;
} else {
@ -3133,6 +3148,7 @@ p_log_update_clause0(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
}
@ -3145,15 +3161,18 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
}
static Int
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;
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)
return FALSE;
rtn = MkDBRefTerm((DBRef)cl);
@ -3211,6 +3230,7 @@ p_static_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
}
@ -3223,6 +3243,7 @@ p_continue_static_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
WRITE_LOCK(pe->PRWLock);
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
#define db_check_trail(x)
#else
#define db_check_trail(x) { \
if (Unsigned(Yap_TrailTop) == Unsigned(x)) { \
#define db_check_trail(x) { \
if (Unsigned(tofref) == Unsigned(x)) { \
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { \
goto error_tr_overflow; \
} \
} \
goto error_tr_overflow; \
} \
} \
}
#endif
@ -370,7 +370,7 @@ int Yap_DBTrailOverflow(void)
return(FALSE);
#endif
#ifdef IDB_LINK_TABLE
return((CELL *)lr > (CELL *)Yap_TrailTop - 1024);
return((CELL *)lr > (CELL *)tofref - 2048);
#endif
}
@ -687,6 +687,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
dbentry->NOfRefsTo++;
}
*--tofref = dbentry;
db_check_trail(lr);
/* just continue the loop */
++ pt0;
continue;
@ -1340,7 +1341,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
int NOfLinks = 0;
#endif
/* place DBRefs in ConsultStack */
DBRef *TmpRefBase = (DBRef *)ConsultSp;
DBRef *TmpRefBase = (DBRef *)Yap_TrailTop;
CELL *CodeAbs; /* how much code did we find */
int vars_found;
@ -1788,8 +1789,10 @@ record_lu(PredEntry *pe, Term t, int position)
LogUpdClause *cl;
int needs_vars = FALSE;
WRITE_LOCK(pe->PRWLock);
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc)) == NULL) {
WRITE_UNLOCK(pe->PRWLock);
return NULL; /* crash */
}
cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
@ -1810,6 +1813,7 @@ record_lu(PredEntry *pe, Term t, int position)
else
ipc->opc = Yap_opcode(_unify_idb_term);
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
WRITE_UNLOCK(pe->PRWLock);
return cl;
}
@ -1825,10 +1829,12 @@ p_rcda(void)
if (!IsVarTerm(Deref(ARG3)))
return (FALSE);
pe = find_lu_entry(t1);
WRITE_LOCK(pe->PRWLock);
restart_record:
Yap_Error_Size = 0;
if (pe) {
LogUpdClause *cl = record_lu(pe, t2, MkFirst);
LogUpdClause *cl;
cl = record_lu(pe, t2, MkFirst);
if (cl != NULL) {
TRAIL_CLREF(cl);
cl->ClFlags |= InUseMask;
@ -2560,6 +2566,7 @@ new_lu_int_key(Int key)
UInt hash_key = (CELL)key % INT_KEYS_SIZE;
PredEntry *p;
Prop p0;
Functor fe;
if (INT_LU_KEYS == NULL) {
init_int_lu_keys();
@ -2570,7 +2577,9 @@ new_lu_int_key(Int key)
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->NextOfPE = INT_LU_KEYS[hash_key];
p->src.IndxId = key;
@ -2591,10 +2600,15 @@ new_lu_entry(Term t)
if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
WRITE_LOCK(f->FRWLock);
p0 = Yap_NewPredPropByFunctor(f,2);
} 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 {
WRITE_LOCK(f->FRWLock);
p0 = Yap_NewPredPropByFunctor(FunctorList,2);
}
pe = RepPredProp(p0);
@ -3808,6 +3822,8 @@ complete_lu_erase(LogUpdClause *clau)
static void
EraseLogUpdCl(LogUpdClause *clau)
{
PredEntry *ap = clau->ClPred;
WRITE_LOCK(ap->PRWLock);
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
@ -3818,22 +3834,22 @@ EraseLogUpdCl(LogUpdClause *clau)
if (clau->ClPrev != NULL) {
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) {
clau->ClPred->cs.p_code.FirstClause = NULL;
ap->cs.p_code.FirstClause = NULL;
} 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) {
clau->ClPred->cs.p_code.LastClause = NULL;
ap->cs.p_code.LastClause = NULL;
} else {
clau->ClPred->cs.p_code.LastClause = clau->ClPrev->ClCode;
ap->cs.p_code.LastClause = clau->ClPrev->ClCode;
}
}
clau->ClFlags |= ErasedMask;
clau->ClPred->cs.p_code.NOfClauses--;
ap->cs.p_code.NOfClauses--;
#ifdef DEBUG
{
LogUpdClause *er_head = DBErasedList;
@ -3849,11 +3865,12 @@ EraseLogUpdCl(LogUpdClause *clau)
#endif
/* we are holding a reference to the clause */
clau->ClRefCount++;
Yap_RemoveClauseFromIndex(clau->ClPred, clau->ClCode);
Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */
clau->ClRefCount--;
}
complete_lu_erase(clau);
WRITE_UNLOCK(ap->PRWLock);
}
static void

10
C/exec.c
View File

@ -42,21 +42,21 @@ Yap_cp_as_integer(choiceptr cp)
static inline Int
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);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
return(FALSE);
return FALSE;
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#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;
P = pen->CodeOfPred;
/* 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');
}
#endif
if ((labp = expand_index(ap)) == NULL)
if ((labp = expand_index(ap)) == NULL) {
return NULL;
if (*labp == FAILCODE)
}
if (*labp == FAILCODE) {
return FAILCODE;
}
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Yap_ShowCode();
@ -4121,8 +4123,9 @@ ExpandIndex(PredEntry *ap) {
Yap_inform_profiler_of_clause(indx_out, Yap_prof_end, ap);
}
#endif
if (indx_out == NULL)
if (indx_out == NULL) {
return FAILCODE;
}
*labp = indx_out;
if (ap->PredFlags & LogUpdatePredFlag) {
/* 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);
}
#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);
else {
if (loud)

16
C/stdpreds.c
View File

@ -2468,6 +2468,20 @@ p_set_yap_flags(void)
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
static Int
p_default_sequential(void) {
@ -2566,6 +2580,8 @@ Yap_InitCPreds(void)
Yap_InitCPred("halt", 1, p_halt, SyncPredFlag);
Yap_InitCPred("halt", 0, p_halt0, 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 */
/* they are defined in analyst.c */
/* 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; */
vsc_count++;
if (vsc_count < 340000LL)
return;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* 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 */
@ -45,6 +45,7 @@ typedef struct various_codes {
ADDR heap_top;
struct FREEB *free_blocks;
#if defined(YAPOR) || defined(THREADS)
rwlock_t bgl; /* protect long critical regions */
lockvar free_blocks_lock; /* protect the list of free blocks */
#endif
#ifdef YAPOR
@ -587,6 +588,7 @@ typedef struct various_codes {
#define DeadClauses heap_regs->dead_clauses
#define SizeOfOverflow heap_regs->size_of_overflow
#define LastWtimePtr heap_regs->last_wtime
#define BGL heap_regs->bgl
#define FreeBlocks heap_regs->free_blocks
#ifdef COROUTINING
#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);
if (/* p->KindOfPE != 0 || only props */
(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
WRITE_UNLOCK(f->FRWLock);
WRITE_UNLOCK(fe->FRWLock);
return (p0);
}
p0 = p->NextOfPE;

26
pl/boot.yap
View File

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

2
pl/directives.yap
View File

@ -44,7 +44,7 @@
'$exec_directive'(multifile(D), _, M) :-
'$system_catch'('$multifile'(D, M), M,
Error,
user:'$LoopError'(Error)).
user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M) :-
'$discontiguous'(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)])).
'$Error'(E) :-
'$LoopError'(E).
'$LoopError'(E,top).
'$LoopError'(_) :-
'$LoopError'(_, _) :-
flush_output(user_output),
flush_output(user_error),
fail.
'$LoopError'(Error) :- !,
'$process_error'(Error),
'$LoopError'(Error, Level) :- !,
'$process_error'(Error, Level),
fail.
'$LoopError'(_) :-
'$LoopError'(_, _) :-
current_stream(_, write, S),
flush_all_streams,
fail.
'$process_error'(abort) :- !,
'$format'(user_error,"[ Execution Aborted ]~n",[]).
'$process_error'(error(Msg, Where)) :- !,
'$process_error'(abort, top) :- !,
print_message(informational,abort(user)).
'$process_error'(abort, _) :- !,
throw(abort).
'$process_error'(error(Msg, Where), _) :- !,
'$set_fpu_exceptions',
'$print_message'(error,error(Msg, Where)).
'$process_error'(Throw) :-
'$process_error'(Throw, _) :-
print_message(error,Throw).
print_message(Level, Mss) :-
@ -79,6 +81,8 @@ print_message(Level, Mss) :-
'$format'(user_error, "~n", []).
'$do_informational_message'(abort(_)) :- !,
'$format'(user_error, "[ Execution Aborted ]~n", []).
'$do_informational_message'(loading(_,user)) :- !.
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC),
@ -94,6 +98,10 @@ print_message(Level, Mss) :-
'$format'(user_error," ]~n", []).
%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)) :- !,
'$format'(user_error,"Debug mode on.",[]).
'$do_print_message'(debug(off)) :- !,