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 2008-08-07 20:51:23 +00:00
parent 6d23a23a81
commit 2581c3a3bf
15 changed files with 221 additions and 153 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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