From 026bfb3c184ae1734c88c4b0008bc68dc5dfa9a7 Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 19 Feb 2004 19:24:46 +0000 Subject: [PATCH] more thread fixes git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@997 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 21 ++++--- C/adtdefs.c | 3 + C/alloc.c | 14 ++++- C/amasm.c | 1 + C/cdmgr.c | 152 ++++++++++++++++++++++++++++++++++--------------- C/dbase.c | 26 +++------ C/index.c | 65 ++++++++++++--------- C/stdpreds.c | 13 ++--- C/threads.c | 78 ++++++++++++++++++------- C/tracer.c | 12 +++- H/Yapproto.h | 7 ++- pl/setof.yap | 3 +- pl/threads.yap | 5 +- 13 files changed, 267 insertions(+), 133 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 567bf9a8b..d1e17ce60 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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(); } diff --git a/C/adtdefs.c b/C/adtdefs.c index 5869f063b..3fed3e0f3 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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; } diff --git a/C/alloc.c b/C/alloc.c index 46065e802..8ae097ab8 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -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) diff --git a/C/amasm.c b/C/amasm.c index 3b3721dfa..2c148e657 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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++; } diff --git a/C/cdmgr.c b/C/cdmgr.c index 0c7aeb45a..e829a97dd 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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) diff --git a/C/dbase.c b/C/dbase.c index e04002040..8eacb171d 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -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 diff --git a/C/index.c b/C/index.c index 2dd03c849..bd2785f3d 100644 --- a/C/index.c +++ b/C/index.c @@ -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; } } diff --git a/C/stdpreds.c b/C/stdpreds.c index 603b7a3fb..44d24e543 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -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; } } diff --git a/C/threads.c b/C/threads.c index c319f269d..7bd24d9a4 100644 --- a/C/threads.c +++ b/C/threads.c @@ -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); diff --git a/C/tracer.c b/C/tracer.c index c68439628..10a5585cc 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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 || diff --git a/H/Yapproto.h b/H/Yapproto.h index 7cf404c51..c9ce84914 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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)); diff --git a/pl/setof.yap b/pl/setof.yap index bb0a27628..523db1945 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -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. diff --git a/pl/threads.yap b/pl/threads.yap index a41c270ca..7a4533daf 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -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.