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

make thread_local compatible with dynamic 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@977 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-02-11 13:33:19 +00:00
parent acbf57f59d
commit c9247ce308
10 changed files with 65 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/absmi.c
View File

@ -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();

2
C/adtdefs.c
View File

@ -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));

26
C/cdmgr.c
View File

@ -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;

18
C/dbase.c
View File

@ -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

17
C/exec.c
View File

@ -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
}

10
C/stdpreds.c
View File

@ -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);
}

5
C/threads.c
View File

@ -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);

6
H/Heap.h
View File

@ -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

3
H/Regs.h
View File

@ -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

2
pl/threads.yap
View File

@ -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))
).