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

more thread fixes

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@997 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-02-19 19:24:46 +00:00
parent d3f49b75df
commit 026bfb3c18
13 changed files with 267 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
C/absmi.c
View File

@ -1081,6 +1081,11 @@ Yap_absmi(int inp)
#if defined(YAPOR) || defined(THREADS)
PP = PREG->u.p.p;
READ_LOCK(PP->PRWLock);
if (PP->cs.p_code.TrueCodeOfPred != PREG) {
PREG = PP->cs.p_code.TrueCodeOfPred;
READ_UNLOCK(PP->PRWLock);
GONext();
}
#endif
PREG = NEXTOP(PREG, p);
GONext();
@ -1102,7 +1107,6 @@ Yap_absmi(int inp)
/* enter logical pred */
BOp(stale_lu_index, Ill);
saveregs();
{
yamop *ipc;
@ -1112,17 +1116,18 @@ Yap_absmi(int inp)
ASP = (CELL *) B;
}
#if defined(YAPOR) || defined(THREADS)
LOCK(pe->PELock);
LOCK(PREG->u.Ill.l1->u.ld.p->PELock);
if (*PREG_ADDR != PREG) {
PREG = *PREG_ADDR;
UNLOCK(pe->PELock);
UNLOCK(PREG->u.Ill.l1->u.ld.p->PELock);
JMPNext();
}
#endif
saveregs();
ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
READ_UNLOCK(pe->PRWLock);
/* restart index */
setregs();
UNLOCK(PREG->u.Ill.l1->u.ld.p->PELock);
/* restart index */
PREG = ipc;
if (PREG == NULL) FAIL();
CACHED_A1() = ARG1;
@ -6357,19 +6362,19 @@ Yap_absmi(int inp)
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
saveregs();
#if defined(YAPOR) || defined(THREADS)
LOCK(pe->PELock);
if (*PREG_ADDR != PREG)) {
if (*PREG_ADDR != PREG) {
PREG = *PREG_ADDR;
UNLOCK(pe->PELock);
JMPNext();
}
#endif
saveregs();
pt0 = Yap_ExpandIndex(pe);
/* restart index */
UNLOCK(pe->PELock);
setregs();
UNLOCK(pe->PELock);
PREG = pt0;
JMPNext();
}

3
C/adtdefs.c
View File

@ -187,6 +187,9 @@ LookupAtom(char *atom)
if (NOfAtoms > 2*AtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL);
}
{extern int vsc_xstop;
if (ae == 0x81cf80c) vsc_xstop = 1;
}
return na;
}

14
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.45 2004-02-11 01:20:56 vsc Exp $ *
* version:$Id: alloc.c,v 1.46 2004-02-19 19:24:44 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -185,6 +185,17 @@ Yap_InitExStacks(int Trail, int Stack)
InitExStacks(Trail, Stack);
}
#if defined(YAPOR) || defined(THREADS)
void
Yap_KillStacks(int wid)
{
ADDR gb = Yap_thread_gl[worker_id].global_base;
if (gb) {
free(gb);
Yap_thread_gl[wid].global_base = NULL;
}
}
#else
void
Yap_KillStacks(void)
{
@ -193,6 +204,7 @@ Yap_KillStacks(void)
Yap_GlobalBase = NULL;
}
}
#endif
void
Yap_InitMemory(int Trail, int Heap, int Stack)

1
C/amasm.c
View File

@ -1170,6 +1170,7 @@ init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u)
ic->ChildIndex = NULL;
ic->ClRefCount = 0;
ic->u.ParentIndex = (LogUpdIndex *)cl_u;
INIT_LOCK(ic->ClLock);
cl_u->lui.ChildIndex = ic;
cl_u->lui.ClRefCount++;
}

152
C/cdmgr.c
View File

