more threadin fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2300 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
6d23a23a81
commit
2581c3a3bf
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2008-08-06 23:05:49 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-07 20:51:15 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.244 2008/08/06 23:05:49 vsc
|
||||
* fix debugging info
|
||||
*
|
||||
* Revision 1.243 2008/08/06 17:32:18 vsc
|
||||
* more thread fixes
|
||||
*
|
||||
@ -8266,9 +8269,6 @@ Yap_absmi(int inp)
|
||||
/* actually get rid of the code */
|
||||
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
|
||||
if (PREG != FAILCODE) {
|
||||
/* I am the last one using this clause, hence I don't need a lock
|
||||
to dispose of it
|
||||
*/
|
||||
if (lcl->ClRefCount == 1) {
|
||||
/* make sure the clause isn't destroyed */
|
||||
/* always add an extra reference */
|
||||
|
||||
12
C/amasm.c
12
C/amasm.c
@ -11,8 +11,12 @@
|
||||
* File: amasm.c *
|
||||
* comments: abstract machine assembler *
|
||||
* *
|
||||
* Last rev: $Date: 2008-07-11 17:02:07 $ *
|
||||
* Last rev: $Date: 2008-08-07 20:51:16 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.102 2008/07/11 17:02:07 vsc
|
||||
* fixes by Bart and Tom: mostly libraries but nasty one in indexing
|
||||
* compilation.
|
||||
*
|
||||
* Revision 1.101 2008/04/01 22:28:41 vsc
|
||||
* put YAPOR back to life.
|
||||
*
|
||||
@ -1664,7 +1668,7 @@ init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u)
|
||||
ic->ChildIndex = NULL;
|
||||
ic->ClRefCount = 0;
|
||||
ic->ParentIndex = (LogUpdIndex *)cl_u;
|
||||
INIT_LOCK(ic->ClLock);
|
||||
// INIT_LOCK(ic->ClLock);
|
||||
cl_u->lui.ChildIndex = ic;
|
||||
cl_u->lui.ClRefCount++;
|
||||
}
|
||||
@ -2770,7 +2774,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
cl_u->luc.ClExt = NULL;
|
||||
cl_u->luc.ClPrev = cl_u->luc.ClNext = NULL;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_LOCK(cl_u->luc.ClLock);
|
||||
//INIT_LOCK(cl_u->luc.ClLock);
|
||||
INIT_CLREF_COUNT(&(cl_u->luc));
|
||||
#endif
|
||||
}
|
||||
@ -2834,7 +2838,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
cl_u->lui.ParentIndex = NULL;
|
||||
cl_u->lui.ClSize = size;
|
||||
cl_u->lui.ClRefCount = 0;
|
||||
INIT_LOCK(cl_u->lui.ClLock);
|
||||
// INIT_LOCK(cl_u->lui.ClLock);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_CLREF_COUNT(&(cl_u->lui));
|
||||
#endif
|
||||
|
||||
16
C/arrays.c
16
C/arrays.c
@ -732,15 +732,15 @@ ClearStaticArray(StaticArrayEntry *pp)
|
||||
|
||||
if (ptr->Flags & LogUpdMask) {
|
||||
LogUpdClause *lup = (LogUpdClause *)ptr;
|
||||
LOCK(lup->ClLock);
|
||||
// LOCK(lup->ClLock);
|
||||
lup->ClRefCount--;
|
||||
if (lup->ClRefCount == 0 &&
|
||||
(lup->ClFlags & ErasedMask) &&
|
||||
!(lup->ClFlags & InUseMask)) {
|
||||
UNLOCK(lup->ClLock);
|
||||
// UNLOCK(lup->ClLock);
|
||||
Yap_ErLogUpdCl(lup);
|
||||
} else {
|
||||
UNLOCK(lup->ClLock);
|
||||
// UNLOCK(lup->ClLock);
|
||||
}
|
||||
} else {
|
||||
ptr->NOfRefsTo--;
|
||||
@ -1836,15 +1836,15 @@ p_assign_static(void)
|
||||
|
||||
if (ptr->Flags & LogUpdMask) {
|
||||
LogUpdClause *lup = (LogUpdClause *)ptr;
|
||||
LOCK(lup->ClLock);
|
||||
// LOCK(lup->ClLock);
|
||||
lup->ClRefCount--;
|
||||
if (lup->ClRefCount == 0 &&
|
||||
(lup->ClFlags & ErasedMask) &&
|
||||
!(lup->ClFlags & InUseMask)) {
|
||||
UNLOCK(lup->ClLock);
|
||||
// UNLOCK(lup->ClLock);
|
||||
Yap_ErLogUpdCl(lup);
|
||||
} else {
|
||||
UNLOCK(lup->ClLock);
|
||||
// UNLOCK(lup->ClLock);
|
||||
}
|
||||
} else {
|
||||
ptr->NOfRefsTo--;
|
||||
@ -1858,9 +1858,9 @@ p_assign_static(void)
|
||||
|
||||
if (p->Flags & LogUpdMask) {
|
||||
LogUpdClause *lup = (LogUpdClause *)p;
|
||||
LOCK(lup->ClLock);
|
||||
// LOCK(lup->ClLock);
|
||||
lup->ClRefCount++;
|
||||
UNLOCK(lup->ClLock);
|
||||
// UNLOCK(lup->ClLock);
|
||||
} else {
|
||||
p->NOfRefsTo++;
|
||||
}
|
||||
|
||||
@ -10,8 +10,11 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2008-08-01 21:44:24 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.122 2008/08/01 21:44:24 vsc
|
||||
* swi compatibility support
|
||||
*
|
||||
* Revision 1.121 2008/07/24 16:02:00 vsc
|
||||
* improve C-interface and SWI comptaibility a bit.
|
||||
*
|
||||
@ -2295,36 +2298,10 @@ YAP_CreateModule(Atom at)
|
||||
X_API Term
|
||||
YAP_StripModule(Term t, Term *modp)
|
||||
{
|
||||
Term tmod;
|
||||
|
||||
tmod = CurrentModule;
|
||||
restart:
|
||||
if (IsVarTerm(t)) {
|
||||
return 0L;
|
||||
} else if (IsAtomTerm(t)) {
|
||||
*modp = tmod;
|
||||
return t;
|
||||
} else if (IsApplTerm(t)) {
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
if (fun == FunctorModule) {
|
||||
tmod = ArgOfTerm(1, t);
|
||||
if (IsVarTerm(tmod) ) {
|
||||
return 0L;
|
||||
}
|
||||
if (!IsAtomTerm(tmod) ) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
goto restart;
|
||||
}
|
||||
*modp = tmod;
|
||||
return t;
|
||||
}
|
||||
return 0L;
|
||||
return Yap_StripModule(t, modp);
|
||||
}
|
||||
|
||||
|
||||
|
||||
X_API int
|
||||
YAP_ThreadSelf(void)
|
||||
{
|
||||
|
||||
@ -1835,7 +1835,7 @@ new_lu_db_entry(Term t, PredEntry *pe)
|
||||
}
|
||||
cl->ClTimeEnd = TIMESTAMP_EOT;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_LOCK(cl->ClLock);
|
||||
// INIT_LOCK(cl->ClLock);
|
||||
INIT_CLREF_COUNT(cl);
|
||||
#endif
|
||||
if (needs_vars)
|
||||
|
||||
@ -11,8 +11,12 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2008-07-11 17:02:07 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.202 2008/07/11 17:02:07 vsc
|
||||
* fixes by Bart and Tom: mostly libraries but nasty one in indexing
|
||||
* compilation.
|
||||
*
|
||||
* Revision 1.201 2008/05/10 23:24:11 vsc
|
||||
* fix threads and LU
|
||||
*
|
||||
@ -6128,7 +6132,7 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
|
||||
ncl->ChildIndex = cl->ChildIndex;
|
||||
ncl->ParentIndex = cl->ParentIndex;
|
||||
ncl->ClPred = cl->ClPred;
|
||||
INIT_LOCK(ncl->ClLock);
|
||||
// INIT_LOCK(ncl->ClLock);
|
||||
if (c == cl) {
|
||||
parent_block->lui.ChildIndex = ncl;
|
||||
} else {
|
||||
|
||||
2
C/init.c
2
C/init.c
@ -1335,7 +1335,7 @@ InitCodes(void)
|
||||
Yap_heap_regs->logdb_erased_marker->ClNext = NULL;
|
||||
Yap_heap_regs->logdb_erased_marker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
|
||||
Yap_heap_regs->logdb_erased_marker->ClCode->opc = Yap_opcode(_op_fail);
|
||||
INIT_LOCK(Yap_heap_regs->logdb_erased_marker->ClLock);
|
||||
// INIT_LOCK(Yap_heap_regs->logdb_erased_marker->ClLock);
|
||||
INIT_CLREF_COUNT(Yap_heap_regs->logdb_erased_marker);
|
||||
Yap_heap_regs->yap_streams = NULL;
|
||||
#if DEBUG
|
||||
|
||||
33
C/modules.c
33
C/modules.c
@ -264,6 +264,39 @@ p_context_module(void)
|
||||
return Yap_unify(ARG1, CurrentModule);
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_StripModule(Term t, Term *modp)
|
||||
{
|
||||
Term tmod;
|
||||
|
||||
tmod = CurrentModule;
|
||||
restart:
|
||||
if (IsVarTerm(t)) {
|
||||
return 0L;
|
||||
} else if (IsAtomTerm(t)) {
|
||||
*modp = tmod;
|
||||
return t;
|
||||
} else if (IsApplTerm(t)) {
|
||||
Functor fun = FunctorOfTerm(t);
|
||||
if (fun == FunctorModule) {
|
||||
tmod = ArgOfTerm(1, t);
|
||||
if (IsVarTerm(tmod) ) {
|
||||
return 0L;
|
||||
}
|
||||
if (!IsAtomTerm(tmod) ) {
|
||||
return 0L;
|
||||
}
|
||||
t = ArgOfTerm(2, t);
|
||||
goto restart;
|
||||
}
|
||||
*modp = tmod;
|
||||
return t;
|
||||
}
|
||||
return 0L;
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
Yap_InitModulesC(void)
|
||||
{
|
||||
|
||||
82
C/threads.c
82
C/threads.c
@ -67,21 +67,24 @@ allocate_new_tid(void)
|
||||
}
|
||||
|
||||
static int
|
||||
store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
||||
store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit)
|
||||
{
|
||||
UInt pm; /* memory to be requested */
|
||||
Term tmod;
|
||||
|
||||
if (tsize < MinTrailSpace)
|
||||
tsize = MinTrailSpace;
|
||||
if (ssize < MinStackSpace)
|
||||
ssize = MinStackSpace;
|
||||
ThreadHandle[new_worker_id].ssize = ssize;
|
||||
ThreadHandle[new_worker_id].tsize = tsize;
|
||||
ThreadHandle[new_worker_id].sysize = sysize;
|
||||
pm = (ssize + tsize)*1024;
|
||||
if (!(ThreadHandle[new_worker_id].stack_address = malloc(pm))) {
|
||||
return FALSE;
|
||||
}
|
||||
ThreadHandle[new_worker_id].tgoal =
|
||||
Yap_StoreTermInDB(tgoal,4);
|
||||
Yap_StoreTermInDB(tgoal,7);
|
||||
ThreadHandle[new_worker_id].cmod =
|
||||
CurrentModule;
|
||||
if (IsVarTerm(tdetach)){
|
||||
@ -91,6 +94,10 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
||||
ThreadHandle[new_worker_id].tdetach =
|
||||
tdetach;
|
||||
}
|
||||
tgoal = Yap_StripModule(texit, &tmod);
|
||||
ThreadHandle[new_worker_id].texit_mod = tmod;
|
||||
ThreadHandle[new_worker_id].texit =
|
||||
Yap_StoreTermInDB(tgoal,7);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
@ -114,6 +121,7 @@ kill_thread_engine (int wid, int always_die)
|
||||
ThreadHandle[wid].current_yaam_regs = NULL;
|
||||
free(ThreadHandle[wid].start_of_timesp);
|
||||
free(ThreadHandle[wid].last_timep);
|
||||
Yap_FreeCodeSpace((ADDR)ThreadHandle[wid].texit);
|
||||
LOCK(ThreadHandlesLock);
|
||||
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
|
||||
always_die) {
|
||||
@ -213,9 +221,9 @@ p_thread_new_tid(void)
|
||||
}
|
||||
|
||||
static int
|
||||
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
||||
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit)
|
||||
{
|
||||
return store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
|
||||
return store_specs(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit);
|
||||
}
|
||||
|
||||
static Int
|
||||
@ -223,11 +231,14 @@ p_create_thread(void)
|
||||
{
|
||||
UInt ssize;
|
||||
UInt tsize;
|
||||
UInt sysize;
|
||||
Term tgoal = Deref(ARG1);
|
||||
Term tdetach = Deref(ARG5);
|
||||
Term texit = Deref(ARG6);
|
||||
Term x2 = Deref(ARG2);
|
||||
Term x3 = Deref(ARG3);
|
||||
int new_worker_id = IntegerOfTerm(Deref(ARG6));
|
||||
Term x4 = Deref(ARG4);
|
||||
int new_worker_id = IntegerOfTerm(Deref(ARG7));
|
||||
|
||||
// fprintf(stderr," %d --> %d\n", worker_id, new_worker_id);
|
||||
if (IsBigIntTerm(x2))
|
||||
@ -236,13 +247,14 @@ p_create_thread(void)
|
||||
return FALSE;
|
||||
ssize = IntegerOfTerm(x2);
|
||||
tsize = IntegerOfTerm(x3);
|
||||
sysize = IntegerOfTerm(x4);
|
||||
/* UInt systemsize = IntegerOfTerm(Deref(ARG4)); */
|
||||
if (new_worker_id == -1) {
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
/* make sure we can proceed */
|
||||
if (!init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach))
|
||||
if (!init_thread_engine(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit))
|
||||
return FALSE;
|
||||
ThreadHandle[new_worker_id].id = new_worker_id;
|
||||
ThreadHandle[new_worker_id].ref_count = 1;
|
||||
@ -352,7 +364,7 @@ Yap_thread_create_engine(thread_attr *ops)
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
if (!init_thread_engine(new_id, ops->ssize, ops->tsize, TermNil, TermNil))
|
||||
if (!init_thread_engine(new_id, ops->ssize, ops->tsize, ops->sysize, TermNil, TermNil, ops->egoal))
|
||||
return FALSE;
|
||||
ThreadHandle[new_id].id = new_id;
|
||||
ThreadHandle[new_id].handle = pthread_self();
|
||||
@ -658,6 +670,57 @@ p_cond_wait(void)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_stacks(void)
|
||||
{ /* '$thread_signal'(+P) */
|
||||
Int tid = IntegerOfTerm(Deref(ARG1));
|
||||
Int status= TRUE;
|
||||
|
||||
LOCK(ThreadHandlesLock);
|
||||
if (!ThreadHandle[tid].in_use &&
|
||||
!ThreadHandle[tid].zombie) {
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
return FALSE;
|
||||
}
|
||||
status &= Yap_unify(ARG2,MkIntegerTerm(ThreadHandle[tid].ssize));
|
||||
status &= Yap_unify(ARG3,MkIntegerTerm(ThreadHandle[tid].tsize));
|
||||
status &= Yap_unify(ARG4,MkIntegerTerm(ThreadHandle[tid].sysize));
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
return status;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_atexit(void)
|
||||
{ /* '$thread_signal'(+P) */
|
||||
Term t;
|
||||
|
||||
if (ThreadHandle[worker_id].texit->Entry == MkAtomTerm(AtomTrue)) {
|
||||
return FALSE;
|
||||
}
|
||||
do {
|
||||
t = Yap_FetchTermFromDB(ThreadHandle[worker_id].texit);
|
||||
if (t == 0) {
|
||||
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_growglobal(NULL)) {
|
||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
|
||||
thread_die(worker_id, FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
if (!Yap_growstack(ThreadHandle[worker_id].tgoal->NOfCells*CellSize)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
thread_die(worker_id, FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
} while (t == 0);
|
||||
return Yap_unify(ARG1, t) && Yap_unify(ARG2, ThreadHandle[worker_id].texit_mod);
|
||||
}
|
||||
|
||||
|
||||
|
||||
static Int
|
||||
p_thread_signal(void)
|
||||
@ -747,7 +810,7 @@ void Yap_InitThreadPreds(void)
|
||||
Yap_InitCPred("$max_workers", 1, p_max_workers, HiddenPredFlag);
|
||||
Yap_InitCPred("$max_threads", 1, p_max_threads, HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_new_tid", 1, p_thread_new_tid, HiddenPredFlag);
|
||||
Yap_InitCPred("$create_thread", 6, p_create_thread, HiddenPredFlag);
|
||||
Yap_InitCPred("$create_thread", 7, p_create_thread, HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_status_lock", 1, p_thread_status_lock, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_status_unlock", 1, p_thread_status_unlock, SafePredFlag|HiddenPredFlag);
|
||||
@ -771,12 +834,14 @@ void Yap_InitThreadPreds(void)
|
||||
Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$signal_thread", 1, p_thread_signal, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads_created", 1, p_nof_threads_created, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_sleep", 4, p_thread_sleep, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_runtime", 1, p_thread_runtime, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_self_lock", 1, p_thread_self_lock, SafePredFlag);
|
||||
Yap_InitCPred("$thread_run_at_exit", 2, p_thread_atexit, SafePredFlag);
|
||||
Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag);
|
||||
}
|
||||
|
||||
@ -838,6 +903,7 @@ void Yap_InitThreadPreds(void)
|
||||
Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads_created", 1, p_nof_threads_created, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_runtime", 1, p_thread_runtime, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag);
|
||||
}
|
||||
|
||||
7
H/Heap.h
7
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.134 2008-08-06 17:32:20 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.135 2008-08-07 20:51:23 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -185,10 +185,11 @@ typedef struct thandle {
|
||||
int zombie;
|
||||
UInt ssize;
|
||||
UInt tsize;
|
||||
UInt sysize;
|
||||
void *stack_address;
|
||||
Term tdetach;
|
||||
Term cmod;
|
||||
struct DB_TERM *tgoal;
|
||||
Term cmod, texit_mod;
|
||||
struct DB_TERM *tgoal, *texit;
|
||||
int id;
|
||||
int ret;
|
||||
REGSTORE *default_yaam_regs;
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.89 2008-08-06 17:32:21 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.90 2008-08-07 20:51:23 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -258,6 +258,7 @@ Term STD_PROTO(Yap_Module, (Term));
|
||||
Term STD_PROTO(Yap_Module_Name, (struct pred_entry *));
|
||||
struct pred_entry *STD_PROTO(Yap_ModulePred, (Term));
|
||||
void STD_PROTO(Yap_NewModulePred, (Term, struct pred_entry *));
|
||||
Term STD_PROTO(Yap_StripModule, (Term, Term *));
|
||||
void STD_PROTO(Yap_InitModules, (void));
|
||||
void STD_PROTO(Yap_InitModulesC, (void));
|
||||
|
||||
|
||||
@ -44,7 +44,7 @@ typedef struct logic_upd_index {
|
||||
UInt ClRefCount;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
/* A lock for manipulating the clause */
|
||||
lockvar ClLock;
|
||||
// lockvar ClLock;
|
||||
#endif
|
||||
UInt ClSize;
|
||||
struct logic_upd_index *ParentIndex;
|
||||
@ -65,7 +65,7 @@ typedef struct logic_upd_clause {
|
||||
CELL ClFlags;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
/* A lock for manipulating the clause */
|
||||
lockvar ClLock;
|
||||
// lockvar ClLock;
|
||||
#endif
|
||||
UInt ClSize;
|
||||
/* extra clause information for logical update indices and facts */
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2008-07-22 23:34:49 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-07 20:51:23 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.99 2008/07/22 23:34:49 vsc
|
||||
* SWI and module fixes
|
||||
*
|
||||
* Revision 1.98 2008/05/12 22:31:37 vsc
|
||||
* fix previous fixes
|
||||
*
|
||||
@ -398,7 +401,7 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp)
|
||||
* clause for this predicate or not
|
||||
*/
|
||||
{
|
||||
INIT_LOCK(cl->ClLock);
|
||||
// INIT_LOCK(cl->ClLock);
|
||||
if (cl->ClFlags & LogUpdRuleMask) {
|
||||
cl->ClExt = PtoOpAdjust(cl->ClExt);
|
||||
}
|
||||
@ -437,7 +440,7 @@ RestoreDBTermEntry(struct dbterm_list *dbl) {
|
||||
static void
|
||||
CleanLUIndex(LogUpdIndex *idx, int recurse)
|
||||
{
|
||||
INIT_LOCK(idx->ClLock);
|
||||
// INIT_LOCK(idx->ClLock);
|
||||
idx->ClPred = PtoPredAdjust(idx->ClPred);
|
||||
if (idx->ParentIndex)
|
||||
idx->ParentIndex = LUIndexAdjust(idx->ParentIndex);
|
||||
|
||||
@ -1,7 +1,9 @@
|
||||
typedef struct{
|
||||
UInt ssize;
|
||||
UInt tsize;
|
||||
UInt sysize;
|
||||
int (*cancel)(int thread);
|
||||
Term egoal;
|
||||
} thread_attr;
|
||||
|
||||
Int STD_PROTO(Yap_thread_self,(void));
|
||||
|
||||
153
pl/threads.yap
153
pl/threads.yap
@ -29,7 +29,6 @@
|
||||
no_threads, !,
|
||||
recorda('$thread_alias', [0|main], _).
|
||||
'$init_thread0' :-
|
||||
'$record_thread_info'(0, main, [0, 0, 0], false, true, '$init_thread0'),
|
||||
recorda('$thread_defaults', [0, 0, 0, false, true], _),
|
||||
'$new_mutex'(QId),
|
||||
assert('$global_queue_mutex'(QId)),
|
||||
@ -42,25 +41,26 @@
|
||||
(Detached == true -> '$detach_thread'(Id) ; true),
|
||||
'$current_module'(Module),
|
||||
% always finish with a throw to make sure we clean stacks.
|
||||
'$system_catch'((G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Module,Exception,'$close_thread'(Exception,Detached)).
|
||||
'$system_catch'((G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Module,Exception,'$close_thread'(Exception,Detached)),
|
||||
% force backtracking and handling exceptions
|
||||
fail.
|
||||
|
||||
'$close_thread'(Status, Detached) :-
|
||||
'$thread_zombie_self'(Id0), !,
|
||||
'$record_thread_status'(Id0,Status),
|
||||
'$run_at_thread_exit'(Id0),
|
||||
'$erase_thread_info'(Id0).
|
||||
'$close_thread'(Status) :-
|
||||
'$close_thread'(Status).
|
||||
|
||||
% OK, we want to ensure atomicity here in case we get an exception while we
|
||||
% are closing down the thread.
|
||||
'$record_thread_status'(Id0,Stat) :- !,
|
||||
(recorded('$thread_exit_status', [Id0|_], R), erase(R), fail
|
||||
'$mk_tstatus_key'(Id0, Key),
|
||||
(recorded(Key, _, R), erase(R), fail
|
||||
;
|
||||
Stat = '$thread_finished'(Status) ->
|
||||
recorda('$thread_exit_status', [Id0|Status], _)
|
||||
recorda(Key, Status, _)
|
||||
;
|
||||
recorda('$thread_exit_status', [Id0|exception(Stat)], _)
|
||||
recorda(Key, exception(Stat), _)
|
||||
).
|
||||
|
||||
thread_create(Goal) :-
|
||||
@ -69,14 +69,14 @@ thread_create(Goal) :-
|
||||
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
% '$erase_thread_info'(Id), % this should not be here
|
||||
'$record_thread_info'(Id, [Stack, Trail, System], Detached, AtExit),
|
||||
'$create_thread_mq'(Id),
|
||||
(
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, Id)
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||
->
|
||||
true
|
||||
;
|
||||
recorda('$thread_exit_status', [Id|exception(resource_error(memory))],_)
|
||||
'$mk_tstatus_key'(Id, Key),
|
||||
recorda(Key, exception(resource_error(memory)),_)
|
||||
).
|
||||
|
||||
thread_create(Goal, Id) :-
|
||||
@ -86,14 +86,14 @@ thread_create(Goal, Id) :-
|
||||
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
% '$erase_thread_info'(Id), % this should not be here
|
||||
'$record_thread_info'(Id, [Stack, Trail, System], Detached, AtExit),
|
||||
'$create_thread_mq'(Id),
|
||||
(
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, Id)
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||
->
|
||||
true
|
||||
;
|
||||
recorda('$thread_exit_status', [Id|exception(resource_error(memory))],_)
|
||||
'$mk_tstatus_key'(Id, Key),
|
||||
recorda(Key, exception(resource_error(memory)),_)
|
||||
).
|
||||
|
||||
thread_create(Goal, Id, Options) :-
|
||||
@ -103,31 +103,21 @@ thread_create(Goal, Id, Options) :-
|
||||
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
% '$erase_thread_info'(Id), % this should not be here
|
||||
( var(Alias) ->
|
||||
'$record_thread_info'(Id, [Stack, Trail, System], Detached, AtExit)
|
||||
; '$record_thread_info'(Id, Alias, [Stack, Trail, System], Detached, AtExit, G0)
|
||||
),
|
||||
'$record_alias_info'(Id, Alias),
|
||||
'$create_thread_mq'(Id),
|
||||
(
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, Id)
|
||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||
->
|
||||
true
|
||||
;
|
||||
recorda('$thread_exit_status', [Id|exception(resource_error(memory))],_)
|
||||
'$mk_tstatus_key'(Id, Key),
|
||||
recorda(Key, exception(resource_error(memory)),_)
|
||||
).
|
||||
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_alias',[Id|_],R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_sizes', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_at_exit', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_exit_hook', [Id|_], R),
|
||||
erase(R),
|
||||
@ -169,19 +159,13 @@ thread_create(Goal, Id, Options) :-
|
||||
'$thread_option'(Option, _, _, _, _, _, _, G0) :-
|
||||
'$do_error'(domain_error(thread_option,Option),G0).
|
||||
|
||||
'$record_thread_info'(_, Alias, _, _, _, Goal) :-
|
||||
'$record_alias_info'(_, Alias) :-
|
||||
var(Alias), !.
|
||||
'$record_alias_info'(_, Alias) :-
|
||||
recorded('$thread_alias', [_|Alias], _), !,
|
||||
'$do_error'(permission_error(create,thread,alias(Alias)), Goal).
|
||||
'$record_thread_info'(Id, Alias, Sizes, Detached, AtExit, _) :-
|
||||
recorda('$thread_alias', [Id|Alias], _),
|
||||
'$record_thread_info'(Id, Sizes, Detached, AtExit).
|
||||
|
||||
'$record_thread_info'(Id, Sizes, Detached, AtExit) :-
|
||||
recorda('$thread_sizes', [Id|Sizes], _),
|
||||
( AtExit == true ->
|
||||
true
|
||||
; recorda('$thread_at_exit', [Id|AtExit], _)
|
||||
).
|
||||
'$record_alias_info'(Id, Alias) :-
|
||||
recorda('$thread_alias', [Id|Alias], _).
|
||||
|
||||
% vsc: ?????
|
||||
thread_defaults(Defaults) :-
|
||||
@ -298,7 +282,8 @@ thread_join(Id, Status) :-
|
||||
'$check_thread_or_alias'(Id, thread_join(Id, Status)),
|
||||
'$thread_id_alias'(Id0, Id),
|
||||
'$thread_join'(Id0),
|
||||
recorded('$thread_exit_status', [Id0|Status], R),
|
||||
'$mk_tstatus_key'(Id0, Key),
|
||||
recorded(Key, Status, R),
|
||||
erase(R),
|
||||
'$thread_destroy'(Id0).
|
||||
|
||||
@ -312,7 +297,8 @@ thread_detach(Id) :-
|
||||
'$check_thread_or_alias'(Id, thread_detach(Id)),
|
||||
'$thread_id_alias'(Id0, Id),
|
||||
'$detach_thread'(Id0),
|
||||
( recorded('$thread_exit_status', [Id0|_], _) ->
|
||||
'$mk_tstatus_key'(Id0, Key),
|
||||
( recorded(Key, _, _) ->
|
||||
'$erase_thread_info'(Id0),
|
||||
'$thread_destroy'(Id0)
|
||||
;
|
||||
@ -326,8 +312,8 @@ thread_exit(Term) :-
|
||||
'$close_thread'('$thread_finished'(exited(Term)), Detached).
|
||||
|
||||
'$run_at_thread_exit'(Id0) :-
|
||||
recorded('$thread_at_exit',[Id0|AtExit],R), erase(R),
|
||||
catch(once(AtExit), _, fail),
|
||||
'$thread_run_at_exit'(G, M),
|
||||
catch(once(M:G), _, fail),
|
||||
fail.
|
||||
'$run_at_thread_exit'(Id0) :-
|
||||
recorded('$thread_exit_hook',[Id0|Hook],R), erase(R),
|
||||
@ -541,12 +527,10 @@ message_queue_create(Id, Options) :-
|
||||
var(Options), !,
|
||||
'$do_error'(instantiation_error, message_queue_create(Id, Options)).
|
||||
message_queue_create(Id, []) :- !,
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$new_mutex'(Mutex),
|
||||
'$cond_create'(Cond),
|
||||
'$mq_new_id'(Id, NId, Key),
|
||||
recorda('$queue',q(Id,Mutex,Cond,NId,Key), _),
|
||||
'$unlock_mutex'(QMutex).
|
||||
recorda('$queue',q(Id,Mutex,Cond,NId,Key), _).
|
||||
message_queue_create(Id, [alias(Alias)]) :-
|
||||
var(Alias), !,
|
||||
'$do_error'(instantiation_error, message_queue_create(Id, [alias(Alias)])).
|
||||
@ -554,19 +538,14 @@ message_queue_create(Id, [alias(Alias)]) :-
|
||||
\+ atom(Alias), !,
|
||||
'$do_error'(type_error(atom,Alias), message_queue_create(Id, [alias(Alias)])).
|
||||
message_queue_create(Id, [alias(Alias)]) :- !,
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$lock_mutex'(QMutex),
|
||||
'$new_mutex'(Mutex),
|
||||
'$cond_create'(Cond),
|
||||
( recorded('$queue', q(Alias,_,_,_,_), _) ->
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
|
||||
; recorded('$thread_alias', [_|Alias], _) ->
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
|
||||
; '$mq_new_id'(Id, NId, Key),
|
||||
recorda('$queue',q(Alias,Mutex,Cond,NId,Key), _),
|
||||
'$unlock_mutex'(QMutex)
|
||||
recorda('$queue',q(Alias,Mutex,Cond,NId,Key), _)
|
||||
).
|
||||
message_queue_create(Id, [Option| _]) :-
|
||||
'$do_error'(domain_error(queue_option, Option), message_queue_create(Id, [Option| _])).
|
||||
@ -582,12 +561,13 @@ message_queue_create(Id) :-
|
||||
).
|
||||
|
||||
'$create_thread_mq'(TId) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$new_mutex'(Mutex),
|
||||
'$cond_create'(Cond),
|
||||
'$mq_new_id'(TId, TId, Key),
|
||||
recorda('$queue', q(TId,Mutex,Cond,TId,Key), _),
|
||||
'$unlock_mutex'(QMutex).
|
||||
fail.
|
||||
% recover space
|
||||
'$create_thread_mq'(_).
|
||||
|
||||
'$mq_new_id'(Id, Id, AtId) :-
|
||||
integer(Id), !,
|
||||
@ -609,21 +589,22 @@ message_queue_create(Id) :-
|
||||
message_queue_destroy(Name) :-
|
||||
var(Name), !,
|
||||
'$do_error'(instantiation_error,message_queue_destroy(Name)).
|
||||
message_queue_destroy(Queue) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$lock_mutex'(QMutex),
|
||||
message_queue_destroy(Name) :-
|
||||
'$message_queue_destroy'(Name),
|
||||
fail.
|
||||
message_queue_destroy(_).
|
||||
|
||||
|
||||
'$message_queue_destroy'(Queue) :-
|
||||
recorded('$queue',q(Queue,Mutex,Cond,_,QKey),R), !,
|
||||
erase(R),
|
||||
'$cond_destroy'(Cond),
|
||||
'$destroy_mutex'(Mutex),
|
||||
'$clean_mqueue'(QKey),
|
||||
'$unlock_mutex'(QMutex).
|
||||
message_queue_destroy(Queue) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$clean_mqueue'(QKey).
|
||||
'$message_queue_destroy'(Queue) :-
|
||||
atomic(Queue), !,
|
||||
'$do_error'(existence_error(message_queue,Queue),message_queue_destroy(Queue)).
|
||||
message_queue_destroy(Name) :-
|
||||
'$message_queue_destroy'(Name) :-
|
||||
'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
|
||||
|
||||
'$clean_mqueue'(Queue) :-
|
||||
@ -684,17 +665,18 @@ thread_send_message(Queue, Term) :-
|
||||
recorded('$thread_alias',[Id|Queue],_), !,
|
||||
thread_send_message(Id, Term).
|
||||
thread_send_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$lock_mutex'(QMutex),
|
||||
'$do_thread_send_message'(Queue, Term),
|
||||
fail.
|
||||
% release pointers
|
||||
thread_send_message(_, _).
|
||||
|
||||
'$do_thread_send_message'(Queue, Term) :-
|
||||
recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
|
||||
'$lock_mutex'(Mutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
recordz(Key,Term,_),
|
||||
'$cond_signal'(Cond),
|
||||
'$unlock_mutex'(Mutex).
|
||||
thread_send_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$do_thread_send_message'(Queue, Term) :-
|
||||
'$do_error'(existence_error(queue,Queue),thread_send_message(Queue,Term)).
|
||||
|
||||
thread_get_message(Term) :-
|
||||
@ -707,15 +689,10 @@ thread_get_message(Queue, Term) :-
|
||||
recorded('$thread_alias',[Id|Queue],_), !,
|
||||
thread_get_message(Id, Term).
|
||||
thread_get_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$lock_mutex'(QMutex),
|
||||
recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
|
||||
'$lock_mutex'(Mutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
|
||||
thread_get_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$do_error'(existence_error(message_queue,Queue),thread_get_message(Queue,Term)).
|
||||
|
||||
|
||||
@ -737,15 +714,10 @@ thread_peek_message(Queue, Term) :-
|
||||
recorded('$thread_alias',[Id|Queue],_), !,
|
||||
thread_peek_message(Id, Term).
|
||||
thread_peek_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$lock_mutex'(QMutex),
|
||||
recorded('$queue',q(Queue,Mutex,_,_,Key),_), !,
|
||||
'$lock_mutex'(Mutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$thread_peek_message2'(Key, Term, Mutex).
|
||||
thread_peek_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$do_error'(existence_error(message_queue,Queue),thread_peek_message(Queue,Term)).
|
||||
|
||||
|
||||
@ -826,7 +798,7 @@ thread_property(Prop) :-
|
||||
thread_property(Id, Prop) :-
|
||||
( nonvar(Id) ->
|
||||
'$check_thread_or_alias'(Id, thread_property(Id, Prop))
|
||||
; recorded('$thread_sizes', [Id| _], _)
|
||||
; '$thread_stacks'(Id, _, _, _)
|
||||
),
|
||||
'$check_thread_property'(Prop, thread_property(Id, Prop)),
|
||||
'$thread_id_alias'(Id0, Id),
|
||||
@ -835,21 +807,22 @@ thread_property(Id, Prop) :-
|
||||
'$thread_property'(Id, alias(Alias)) :-
|
||||
recorded('$thread_alias', [Id|Alias], _).
|
||||
'$thread_property'(Id, status(Status)) :-
|
||||
( recorded('$thread_exit_status', [Id|Exit], _) ->
|
||||
'$mk_tstatus_key'(Id, Key),
|
||||
( recorded(Key, Exit, _) ->
|
||||
Status = Exit
|
||||
; Status = running
|
||||
).
|
||||
'$thread_property'(Id, detached(Detached)) :-
|
||||
'$thread_detached'(Detached).
|
||||
'$thread_property'(Id, at_exit(AtExit)) :-
|
||||
recorded('$thread_at_exit', [Id|AtExit], _).
|
||||
'$thread_property'(Id, stack(Stack)) :-
|
||||
recorded('$thread_sizes', [Id, Stack, _, _], _).
|
||||
'$thread_property'(Id, trail(Trail)) :-
|
||||
recorded('$thread_sizes', [Id, _, Trail, _], _).
|
||||
'$thread_property'(Id, system(System)) :-
|
||||
recorded('$thread_sizes', [Id, _, _, System], _).
|
||||
'$thread_property'(Id, at_exit(M:G)) :-
|
||||
'$thread_run_at_exit'(G,M).
|
||||
'$thread_property'(Id, InfoSize) :-
|
||||
'$thread_stacks'(Id, Stack, Trail, System),
|
||||
'$select_thread_property'(InfoSize, Stack, Trail, System).
|
||||
|
||||
'$select_thread_property'(stack(Stack), Stack, _, _).
|
||||
'$select_thread_property'(trail(Trail), _, Trail, _).
|
||||
'$select_thread_property'(system(System), _, _, System).
|
||||
|
||||
threads :-
|
||||
format(user_error,'------------------------------------------------------------------------~n',[]),
|
||||
@ -919,3 +892,7 @@ threads :-
|
||||
).
|
||||
'$check_mutex_property'(Term, Goal) :-
|
||||
'$do_error'(domain_error(mutex_property, Term), Goal).
|
||||
|
||||
'$mk_tstatus_key'(Id0, Key) :-
|
||||
atomic_concat('$thread_exit_status__',Id0,Key).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user