From c9247ce30838188fb045002eb4022c570c71f16f Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 11 Feb 2004 13:33:19 +0000 Subject: [PATCH] make thread_local compatible with dynamic git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@977 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 3 +++ C/adtdefs.c | 2 +- C/cdmgr.c | 26 +++++++++++++++++++++----- C/dbase.c | 18 ++++++++++++++---- C/exec.c | 17 +++++++++++------ C/stdpreds.c | 10 +++++----- C/threads.c | 5 +++-- H/Heap.h | 6 ++++-- H/Regs.h | 3 ++- pl/threads.yap | 2 +- 10 files changed, 65 insertions(+), 27 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 6b5bb54c7..d63c38641 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -6307,6 +6307,7 @@ Yap_absmi(int inp) { PredEntry *ap = PredFromDefCode(PREG); WRITE_LOCK(ap->PRWLock); + WPP = ap; #if defined(YAPOR) || defined(THREADS) /* we do not lock access to the predicate, @@ -6315,6 +6316,7 @@ Yap_absmi(int inp) if (ap->OpcodeOfPred != INDEX_OPCODE) { /* someone was here before we were */ PREG = ap->CodeOfPred; + WPP = NULL; WRITE_UNLOCK(ap->PRWLock); JMPNext(); } @@ -6329,6 +6331,7 @@ Yap_absmi(int inp) setregs(); CACHED_A1() = ARG1; PREG = ap->CodeOfPred; + WPP = NULL; WRITE_UNLOCK(ap->PRWLock); } JMPNext(); diff --git a/C/adtdefs.c b/C/adtdefs.c index 894278c06..2674a924c 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -518,7 +518,7 @@ Yap_NewThreadPred(PredEntry *ap) p->ArityOfPE = ap->ArityOfPE; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; p->cs.p_code.NOfClauses = 0; - p->PredFlags = (ThreadLocalPredFlag|LogUpdatePredFlag); + p->PredFlags = ap->PredFlags & ~(IndexedPredFlag|SpiedPredFlag); p->src.OwnerFile = ap->src.OwnerFile; p->OpcodeOfPred = UNDEF_OPCODE; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); diff --git a/C/cdmgr.c b/C/cdmgr.c index 41ed22888..9225b37c4 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1053,6 +1053,7 @@ addclause(Term t, yamop *cp, int mode, int mod) } Yap_PutValue(AtomAbol, TermNil); WRITE_LOCK(p->PRWLock); + WPP = p; pflags = p->PredFlags; /* we are redefining a prolog module predicate */ if (p->ModuleOfPred == 0 && mod != 0) { @@ -1072,6 +1073,7 @@ addclause(Term t, yamop *cp, int mode, int mod) not_was_reconsulted(p, t, TRUE); /* always check if we have a valid error first */ if (Yap_ErrorMessage && Yap_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) { + WPP = NULL; WRITE_UNLOCK(p->PRWLock); return TermNil; } @@ -1125,6 +1127,7 @@ addclause(Term t, yamop *cp, int mode, int mod) p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc; } } + WPP = NULL; WRITE_UNLOCK(p->PRWLock); if (pflags & LogUpdatePredFlag) { return MkDBRefTerm((DBRef)ClauseCodeToLogUpdClause(cp)); @@ -1605,12 +1608,15 @@ p_purge_clauses(void) } else return (FALSE); WRITE_LOCK(pred->PRWLock); + WPP = pred; if (pred->PredFlags & StandardPredFlag) { + WPP = NULL; WRITE_UNLOCK(pred->PRWLock); Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, "assert/1"); return (FALSE); } purge_clauses(pred); + WPP = NULL; WRITE_UNLOCK(pred->PRWLock); return (TRUE); } @@ -1643,10 +1649,10 @@ p_setspy(void) mod = Yap_LookupModule(t2); if (IsAtomTerm(t)) { Atom at = AtomOfTerm(t); - pred = RepPredProp(PredPropByAtom(at, mod)); + pred = RepPredProp(Yap_PredPropByAtomNonThreadLocal(at, mod)); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); - pred = RepPredProp(PredPropByFunc(fun, mod)); + pred = RepPredProp(Yap_PredPropByFunctorNonThreadLocal(fun, mod)); } else { return (FALSE); } @@ -1697,10 +1703,10 @@ p_rmspy(void) return (FALSE); if (IsAtomTerm(t)) { at = AtomOfTerm(t); - pred = RepPredProp(PredPropByAtom(at, mod)); + pred = RepPredProp(Yap_PredPropByAtomNonThreadLocal(at, mod)); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); - pred = RepPredProp(PredPropByFunc(fun, mod)); + pred = RepPredProp(Yap_PredPropByFunctorNonThreadLocal(fun, mod)); } else return (FALSE); WRITE_LOCK(pred->PRWLock); @@ -1708,7 +1714,9 @@ p_rmspy(void) WRITE_UNLOCK(pred->PRWLock); return (FALSE); } - if (!(pred->PredFlags & DynamicPredFlag)) { + if (!(pred->PredFlags & ThreadLocalPredFlag)) { + pred->OpcodeOfPred = Yap_opcode(_thread_local); + } else if (!(pred->PredFlags & DynamicPredFlag)) { pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred; pred->OpcodeOfPred = ((yamop *)(pred->CodeOfPred))->opc; } else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) { @@ -3058,6 +3066,7 @@ 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) { + WPP = NULL; WRITE_UNLOCK(pe->PRWLock); return FALSE; } @@ -3073,6 +3082,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 + WPP = NULL; WRITE_UNLOCK(pe->PRWLock); if (cl->ClFlags & FactMask) { if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || @@ -3130,6 +3140,7 @@ p_log_update_clause(void) if (pe == NULL || EndOfPAEntr(pe)) return FALSE; WRITE_LOCK(pe->PRWLock); + WPP = pe; if(pe->OpcodeOfPred == INDEX_OPCODE) { IPred(pe); } @@ -3143,6 +3154,7 @@ p_continue_log_update_clause(void) yamop *ipc = (yamop *)IntegerOfTerm(ARG2); WRITE_LOCK(pe->PRWLock); + WPP = pe; return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE); } @@ -3152,6 +3164,7 @@ 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); + WPP = NULL; WRITE_UNLOCK(pe->PRWLock); if (cl == NULL) { return FALSE; @@ -3210,6 +3223,7 @@ p_log_update_clause0(void) if (pe == NULL || EndOfPAEntr(pe)) return FALSE; WRITE_LOCK(pe->PRWLock); + WPP = pe; if(pe->OpcodeOfPred == INDEX_OPCODE) { IPred(pe); } @@ -3223,6 +3237,7 @@ p_continue_log_update_clause0(void) yamop *ipc = (yamop *)IntegerOfTerm(ARG2); WRITE_LOCK(pe->PRWLock); + WPP = pe; return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE); } @@ -3314,6 +3329,7 @@ p_nth_clause(void) if (pe == NULL || EndOfPAEntr(pe)) return FALSE; WRITE_LOCK(pe->PRWLock); + WPP = pe; if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) { WRITE_UNLOCK(pe->PRWLock); return FALSE; diff --git a/C/dbase.c b/C/dbase.c index 04edfa7c1..b309f49c9 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -1836,7 +1836,9 @@ record_lu(PredEntry *pe, Term t, int position) else ipc->opc = Yap_opcode(_unify_idb_term); WRITE_LOCK(pe->PRWLock); + WPP = pe; Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0)); + WPP = NULL; WRITE_UNLOCK(pe->PRWLock); return cl; } @@ -3846,7 +3848,9 @@ static void EraseLogUpdCl(LogUpdClause *clau) { PredEntry *ap = clau->ClPred; - WRITE_LOCK(ap->PRWLock); + if (WPP != ap) { + WRITE_LOCK(ap->PRWLock); + } /* no need to erase what has been erased */ if (!(clau->ClFlags & ErasedMask)) { @@ -3893,7 +3897,9 @@ EraseLogUpdCl(LogUpdClause *clau) clau->ClRefCount--; } complete_lu_erase(clau); - WRITE_UNLOCK(ap->PRWLock); + if (WPP != ap) { + WRITE_UNLOCK(ap->PRWLock); + } } static void @@ -3968,7 +3974,9 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr) if (clau->ClFlags & ErasedMask) return; clau->ClFlags |= ErasedMask; - WRITE_LOCK(p->PRWLock); + if (WPP != p) { + WRITE_LOCK(p->PRWLock); + } if (p->cs.p_code.FirstClause != cl) { /* we are not the first clause... */ yamop *prev_code_p = (yamop *)(dbr->Prev->Code); @@ -4018,7 +4026,9 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr) p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } } - WRITE_UNLOCK(p->PRWLock); + if (WPP != p) { + WRITE_UNLOCK(p->PRWLock); + } } static void diff --git a/C/exec.c b/C/exec.c index 3a87022dd..6a12745aa 100644 --- a/C/exec.c +++ b/C/exec.c @@ -47,7 +47,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) { if (Yap_do_low_level_trace) low_level_trace(enter_pred,pen,XREGS+1); #endif /* LOW_LEVEL_TRACE */ - WRITE_LOCK(pen->PRWLock); + READ_LOCK(pen->PRWLock); #ifdef DEPTH_LIMIT if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ if (pen->ModuleOfPred) { @@ -61,7 +61,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) { CP = P; P = pen->CodeOfPred; /* vsc: increment reduction counter at meta-call entry */ - WRITE_UNLOCK(pen->PRWLock); + READ_UNLOCK(pen->PRWLock); if (pen->PredFlags & ProfiledPredFlag) { LOCK(pen->StatisticsForPred.lock); pen->StatisticsForPred.NOfEntries++; @@ -108,7 +108,7 @@ CallClause(PredEntry *pen, Int position) CELL flags; if (position == -1) return(CallPredicate(pen, B)); - WRITE_LOCK(pen->PRWLock); + READ_LOCK(pen->PRWLock); flags = pen->PredFlags; if ((flags & (CompiledPredFlag | DynamicPredFlag)) || pen->OpcodeOfPred == UNDEF_OPCODE) { @@ -167,24 +167,24 @@ CallClause(PredEntry *pen, Int position) *opp |= InUseMask; } #endif + READ_UNLOCK(pen->PRWLock); CLAUSECODE->clause = NEXTOP(q,ld); P = CLAUSECODE->clause; - WRITE_UNLOCK(pen->PRWLock); return((CELL)(&(CLAUSECODE->clause))); } else if (flags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(q); for (; position > 1; position--) cl = cl->ClNext; + READ_UNLOCK(pen->PRWLock); P = cl->ClCode; - WRITE_UNLOCK(pen->PRWLock); return (Unsigned(pen)); } else { /* static clause */ LogUpdClause *cl = ClauseCodeToLogUpdClause(q); for (; position > 1; position--) cl = cl->ClNext; + READ_UNLOCK(pen->PRWLock); P = cl->ClCode; - WRITE_UNLOCK(pen->PRWLock); return (Unsigned(pen)); } } else { @@ -1590,6 +1590,11 @@ Yap_InitYaamRegs(void) MutableList = Yap_NewTimedVar(TermNil); AttsMutableList = Yap_NewTimedVar(TermNil); #endif +#if defined(YAPOR) || defined(THREADS) + PP = NULL; + WPP = NULL; + PREG_ADDR = NULL; +#endif } diff --git a/C/stdpreds.c b/C/stdpreds.c index 8e918c7c7..8bdc48369 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2019,14 +2019,14 @@ p_flags(void) return (FALSE); if (EndOfPAEntr(pe)) return (FALSE); - WRITE_LOCK(pe->PRWLock); + READ_LOCK(pe->PRWLock); if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) { - WRITE_UNLOCK(pe->PRWLock); + READ_UNLOCK(pe->PRWLock); return(FALSE); } ARG4 = Deref(ARG4); if (IsVarTerm(ARG4)) { - WRITE_UNLOCK(pe->PRWLock); + READ_UNLOCK(pe->PRWLock); return (TRUE); } else if (!IsIntegerTerm(ARG4)) { union arith_ret v; @@ -2034,14 +2034,14 @@ p_flags(void) if (Yap_Eval(ARG4, &v) == long_int_e) { newFl = v.Int; } else { - WRITE_UNLOCK(pe->PRWLock); + READ_UNLOCK(pe->PRWLock); Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags"); return(FALSE); } } else newFl = IntegerOfTerm(ARG4); pe->PredFlags = (CELL)newFl; - WRITE_UNLOCK(pe->PRWLock); + READ_UNLOCK(pe->PRWLock); return (TRUE); } diff --git a/C/threads.c b/C/threads.c index 1c87affd1..90b1c8fca 100644 --- a/C/threads.c +++ b/C/threads.c @@ -369,10 +369,11 @@ p_install_thread_local(void) } else return FALSE; WRITE_LOCK(pe->PRWLock); - if (pe->PredFlags & (UserCPredFlag|HiddenPredFlag|CArgsPredFlag|SourcePredFlag|SyncPredFlag|TestPredFlag|AsmPredFlag|StandardPredFlag|DynamicPredFlag|CPredFlag|SafePredFlag|IndexedPredFlag|BinaryTestPredFlag|SpiedPredFlag)) { + if (pe->PredFlags & (UserCPredFlag|HiddenPredFlag|CArgsPredFlag|SyncPredFlag|TestPredFlag|AsmPredFlag|StandardPredFlag|CPredFlag|SafePredFlag|IndexedPredFlag|BinaryTestPredFlag) || + pe->cs.p_code.FirstClause != NULL) { return FALSE; } - pe->PredFlags |= (ThreadLocalPredFlag|LogUpdatePredFlag); + pe->PredFlags |= ThreadLocalPredFlag; pe->OpcodeOfPred = Yap_opcode(_thread_local); pe->CodeOfPred = (yamop *)&pe->OpcodeOfPred; WRITE_UNLOCK(pe->PRWLock); diff --git a/H/Heap.h b/H/Heap.h index d9a51d106..55d3b2136 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.54 2004-02-11 01:20:56 vsc Exp $ * +* version: $Id: Heap.h,v 1.55 2004-02-11 13:33:19 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -45,8 +45,9 @@ typedef struct scratch_block_struct { } scratch_block; typedef struct worker_local_struct { -#ifdef THREADS +#if defined(YAPOR) || defined(THREADS) lockvar signal_lock; /* protect signal handlers from IPIs */ + struct pred_entry *wpp; #endif UInt active_signals; UInt i_pred_arity; @@ -612,6 +613,7 @@ struct various_codes *heap_regs; #endif #if defined(YAPOR) || defined(THREADS) #define SignalLock heap_regs->wl[worker_id].signal_lock +#define WPP heap_regs->wl[worker_id].wpp #define ActiveSignals heap_regs->wl[worker_id].active_signals #define IPredArity heap_regs->wl[worker_id].i_pred_arity #define ProfEnd heap_regs->wl[worker_id].prof_end diff --git a/H/Regs.h b/H/Regs.h index 49dadf850..fb4791422 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -10,7 +10,7 @@ * File: Regs.h * * mods: * * comments: YAP abstract machine registers * -* version: $Id: Regs.h,v 1.24 2004-02-06 17:22:24 vsc Exp $ * +* version: $Id: Regs.h,v 1.25 2004-02-11 13:33:19 vsc Exp $ * *************************************************************************/ @@ -108,6 +108,7 @@ typedef struct #endif /* SBA || TABLING */ #if defined(YAPOR) || defined(THREADS) struct pred_entry *PP_; + /* recursive write-locks for PredEntry */ yamop **PREG_ADDR_; unsigned int worker_id_; #ifdef SBA diff --git a/pl/threads.yap b/pl/threads.yap index 4b98f9893..fdf912b10 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -371,7 +371,7 @@ thread_local(X) :- '$thread_local2'(A/N, Mod) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,Mod,F,F), - ( '$undefined'(T,Mod) -> '$install_thread_local'(T,Mod); + ( '$install_thread_local'(T,Mod) -> true ; F /\ 0x08002000 =\= 0 -> '$do_error'(permission_error(modify,dynamic_procedure,A/N),thread_local(Mod:A/N)) ; '$do_error'(permission_error(modify,static_procedure,A/N),thread_local(Mod:A/N)) ).