@ -254,9 +254,18 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc)
!(cl->ClRefCount) &&
!(cl->ClFlags & InUseMask)) {
/* last ref to the clause */
#if defined(YAPOR) || defined(THREADS)
/* can't do erase now without risking deadlocks */
cl->ClRefCount++;
TRAIL_CLREF(cl);
UNLOCK(cl->ClLock);
#else
UNLOCK(cl->ClLock);
Yap_ErLogUpdCl(cl);
#endif
} else {
UNLOCK(cl->ClLock);
}
UNLOCK(cl->ClLock);
}
}
@ -402,10 +411,13 @@ kill_static_child_indxs(StaticIndex *indx)
static void
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
{
LogUpdIndex *ncl = c->ChildIndex;
LogUpdIndex *ncl;
/* parent is always locked, now I lock myself */
LOCK(c->ClLock);
if (parent != NULL &&
!(c->ClFlags & ErasedMask)) {
/* remove myself from parent */
if (c == parent->ChildIndex) {
parent->ChildIndex = c->SiblingIndex;
} else {
@ -418,6 +430,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
}
/* make sure that a child cannot remove us */
c->ClRefCount++;
ncl = c->ChildIndex;
while (ncl != NULL) {
LogUpdIndex *next = ncl->SiblingIndex;
kill_first_log_iblock(ncl, c, ap);
@ -429,21 +442,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
RemoveMainIndex(ap);
}
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
if (parent != NULL) {
parent->ClRefCount--;
if (parent->ClFlags & ErasedMask &&
!(parent->ClFlags & InUseMask) &&
parent->ClRefCount == 0) {
/* cool, I can erase the father too. */
if (parent->ClFlags & SwitchRootMask) {
kill_first_log_iblock(parent, NULL, ap);
} else {
kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
}
}
}
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
#ifdef DEBUG
{
LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
@ -457,6 +456,27 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
}
}
#endif
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
if (parent != NULL) {
parent->ClRefCount--;
if (parent->ClFlags & ErasedMask &&
!(parent->ClFlags & InUseMask) &&
parent->ClRefCount == 0) {
/* cool, I can erase the father too. */
if (parent->ClFlags & SwitchRootMask) {
UNLOCK(parent->ClLock);
kill_first_log_iblock(parent, NULL, ap);
LOCK(parent->ClLock);
} else {
LOCK(parent->u.ParentIndex->ClLock);
UNLOCK(parent->ClLock);
kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
LOCK(parent->ClLock);
UNLOCK(parent->u.ParentIndex->ClLock);
}
}
}
UNLOCK(c->ClLock);
Yap_FreeCodeSpace((CODEADDR)c);
} else {
#ifdef DEBUG
@ -464,6 +484,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
DBErasedIList = c;
#endif
c->ClFlags |= ErasedMask;
#if !defined(THREADS) && !defined(YAPOR)
/* try to move up, so that we don't hold an index */
if (parent != NULL &&
parent->ClFlags & SwitchTableMask) {
@ -471,7 +492,9 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
parent->u.ParentIndex->ClRefCount++;
parent->ClRefCount--;
}
#endif
c->ChildIndex = NULL;
UNLOCK(c->ClLock);
}
}
@ -489,7 +512,9 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap)
LogUpdIndex *c = (LogUpdIndex *)blk;
if (parent_blk != NULL) {
LogUpdIndex *cl = (LogUpdIndex *)parent_blk;
LOCK(cl->ClLock);
kill_first_log_iblock(c, cl, ap);
UNLOCK(cl->ClLock);
} else {
kill_first_log_iblock(c, NULL, ap);
}
@ -518,18 +543,28 @@ void
Yap_ErLogUpdIndex(LogUpdIndex *clau)
{
LogUpdIndex *c = clau;
if (clau->ClFlags & ErasedMask) {
/* nothing I can do, I have been erased already */
return;
}
if (c->ClFlags & SwitchRootMask) {
kill_first_log_iblock(clau, NULL, c->u.pred);
} else {
while (!(c->ClFlags & SwitchRootMask))
c = c->u.ParentIndex;
LOCK(clau->u.ParentIndex->ClLock);
kill_first_log_iblock(clau, clau->u.ParentIndex, c->u.pred);
UNLOCK(clau->u.ParentIndex->ClLock);
}
}
void
Yap_RemoveLogUpdIndex(LogUpdIndex *cl)
{
if (cl->ClFlags & ErasedMask) {
/* nothing I can do, I have been erased already */
return;
}
if (cl->ClFlags & SwitchRootMask) {
kill_first_log_iblock(cl, NULL, cl->u.pred);
} else {
@ -537,7 +572,9 @@ Yap_RemoveLogUpdIndex(LogUpdIndex *cl)
while (!(pcl->ClFlags & SwitchRootMask)) {
pcl = pcl->u.ParentIndex;
}
LOCK(cl->u.ParentIndex->ClLock);
kill_first_log_iblock(cl, cl->u.ParentIndex, pcl->u.pred);
UNLOCK(cl->u.ParentIndex->ClLock);
}
}
@ -3051,7 +3088,6 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
if (cl == NULL) {
READ_UNLOCK(pe->PRWLock);
return FALSE;
}
rtn = MkDBRefTerm((DBRef)cl);
@ -3066,7 +3102,9 @@ 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
READ_UNLOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
WPP = NULL;
#endif
if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
!Yap_unify(tr, rtn))
@ -3118,15 +3156,33 @@ p_log_update_clause(void)
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
READ_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
WRITE_LOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
if (pe->OpcodeOfPred == INDEX_OPCODE)
#endif
IPred(pe);
WRITE_UNLOCK(pe->PRWLock);
}
return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
#if defined(YAPOR) || defined(THREADS)
if (PP != pe) {
READ_LOCK(pe->PRWLock);
PP = pe;
}
#endif
ret = fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
#if defined(YAPOR) || defined(THREADS)
if (PP == pe) {
PP = NULL;
READ_UNLOCK(pe->PRWLock);
}
#endif
return ret;
}
static Int /* $hidden_predicate(P) */
@ -3135,7 +3191,6 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
READ_LOCK(pe->PRWLock);
return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
}
@ -3145,7 +3200,6 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
LogUpdClause *cl;
cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
READ_UNLOCK(pe->PRWLock);
if (cl == NULL) {
return FALSE;
}
@ -3198,15 +3252,31 @@ p_log_update_clause0(void)
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Int ret;
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
READ_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
#if defined(YAPOR) || defined(THREADS)
if (pe->OpcodeOfPred == INDEX_OPCODE)
#endif
IPred(pe);
}
return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
#if defined(YAPOR) || defined(THREADS)
if (PP != pe) {
READ_LOCK(pe->PRWLock);
PP = pe;
}
#endif
ret = fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
#if defined(YAPOR) || defined(THREADS)
if (PP == pe) {
PP = NULL;
READ_UNLOCK(pe->PRWLock);
}
#endif
return ret;
}
static Int /* $hidden_predicate(P) */
@ -3215,7 +3285,6 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
READ_LOCK(pe->PRWLock);
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
}
@ -3284,7 +3353,12 @@ p_static_clause(void)
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
WRITE_LOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
if (pe->OpcodeOfPred == INDEX_OPCODE)
#endif
IPred(pe);
WRITE_UNLOCK(pe->PRWLock);
}
return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
}
@ -3304,21 +3378,9 @@ p_nth_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
if(pe->OpcodeOfPred == INDEX_OPCODE) {
WRITE_LOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
}
WRITE_UNLOCK(pe->PRWLock);
}
READ_LOCK(pe->PRWLock);
if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
READ_UNLOCK(pe->PRWLock);
return FALSE;
}
if (pe->PredFlags & SourcePredFlag) {
READ_UNLOCK(pe->PRWLock);
}
/* in case we have to index or to expand code */
if (pe->ModuleOfPred != IDB_MODULE) {
UInt i;
@ -3329,11 +3391,11 @@ p_nth_clause(void)
} else {
XREGS[2] = MkVarTerm();
}
cl = Yap_NthClause(pe, ncls);
if (pe->PredFlags & LogUpdatePredFlag) {
READ_UNLOCK(pe->PRWLock);
if(pe->OpcodeOfPred == INDEX_OPCODE) {
IPred(pe);
}
if (cl == NULL)
cl = Yap_NthClause(pe, ncls);
if (cl == NULL)
return FALSE;
if (cl->ClFlags & LogUpdatePredFlag) {
#if defined(YAPOR) || defined(THREADS)

26
C/dbase.c
View File

@ -1520,19 +1520,12 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return(NULL);
}
/* restore lr to NULL in case there is a TR overflow */
dbg->lr = NULL;
#endif
if ((InFlag & MkIfNot) && (dbg->found_one = check_if_wvars(p->First, NOfCells, ntp0))) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return dbg->found_one;
}
} else {
#ifdef IDB_LINK_TABLE
/* make sure lr ends in 0 for check_if_nvars */
/* restore lr to NULL in case there is a TR overflow */
dbg->lr = NULL;
#endif
flag = DBNoVars;
if ((InFlag & MkIfNot) && (dbg->found_one = check_if_nvars(p->First, NOfCells, ntp0, dbg))) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
@ -3856,12 +3849,10 @@ complete_lu_erase(LogUpdClause *clau)
static void
EraseLogUpdCl(LogUpdClause *clau)
{
PredEntry *ap = clau->ClPred;
#if defined(YAPOR) || defined(THREADS)
if (WPP != ap) {
WRITE_LOCK(ap->PRWLock);
}
#endif
PredEntry *ap;
LOCK(clau->ClLock);
ap = clau->ClPred;
WRITE_LOCK(ap->PRWLock);
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
@ -3903,16 +3894,15 @@ EraseLogUpdCl(LogUpdClause *clau)
#endif
/* we are holding a reference to the clause */
clau->ClRefCount++;
UNLOCK(clau->ClLock);
Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */
LOCK(clau->ClLock);
clau->ClRefCount--;
}
complete_lu_erase(clau);
#if defined(YAPOR) || defined(THREADS)
if (WPP != ap) {
WRITE_UNLOCK(ap->PRWLock);
}
#endif
UNLOCK(clau->ClLock);
WRITE_UNLOCK(ap->PRWLock);
}
static void

65
C/index.c
View File

@ -4129,7 +4129,8 @@ expand_index(struct intermediates *cint) {
lab = do_index(cls, max, cint, argno+1, fail_l, isfirstcl, clleft, top);
}
}
*labp = (yamop *)lab; /* in case we have a single clause */
if (labp)
*labp = (yamop *)lab; /* in case we have a single clause */
return labp;
}
@ -4170,8 +4171,7 @@ ExpandIndex(PredEntry *ap) {
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
}
UNLOCK(ap->PELock);
return NULL;
return FAILCODE;
}
}
restart_index:
@ -4214,11 +4214,9 @@ ExpandIndex(PredEntry *ap) {
}
#endif
if ((labp = expand_index(&cint)) == NULL) {
UNLOCK(ap->PELock);
return NULL;
return FAILCODE;
}
if (*labp == FAILCODE) {
UNLOCK(ap->PELock);
return FAILCODE;
}
#ifdef DEBUG
@ -4232,21 +4230,18 @@ ExpandIndex(PredEntry *ap) {
if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint)) == NULL) {
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
UNLOCK(ap->PELock);
return NULL;
return FAILCODE;
}
goto restart_index;
}
} else {
/* single case */
UNLOCK(ap->PELock);
return *labp;
}
if (ProfilerOn) {
Yap_inform_profiler_of_clause(indx_out, ProfEnd, ap);
}
if (indx_out == NULL) {
UNLOCK(ap->PELock);
return FAILCODE;
}
*labp = indx_out;
@ -4268,7 +4263,6 @@ ExpandIndex(PredEntry *ap) {
nic->SiblingIndex = ic->ChildIndex;
ic->ChildIndex = nic;
}
UNLOCK(ap->PELock);
return indx_out;
}
@ -4749,12 +4743,23 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
if (op != _try_clause) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
if (compact_mode) {
LOCK(tgl->ClLock);
tgl->ClRefCount--;
if (tgl->ClFlags & ErasedMask &&
!(tgl->ClRefCount) &&
!(tgl->ClFlags & InUseMask)) {
#if defined(YAPOR) || defined(THREADS)
/* can't do erase now without risking deadlocks */
tgl->ClRefCount++;
TRAIL_CLREF(tgl);
UNLOCK(tgl->ClLock);
#else
/* last ref to the clause */
UNLOCK(tgl->ClLock);
Yap_ErLogUpdCl(tgl);
#endif
} else {
UNLOCK(tgl->ClLock);
}
}
}
@ -4789,12 +4794,23 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
if (compact_mode) {
LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
LOCK(tgl->ClLock);
tgl->ClRefCount--;
if (tgl->ClFlags & ErasedMask &&
!(tgl->ClRefCount) &&
!(tgl->ClFlags & InUseMask)) {
/* last ref to the clause */
#if defined(YAPOR) || defined(THREADS)
/* can't do erase now without risking deadlocks */
tgl->ClRefCount++;
TRAIL_CLREF(tgl);
UNLOCK(tgl->ClLock);
#else
UNLOCK(tgl->ClLock);
Yap_ErLogUpdCl(tgl);
#endif
} else {
UNLOCK(tgl->ClLock);
}
}
ocodep = NEXTOP(ocodep, ld);
@ -6066,6 +6082,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
}
/* clause is locked */
void
Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
ClauseDef cl;
@ -6384,8 +6401,8 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
case _stale_lu_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jbl != ipc) {
ipc = *jbl;
if (*jlbl != ipc) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
@ -6586,14 +6603,14 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
case _expand_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jbl != ipc) {
ipc = *jbl;
if (*jlbl != ipc) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
#endif
ipc = ExpandIndex(ap);
UNLOCK(pe->PELock);
UNLOCK(ap->PELock);
break;
case _op_fail:
/*
@ -6751,8 +6768,8 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _stale_lu_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jbl != ipc) {
ipc = *jbl;
if (*jlbl != ipc) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
@ -6814,9 +6831,9 @@ Yap_NthClause(PredEntry *ap, Int ncls)
case _expand_index:
#if defined(YAPOR) || defined(THREADS)
LOCK(ap->PELock);
if (*jbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
ipc = *jbl;
UNLOCK(pe->PELock);
if (*jlbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
ipc = *jlbl;
UNLOCK(ap->PELock);
break;
}
#endif
@ -6833,12 +6850,6 @@ Yap_NthClause(PredEntry *ap, Int ncls)
break;
case _undef_p:
default:
#if defined(YAPOR) || defined(THREADS)
if (PP == ap) {
PP = NULL;
READ_UNLOCK(ap->PRWLock);
}
#endif
return NULL;
}
}

13
C/stdpreds.c
View File

@ -1661,21 +1661,21 @@ cont_current_atom(void)
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
if (catom != NIL) {
break;
}
READ_UNLOCK(HashChain[i].AERWLock);
i++;
}
if (i == AtomHashTableSize) {
cut_fail();
} else {
READ_UNLOCK(HashChain[i].AERWLock);
}
}
ap = RepAtom(catom);
if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) {
READ_LOCK(ap->ARWLock);
if (ap->NextOfAE == NIL) {
READ_UNLOCK(ap->ARWLock);
i++;
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
@ -1687,19 +1687,18 @@ cont_current_atom(void)
i++;
}
if (i == AtomHashTableSize) {
cut_succeed();
cut_fail();
} else {
EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom);
}
} else {
READ_LOCK(ap->ARWLock);
EXTRA_CBACK_ARG(1,1) = MkAtomTerm(ap->NextOfAE);
READ_UNLOCK(ap->ARWLock);
}
EXTRA_CBACK_ARG(1,2) = MkIntTerm(i);
return(TRUE);
return TRUE;
} else {
return(FALSE);
return FALSE;
}
}

78
C/threads.c
View File

@ -60,32 +60,38 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
Yap_StoreTermInDB(tgoal,4);
ThreadHandle[new_worker_id].cmod =
CurrentModule;
if (IsVarTerm(tdetach))
tdetach = MkAtomTerm(AtomFalse);
ThreadHandle[new_worker_id].tdetach =
tdetach;
if (IsVarTerm(tdetach)){
ThreadHandle[new_worker_id].tdetach =
MkAtomTerm(AtomFalse);
} else {
ThreadHandle[new_worker_id].tdetach =
tdetach;
}
}
static void
thread_die(void)
thread_die(int wid)
{
Prop p0 = AbsPredProp(heap_regs->thread_handle[worker_id].local_preds);
Prop p0;
/* kill all thread local preds */
while(p0) {
PredEntry *ap = RepPredProp(p0);
p0 = ap->NextOfPE;
Yap_Abolish(ap);
Yap_FreeCodeSpace((char *)ap);
}
Yap_KillStacks();
LOCK(ThreadHandlesLock);
ActiveSignals = 0L;
free(ScratchPad.ptr);
free(ThreadHandle[worker_id].default_yaam_regs);
ThreadHandle[worker_id].in_use = FALSE;
pthread_mutex_destroy(&(ThreadHandle[worker_id].tlock));
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue)) {
p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
/* kill all thread local preds */
while(p0) {
PredEntry *ap = RepPredProp(p0);
p0 = ap->NextOfPE;
Yap_Abolish(ap);
Yap_FreeCodeSpace((char *)ap);
}
Yap_KillStacks(wid);
heap_regs->wl[wid].active_signals = 0L;
free(heap_regs->wl[wid].scratchpad.ptr);
free(ThreadHandle[wid].default_yaam_regs);
ThreadHandle[wid].in_use = FALSE;
pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
}
UNLOCK(ThreadHandlesLock);
}
@ -113,7 +119,7 @@ thread_run(void *widp)
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock));
out = Yap_RunTopGoal(tgoal);
thread_die();
thread_die(worker_id);
return NULL;
}
@ -132,6 +138,8 @@ p_create_thread(void)
Term tgoal = Deref(ARG1);
Term tdetach = Deref(ARG5);
int new_worker_id = IntegerOfTerm(Deref(ARG6));
pthread_attr_t at;
if (new_worker_id == -1) {
/* YAP ERROR */
return FALSE;
@ -140,6 +148,8 @@ p_create_thread(void)
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
pthread_mutex_lock(&(ThreadHandle[new_worker_id].tlock));
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
pthread_attr_init(&at);
pthread_attr_setstacksize(&at, 32*4096);
if ((ThreadHandle[new_worker_id].ret = pthread_create(&(ThreadHandle[new_worker_id].handle), NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
return TRUE;
}
@ -156,8 +166,22 @@ p_thread_self(void)
static Int
p_thread_join(void)
{
pthread_t th = ThreadHandle[IntegerOfTerm(Deref(ARG1))].handle;
Int tid = IntegerOfTerm(Deref(ARG1));
pthread_t th;
void *retval;
LOCK(ThreadHandlesLock);
if (!ThreadHandle[tid].in_use) {
UNLOCK(ThreadHandlesLock);
return FALSE;
}
if (!ThreadHandle[tid].tdetach == MkAtomTerm(AtomTrue)) {
UNLOCK(ThreadHandlesLock);
return FALSE;
}
ThreadHandle[tid].tdetach = MkAtomTerm(AtomTrue);
th = ThreadHandle[tid].handle;
UNLOCK(ThreadHandlesLock);
if (pthread_join(th, &retval) < 0) {
/* ERROR */
return FALSE;
@ -165,6 +189,15 @@ p_thread_join(void)
return TRUE;
}
static Int
p_thread_destroy(void)
{
Int tid = IntegerOfTerm(Deref(ARG1));
thread_die(tid);
return TRUE;
}
static Int
p_thread_detach(void)
{
@ -179,7 +212,7 @@ p_thread_detach(void)
static Int
p_thread_exit(void)
{
thread_die();
thread_die(worker_id);
pthread_exit(NULL);
return TRUE;
}
@ -386,6 +419,7 @@ void Yap_InitThreadPreds(void)
Yap_InitCPred("$create_thread", 6, p_create_thread, 0);
Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag);
Yap_InitCPred("$thread_join", 1, p_thread_join, 0);
Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, 0);
Yap_InitCPred("$detach_thread", 1, p_thread_detach, 0);
Yap_InitCPred("$thread_exit", 0, p_thread_exit, 0);
Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0);

12
C/tracer.c
View File

@ -102,7 +102,7 @@ check_trail_consistency(void) {
*/
static int vsc_xstop = FALSE;
int vsc_xstop = FALSE;
CELL old_value = 0L, old_value2 = 0L;
@ -116,7 +116,17 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(heap_regs->low_level_trace_lock);
vsc_count++;
if (vsc_count < 12000) {
UNLOCK(heap_regs->low_level_trace_lock);
return;
}
#ifdef COMMENTED
// if (vsc_count == 218280)
// vsc_xstop = 1;
if (vsc_count < 218200) {
UNLOCK(heap_regs->low_level_trace_lock);
return;
}
if (port != enter_pred ||
!pred ||
pred->ArityOfPE != 4 ||

7
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.46 2004-02-12 12:37:12 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.47 2004-02-19 19:24:45 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -187,7 +187,12 @@ void STD_PROTO(Yap_InitAsmPred,(char *, unsigned long int, int, CPredicate, int)
void STD_PROTO(Yap_InitCmpPred,(char *, unsigned long int, CmpPredicate, int));
void STD_PROTO(Yap_InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
void STD_PROTO(Yap_InitWorkspace,(int,int,int,int,int,int));
#if defined(YAPOR) || defined(THREADS)
void STD_PROTO(Yap_KillStacks,(int));
#else
void STD_PROTO(Yap_KillStacks,(void));
#endif
void STD_PROTO(Yap_InitYaamRegs,(void));
void STD_PROTO(Yap_ReInitWallTime, (void));
int STD_PROTO(Yap_OpDec,(int,char *,Atom));

3
pl/setof.yap
View File

@ -51,7 +51,8 @@ findall(Template, Generator, Answers, SoFar) :-
fail.
% now wraps it all
'$findall'(_, _, Ref, SoFar, Answers) :-
'$collect_for_findall'(Ref, SoFar, Answers).
'$catch'(Error,'$clean_findall'(Ref,Error),_),
'$collect_for_findall'(Ref, SoFar, Answers), !.
% error handling: be careful to recover all the space we used up
% in implementing findall.

5
pl/threads.yap
View File

@ -121,7 +121,8 @@ thread_join(Id, Status) :-
'$thread_join'(Id0),
'$erase_thread_aliases'(Id0),
recorded('$thread_exit_status',[Id0|Status],R),
erase(R).
erase(R),
'$thread_destroy'(Id0).
'$erase_thread_aliases'(Id0) :-
recorded('$thread_alias',[Id0|_],R),
@ -305,7 +306,7 @@ message_queue_destroy(Queue) :-
message_queue_destroy(Name) :-
'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
'$clean_mqueue'(Q) :-
'$clean_mqueue'(Queue) :-
recorded('$msg_queue',q(Queue,_),R),
erase(R),
fail.