more thread fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2297 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
ea812ad059
commit
85d7d39dbf
34
C/absmi.c
34
C/absmi.c
|
|
@ -10,8 +10,13 @@
|
|||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2008-06-17 13:37:48 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-06 17:32:18 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.242 2008/06/17 13:37:48 vsc
|
||||
* fix c_interface not to crash when people try to recover slots that are
|
||||
* not there.
|
||||
* fix try_logical and friends to handle case where predicate has arity 0.
|
||||
*
|
||||
* Revision 1.241 2008/06/04 14:47:18 vsc
|
||||
* make sure we do trim_trail whenever we mess with B!
|
||||
*
|
||||
|
|
@ -1559,6 +1564,11 @@ Yap_absmi(int inp)
|
|||
|
||||
ASP = YREG+E_CB;
|
||||
saveregs();
|
||||
if (cl->ClSource == NULL) {
|
||||
fprintf(stderr,"%d CLLLLL %p %p %s\n",worker_id,cl,cl->ClSource,RepAtom(cl->ClPred->FunctorOfPred)->StrOfAE);
|
||||
exit(1);
|
||||
FAIL();
|
||||
}
|
||||
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
||||
|
|
@ -8200,9 +8210,11 @@ Yap_absmi(int inp)
|
|||
CACHE_Y(B);
|
||||
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
PP = PREG->u.lld.d->ClPred;
|
||||
if (!PP) {
|
||||
PP = PREG->u.lld.d->ClPred;
|
||||
LOCK(PP->PELock);
|
||||
}
|
||||
#endif
|
||||
LOCK(PP->PELock);
|
||||
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.lld.t.s]);
|
||||
/* fprintf(stderr,"^ %p/%p %d %d %d--%u\n",PREG,PREG->u.lld.d->ClPred,timestamp,PREG->u.lld.d->ClPred->TimeStampOfPred,PREG->u.lld.d->ClTimeStart,PREG->u.lld.d->ClTimeEnd);*/
|
||||
if (!VALID_TIMESTAMP(timestamp, PREG->u.lld.d)) {
|
||||
|
|
@ -8234,15 +8246,17 @@ Yap_absmi(int inp)
|
|||
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
|
||||
|
||||
/* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->u.lld.d->ClCode);*/
|
||||
LOCK(ap->PELock);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (!PP) {
|
||||
LOCK(ap->PELock);
|
||||
PP = ap;
|
||||
}
|
||||
#endif
|
||||
if (!VALID_TIMESTAMP(timestamp, lcl)) {
|
||||
/* jump to next alternative */
|
||||
PREG = FAILCODE;
|
||||
} else {
|
||||
PREG = lcl->ClCode;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
PP = ap;
|
||||
#endif
|
||||
}
|
||||
/* HEY, leave indexing block alone!! */
|
||||
/* check if we are the ones using this code */
|
||||
|
|
@ -8327,6 +8341,12 @@ Yap_absmi(int inp)
|
|||
}
|
||||
SET_BB(B_YREG);
|
||||
ENDCACHE_Y();
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (PREG == FAILCODE) {
|
||||
UNLOCK(PP->PELock);
|
||||
PP = NULL;
|
||||
}
|
||||
#endif
|
||||
JMPNext();
|
||||
}
|
||||
ENDBOp();
|
||||
|
|
|
|||
10
C/compiler.c
10
C/compiler.c
|
|
@ -11,8 +11,11 @@
|
|||
* File: compiler.c *
|
||||
* comments: Clause compiler *
|
||||
* *
|
||||
* Last rev: $Date: 2008-03-13 14:37:58 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-08-06 17:32:18 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.88 2008/03/13 14:37:58 vsc
|
||||
* update chr
|
||||
*
|
||||
* Revision 1.87 2007/12/18 17:46:58 vsc
|
||||
* purge_clauses does not need to do anything if there are no clauses
|
||||
* fix gprof bugs.
|
||||
|
|
@ -701,10 +704,13 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
|
|||
write_num_op), (CELL) t, Zero, &cglobs->cint);
|
||||
} else if (IsPairTerm(t)) {
|
||||
if (optimizer_on && level < 6) {
|
||||
#if !defined(THREADS)
|
||||
/* discard code sharing because we cannot write on shared stuff */
|
||||
if (!(cglobs->cint.CurrentPred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) {
|
||||
if (try_store_as_dbterm(t, argno, arity, level, cglobs))
|
||||
return;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
t = optimize_ce(t, arity, level, cglobs);
|
||||
if (IsVarTerm(t)) {
|
||||
c_var(t, argno, arity, level, cglobs);
|
||||
|
|
|
|||
17
C/dbase.c
17
C/dbase.c
|
|
@ -1504,7 +1504,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
|||
NOfCells = ntp - ntp0; /* End Of Code Info */
|
||||
*dbg->lr++ = 0;
|
||||
NOfLinks = (dbg->lr - dbg->LinkAr);
|
||||
if (vars_found || InFlag & InQueue) {
|
||||
if (vars_found || InFlag & InQueue ) {
|
||||
|
||||
/*
|
||||
* Take into account the fact that one needs an entry
|
||||
|
|
@ -1800,10 +1800,16 @@ new_lu_db_entry(Term t, PredEntry *pe)
|
|||
yamop *ipc;
|
||||
int needs_vars = FALSE;
|
||||
struct db_globs dbg;
|
||||
int d_flag = 0;
|
||||
|
||||
#ifdef THREADS
|
||||
/* we cannot allow sharing between threads (for now) */
|
||||
if (!(pe->PredFlags & ThreadLocalPredFlag))
|
||||
d_flag |= InQueue;
|
||||
#endif
|
||||
s_dbg = &dbg;
|
||||
ipc = NEXTOP(((LogUpdClause *)NULL)->ClCode,e);
|
||||
if ((x = (DBTerm *)CreateDBStruct(t, NULL, 0, &needs_vars, (UInt)ipc, &dbg)) == NULL) {
|
||||
if ((x = (DBTerm *)CreateDBStruct(t, NULL, d_flag, &needs_vars, (UInt)ipc, &dbg)) == NULL) {
|
||||
return NULL; /* crash */
|
||||
}
|
||||
cl = (LogUpdClause *)((ADDR)x-(UInt)ipc);
|
||||
|
|
@ -1928,7 +1934,7 @@ static Int
|
|||
p_rcda(void)
|
||||
{
|
||||
/* Idiotic xlc's cpp does not work with ARG1 within MkDBRefTerm */
|
||||
Term TRef, t1 = Deref(ARG1), t2 = Deref(ARG2);
|
||||
Term TRef, t1 = Deref(ARG1);
|
||||
PredEntry *pe = NULL;
|
||||
|
||||
if (!IsVarTerm(Deref(ARG3)))
|
||||
|
|
@ -1940,7 +1946,7 @@ p_rcda(void)
|
|||
LogUpdClause *cl;
|
||||
|
||||
LOCK(pe->PELock);
|
||||
cl = record_lu(pe, t2, MkFirst);
|
||||
cl = record_lu(pe, Deref(ARG2), MkFirst);
|
||||
if (cl != NULL) {
|
||||
TRAIL_CLREF(cl);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
|
|
@ -1954,11 +1960,10 @@ p_rcda(void)
|
|||
}
|
||||
UNLOCK(pe->PELock);
|
||||
} else {
|
||||
TRef = MkDBRefTerm(record(MkFirst, t1, t2, Unsigned(0)));
|
||||
TRef = MkDBRefTerm(record(MkFirst, t1, Deref(ARG2), Unsigned(0)));
|
||||
}
|
||||
if (Yap_Error_TYPE != YAP_NO_ERROR) {
|
||||
if (recover_from_record_error(3)) {
|
||||
t2 = Deref(ARG2);
|
||||
goto restart_record;
|
||||
} else {
|
||||
return FALSE;
|
||||
|
|
|
|||
1
C/init.c
1
C/init.c
|
|
@ -985,6 +985,7 @@ InitCodes(void)
|
|||
Yap_heap_regs->thread_handle[0].handle = pthread_self();
|
||||
Yap_heap_regs->thread_handle[0].handle = pthread_self();
|
||||
pthread_mutex_init(&ThreadHandle[0].tlock, NULL);
|
||||
pthread_mutex_init(&ThreadHandle[0].tlock_status, NULL);
|
||||
Yap_heap_regs->n_of_threads = 1;
|
||||
Yap_heap_regs->n_of_threads_created = 1;
|
||||
Yap_heap_regs->threads_total_time = 0;
|
||||
|
|
|
|||
96
C/threads.c
96
C/threads.c
|
|
@ -38,11 +38,9 @@ static char SccsId[] = "%W% %G%";
|
|||
*
|
||||
*/
|
||||
|
||||
#if DEBUG
|
||||
|
||||
#if DEBUGX
|
||||
static void DEBUG_TLOCK_ACCESS( int pos, int wid) {
|
||||
ThreadHandle[wid].been_here2 = ThreadHandle[wid].been_here1;
|
||||
ThreadHandle[wid].been_here1 = pos;
|
||||
fprintf(stderr,"wid=%p %p\n", wid, pos);
|
||||
}
|
||||
#else
|
||||
#define DEBUG_TLOCK_ACCESS(WID, POS)
|
||||
|
|
@ -58,8 +56,8 @@ allocate_new_tid(void)
|
|||
ThreadHandle[new_worker_id].zombie == TRUE) )
|
||||
new_worker_id++;
|
||||
if (new_worker_id < MAX_THREADS) {
|
||||
pthread_mutex_lock(&(ThreadHandle[new_worker_id].tlock));
|
||||
DEBUG_TLOCK_ACCESS(new_worker_id, 0);
|
||||
pthread_mutex_lock(&(ThreadHandle[new_worker_id].tlock));
|
||||
ThreadHandle[new_worker_id].in_use = TRUE;
|
||||
} else {
|
||||
new_worker_id = -1;
|
||||
|
|
@ -98,7 +96,7 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
|||
|
||||
|
||||
static void
|
||||
kill_thread_engine (int wid)
|
||||
kill_thread_engine (int wid, int always_die)
|
||||
{
|
||||
Prop p0 = AbsPredProp(Yap_heap_regs->thread_handle[wid].local_preds);
|
||||
|
||||
|
|
@ -110,33 +108,32 @@ kill_thread_engine (int wid)
|
|||
Yap_FreeCodeSpace((char *)ap);
|
||||
}
|
||||
Yap_KillStacks(wid);
|
||||
Yap_FreeCodeSpace((ADDR)(ThreadHandle[wid].tgoal));
|
||||
ThreadHandle[wid].tgoal = NULL;
|
||||
Yap_heap_regs->wl[wid].active_signals = 0L;
|
||||
free(Yap_heap_regs->wl[wid].scratchpad.ptr);
|
||||
free(ThreadHandle[wid].default_yaam_regs);
|
||||
ThreadHandle[wid].current_yaam_regs = NULL;
|
||||
free(ThreadHandle[wid].start_of_timesp);
|
||||
free(ThreadHandle[wid].last_timep);
|
||||
ThreadHandle[wid].zombie = FALSE;
|
||||
DEBUG_TLOCK_ACCESS(1, wid);
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
LOCK(ThreadHandlesLock);
|
||||
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
|
||||
always_die) {
|
||||
ThreadHandle[wid].zombie = FALSE;
|
||||
ThreadHandle[wid].in_use = FALSE;
|
||||
DEBUG_TLOCK_ACCESS(1, wid);
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
}
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
}
|
||||
|
||||
static void
|
||||
thread_die(int wid, int always_die)
|
||||
{
|
||||
|
||||
LOCK(ThreadHandlesLock);
|
||||
if (!always_die) {
|
||||
/* called by thread itself */
|
||||
ThreadsTotalTime += Yap_cputime();
|
||||
}
|
||||
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
|
||||
always_die) {
|
||||
kill_thread_engine(wid);
|
||||
}
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
kill_thread_engine(wid, always_die);
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -195,6 +192,8 @@ thread_run(void *widp)
|
|||
}
|
||||
}
|
||||
} while (t == 0);
|
||||
free(ThreadHandle[myworker_id].tgoal);
|
||||
ThreadHandle[myworker_id].tgoal = NULL;
|
||||
tgs[1] = ThreadHandle[worker_id].tdetach;
|
||||
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
|
||||
Yap_RunTopGoal(tgoal);
|
||||
|
|
@ -230,6 +229,7 @@ p_create_thread(void)
|
|||
Term x3 = Deref(ARG3);
|
||||
int new_worker_id = IntegerOfTerm(Deref(ARG6));
|
||||
|
||||
// fprintf(stderr," %d --> %d\n", worker_id, new_worker_id);
|
||||
if (IsBigIntTerm(x2))
|
||||
return FALSE;
|
||||
if (IsBigIntTerm(x3))
|
||||
|
|
@ -241,14 +241,13 @@ p_create_thread(void)
|
|||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
/* make sure we can proceed */
|
||||
if (!init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach))
|
||||
return FALSE;
|
||||
ThreadHandle[new_worker_id].id = new_worker_id;
|
||||
ThreadHandle[new_worker_id].ref_count = 1;
|
||||
if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
|
||||
/* wait until the client is initialised */
|
||||
DEBUG_TLOCK_ACCESS(3, new_worker_id);
|
||||
pthread_mutex_unlock(&(ThreadHandle[new_worker_id].tlock));
|
||||
return TRUE;
|
||||
}
|
||||
return FALSE;
|
||||
|
|
@ -304,17 +303,36 @@ p_thread_zombie_self(void)
|
|||
/* make sure the lock is available */
|
||||
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
|
||||
return Yap_unify(MkIntegerTerm(-1), ARG1);
|
||||
pthread_mutex_lock(&(ThreadHandle[worker_id].tlock));
|
||||
DEBUG_TLOCK_ACCESS(4, worker_id);
|
||||
pthread_mutex_lock(&(ThreadHandle[worker_id].tlock));
|
||||
if (Yap_heap_regs->wl[worker_id].active_signals &= YAP_ITI_SIGNAL) {
|
||||
DEBUG_TLOCK_ACCESS(5, worker_id);
|
||||
pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock));
|
||||
return FALSE;
|
||||
}
|
||||
// fprintf(stderr," -- %d\n", worker_id);
|
||||
Yap_heap_regs->thread_handle[worker_id].in_use = FALSE;
|
||||
Yap_heap_regs->thread_handle[worker_id].zombie = TRUE;
|
||||
DEBUG_TLOCK_ACCESS(6, worker_id);
|
||||
pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock));
|
||||
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_status_lock(void)
|
||||
{
|
||||
/* make sure the lock is available */
|
||||
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
|
||||
return FALSE;
|
||||
pthread_mutex_lock(&(ThreadHandle[worker_id].tlock_status));
|
||||
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_status_unlock(void)
|
||||
{
|
||||
/* make sure the lock is available */
|
||||
if (pthread_getspecific(Yap_yaamregs_key) == NULL)
|
||||
return FALSE;
|
||||
pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock_status));
|
||||
return Yap_unify(MkIntegerTerm(worker_id), ARG1);
|
||||
}
|
||||
|
||||
|
|
@ -346,8 +364,8 @@ Yap_thread_create_engine(thread_attr *ops)
|
|||
Int
|
||||
Yap_thread_attach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
DEBUG_TLOCK_ACCESS(7, wid);
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
if (ThreadHandle[wid].ref_count &&
|
||||
ThreadHandle[wid].handle != pthread_self()) {
|
||||
DEBUG_TLOCK_ACCESS(8, wid);
|
||||
|
|
@ -365,8 +383,8 @@ Yap_thread_attach_engine(int wid)
|
|||
Int
|
||||
Yap_thread_detach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
DEBUG_TLOCK_ACCESS(10, wid);
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
if (ThreadHandle[wid].handle == pthread_self())
|
||||
ThreadHandle[wid].handle = 0;
|
||||
ThreadHandle[wid].ref_count--;
|
||||
|
|
@ -379,7 +397,7 @@ Int
|
|||
Yap_thread_destroy_engine(int wid)
|
||||
{
|
||||
if (ThreadHandle[wid].ref_count == 0) {
|
||||
kill_thread_engine(wid);
|
||||
kill_thread_engine(wid, TRUE);
|
||||
return TRUE;
|
||||
} else {
|
||||
DEBUG_TLOCK_ACCESS(12, wid);
|
||||
|
|
@ -404,8 +422,6 @@ p_thread_join(void)
|
|||
UNLOCK(ThreadHandlesLock);
|
||||
return FALSE;
|
||||
}
|
||||
pthread_mutex_lock(&(ThreadHandle[tid].tlock));
|
||||
DEBUG_TLOCK_ACCESS(13, tid);
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
/* make sure this lock is accessible */
|
||||
if (pthread_join(ThreadHandle[tid].handle, NULL) < 0) {
|
||||
|
|
@ -421,7 +437,12 @@ p_thread_destroy(void)
|
|||
{
|
||||
Int tid = IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
thread_die(tid, TRUE);
|
||||
LOCK(ThreadHandlesLock);
|
||||
ThreadHandle[tid].zombie = FALSE;
|
||||
ThreadHandle[tid].in_use = FALSE;
|
||||
DEBUG_TLOCK_ACCESS(32, tid);
|
||||
pthread_mutex_unlock(&(ThreadHandle[tid].tlock));
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
|
@ -444,6 +465,12 @@ p_thread_detach(void)
|
|||
return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_detached(void)
|
||||
{
|
||||
return Yap_unify(ARG1,ThreadHandle[worker_id].tdetach);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_exit(void)
|
||||
{
|
||||
|
|
@ -698,9 +725,16 @@ p_thread_runtime(void)
|
|||
return Yap_unify(ARG1,MkIntegerTerm(ThreadsTotalTime));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_self_lock(void)
|
||||
{ /* '$thread_unlock' */
|
||||
pthread_mutex_lock(&(ThreadHandle[worker_id].tlock));
|
||||
return Yap_unify(ARG1,MkIntegerTerm(worker_id));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_unlock(void)
|
||||
{ /* '$thread_self_lock' */
|
||||
{ /* '$thread_unlock' */
|
||||
Int wid = IntegerOfTerm(Deref(ARG1));
|
||||
DEBUG_TLOCK_ACCESS(19, wid);
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
|
|
@ -715,11 +749,14 @@ void Yap_InitThreadPreds(void)
|
|||
Yap_InitCPred("$thread_new_tid", 1, p_thread_new_tid, HiddenPredFlag);
|
||||
Yap_InitCPred("$create_thread", 6, 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);
|
||||
Yap_InitCPred("$thread_zombie_self", 1, p_thread_zombie_self, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_join", 1, p_thread_join, HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, HiddenPredFlag);
|
||||
Yap_InitCPred("thread_yield", 0, p_thread_yield, 0);
|
||||
Yap_InitCPred("$detach_thread", 1, p_thread_detach, HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_detached", 1, p_thread_detached, HiddenPredFlag);
|
||||
Yap_InitCPred("$thread_exit", 0, p_thread_exit, HiddenPredFlag);
|
||||
Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0);
|
||||
Yap_InitCPred("$valid_thread", 1, p_valid_thread, HiddenPredFlag);
|
||||
|
|
@ -739,6 +776,7 @@ void Yap_InitThreadPreds(void)
|
|||
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_unlock", 1, p_thread_unlock, SafePredFlag);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
|
|||
omax_write_args = max_write_args;
|
||||
max_depth = 5;
|
||||
max_list = 5;
|
||||
max_write_args = 5;
|
||||
max_write_args = 10;
|
||||
Yap_plwrite(args[i], TracePutchar, Handle_vars_f);
|
||||
max_depth = omax_depth;
|
||||
max_list = omax_list;
|
||||
|
|
@ -361,6 +361,12 @@ static Int p_start_low_level_trace(void)
|
|||
return(TRUE);
|
||||
}
|
||||
|
||||
static Int p_show_low_level_trace(void)
|
||||
{
|
||||
fprintf(stderr,"Call counter=%lld\n",vsc_count);
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
#ifdef THREADS
|
||||
static Int p_start_low_level_trace2(void)
|
||||
{
|
||||
|
|
@ -395,6 +401,7 @@ Yap_InitLowLevelTrace(void)
|
|||
Yap_InitCPred("start_low_level_trace", 1, p_start_low_level_trace2, SafePredFlag);
|
||||
#endif
|
||||
Yap_InitCPred("stop_low_level_trace", 0, p_stop_low_level_trace, SafePredFlag);
|
||||
Yap_InitCPred("show_low_level_trace", 0, p_show_low_level_trace, SafePredFlag);
|
||||
Yap_InitCPred("vsc_wait", 0, p_vsc_wait, SafePredFlag);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -24,6 +24,9 @@ static char SccsId[] = "@(#)utilpreds.c 1.3";
|
|||
#include "yapio.h"
|
||||
#include "eval.h"
|
||||
#include "attvar.h"
|
||||
#ifdef HAVE_STRING_H
|
||||
#include "string.h"
|
||||
#endif
|
||||
|
||||
typedef struct {
|
||||
Term old_var;
|
||||
|
|
@ -168,9 +171,30 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
|
|||
INC_DBREF_COUNT(entryref);
|
||||
UNLOCK(entryref->lock);
|
||||
}
|
||||
*ptf++ = d0; /* you can just copy other extensions. */
|
||||
}
|
||||
#endif
|
||||
*ptf++ = d0; /* you can just copy other extensions. */
|
||||
else if (!share) {
|
||||
UInt sz;
|
||||
|
||||
*ptf++ = AbsAppl(H); /* you can just copy other extensions. */
|
||||
/* make sure to copy floats */
|
||||
if (f== FunctorDouble) {
|
||||
sz = sizeof(Float)/sizeof(CELL)+2;
|
||||
} else if (f== FunctorLongInt) {
|
||||
sz = 3;
|
||||
} else {
|
||||
CELL *pt = ap2+1;
|
||||
sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
|
||||
}
|
||||
if (H+sz > ASP - 2048) {
|
||||
goto overflow;
|
||||
}
|
||||
memcpy((void *)H, (void *)ap2, sz*sizeof(CELL));
|
||||
H += sz;
|
||||
} else {
|
||||
*ptf++ = d0; /* you can just copy other extensions. */
|
||||
}
|
||||
continue;
|
||||
}
|
||||
*ptf = AbsAppl(H);
|
||||
|
|
@ -252,7 +276,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
|
|||
goto trail_overflow;
|
||||
}
|
||||
}
|
||||
Bind_Global(ptd0, ptf[-1]);
|
||||
Bind(ptd0, ptf[-1]);
|
||||
}
|
||||
} else {
|
||||
#endif
|
||||
|
|
@ -264,7 +288,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
|
|||
goto trail_overflow;
|
||||
}
|
||||
}
|
||||
Bind_Global(ptd0, (CELL)ptf);
|
||||
Bind(ptd0, (CELL)ptf);
|
||||
ptf++;
|
||||
#ifdef COROUTINING
|
||||
}
|
||||
|
|
@ -482,6 +506,11 @@ Yap_CopyTerm(Term inp) {
|
|||
return CopyTerm(inp, 0, TRUE, TRUE);
|
||||
}
|
||||
|
||||
Term
|
||||
Yap_CopyTermNoShare(Term inp) {
|
||||
return CopyTerm(inp, 0, FALSE, FALSE);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_copy_term(void) /* copy term t to a new instance */
|
||||
{
|
||||
|
|
|
|||
3
H/Heap.h
3
H/Heap.h
|
|
@ -10,7 +10,7 @@
|
|||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.133 2008-07-22 23:34:49 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.134 2008-08-06 17:32:20 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
|
|
@ -202,6 +202,7 @@ typedef struct thandle {
|
|||
int been_here2;
|
||||
#endif
|
||||
pthread_mutex_t tlock;
|
||||
pthread_mutex_t tlock_status;
|
||||
#if HAVE_GETRUSAGE
|
||||
struct timeval *start_of_timesp;
|
||||
struct timeval *last_timep;
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.88 2008-07-24 16:02:02 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.89 2008-08-06 17:32:21 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
|
|
@ -343,6 +343,7 @@ void STD_PROTO(Yap_InitUserBacks,(void));
|
|||
|
||||
/* utilpreds.c */
|
||||
Term STD_PROTO(Yap_CopyTerm,(Term));
|
||||
Term STD_PROTO(Yap_CopyTermNoShare,(Term));
|
||||
int STD_PROTO(Yap_SizeGroundTerm,(Term, int));
|
||||
void STD_PROTO(Yap_InitUtilCPreds,(void));
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* $Id: apply_macros.pl,v 1.2 2008-05-15 13:41:46 vsc Exp $
|
||||
/* $Id: apply_macros.pl,v 1.3 2008-08-06 17:32:21 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
|
|
@ -179,7 +179,7 @@ contains_illegal_dcgnt(NT) :-
|
|||
|
||||
% @tbd Should we only apply if optimization is enabled (-O)?
|
||||
|
||||
user:goal_expansion(GoalIn, GoalOut) :-
|
||||
user:goal_expansion(GoalIn, M, GoalOut) :-
|
||||
\+ current_prolog_flag(xref, true),
|
||||
expand_apply(GoalIn, GoalOut).
|
||||
expand_apply(M:GoalIn, GoalOut).
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,9 @@
|
|||
|
||||
<h2>Yap-5.1.4:</h2>
|
||||
<ul>
|
||||
<li> NEW: seletchk/3.</li>
|
||||
<li> FIXED: do meta-expansion from undefp.</li>
|
||||
<li> FIXED: handle correctly flatten([_,[_]],L).</li>
|
||||
<li> FIXED: bad syntax in config.h (patch from Keri Harris).</li>
|
||||
<li> NEW: format over atom/1.</li>
|
||||
<li> FIXED: clean up apply_macros in swi mode.</li>
|
||||
|
|
|
|||
|
|
@ -70,6 +70,9 @@ swi_predicate_table(_,sumlist(X,Y),lists,sumlist(X,Y)).
|
|||
swi_predicate_table(_,min_list(X,Y),lists,min_list(X,Y)).
|
||||
swi_predicate_table(_,max_list(X,Y),lists,max_list(X,Y)).
|
||||
swi_predicate_table(_,memberchk(X,Y),lists,memberchk(X,Y)).
|
||||
swi_predicate_table(_,flatten(X,Y),lists,flatten(X,Y)).
|
||||
swi_predicate_table(_,select(X,Y,Z),lists,select(X,Y,Z)).
|
||||
swi_predicate_table(_,sublist(X,Y),lists,sublist(X,Y)).
|
||||
swi_predicate_table(_,hash_term(X,Y),terms,term_hash(X,Y)).
|
||||
swi_predicate_table(_,term_hash(X,Y),terms,term_hash(X,Y)).
|
||||
swi_predicate_table(_,subsumes(X,Y),terms,subsumes(X,Y)).
|
||||
|
|
@ -389,6 +392,71 @@ maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
|||
% True if Goal can succesfully be applied to all succesive
|
||||
% quadruples of elements of List1..List4
|
||||
|
||||
prolog:maplist(Goal, List1, List2, List3, List4) :-
|
||||
maplist2(List1, List2, List3, List4, Goal).
|
||||
|
||||
maplist2([], [], [], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
|
||||
call(Goal, Elem1, Elem2, Elem3, Elem4),
|
||||
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
|
||||
|
||||
=======
|
||||
% copied from SWI's boot/apply library
|
||||
:- module_transparent
|
||||
prolog:maplist/2,
|
||||
maplist2/2,
|
||||
prolog:maplist/3,
|
||||
maplist2/3,
|
||||
prolog:maplist/4,
|
||||
maplist2/4,
|
||||
prolog:maplist/5,
|
||||
maplist2/5.
|
||||
|
||||
% maplist(:Goal, +List)
|
||||
%
|
||||
% True if Goal can succesfully be applied on all elements of List.
|
||||
% Arguments are reordered to gain performance as well as to make
|
||||
% the predicate deterministic under normal circumstances.
|
||||
|
||||
prolog:maplist(Goal, List) :-
|
||||
maplist2(List, Goal).
|
||||
|
||||
maplist2([], _).
|
||||
maplist2([Elem|Tail], Goal) :-
|
||||
call(Goal, Elem),
|
||||
maplist2(Tail, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive pairs
|
||||
% of elements of List1 and List2.
|
||||
|
||||
prolog:maplist(Goal, List1, List2) :-
|
||||
maplist2(List1, List2, Goal).
|
||||
|
||||
maplist2([], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
||||
call(Goal, Elem1, Elem2),
|
||||
maplist2(Tail1, Tail2, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2, ?List3)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive triples
|
||||
% of elements of List1..List3.
|
||||
|
||||
prolog:maplist(Goal, List1, List2, List3) :-
|
||||
maplist2(List1, List2, List3, Goal).
|
||||
|
||||
maplist2([], [], [], _).
|
||||
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
||||
call(Goal, Elem1, Elem2, Elem3),
|
||||
maplist2(Tail1, Tail2, Tail3, Goal).
|
||||
|
||||
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
||||
%
|
||||
% True if Goal can succesfully be applied to all succesive
|
||||
% quadruples of elements of List1..List4
|
||||
|
||||
prolog:maplist(Goal, List1, List2, List3, List4) :-
|
||||
maplist2(List1, List2, List3, List4, Goal).
|
||||
|
||||
|
|
|
|||
|
|
@ -46,36 +46,29 @@
|
|||
|
||||
'$close_thread'(Status, Detached) :-
|
||||
'$thread_zombie_self'(Id0), !,
|
||||
'$close_thread'(Status, Detached, Id0).
|
||||
'$close_thread'(Status, Detached) :- !,
|
||||
% zombie_self failed as it the thread was messages pending
|
||||
'$close_thread'(Status, Detached).
|
||||
|
||||
|
||||
'$close_thread'('$thread_finished'(Status), Detached, Id0) :- !,
|
||||
recorda('$thread_exit_status', [Id0|Status], _),
|
||||
'$record_thread_status'(Id0,Status),
|
||||
'$run_at_thread_exit'(Id0),
|
||||
( Detached == true ->
|
||||
'$erase_thread_info'(Id0)
|
||||
; true
|
||||
).
|
||||
% format(user_error,'closing thread ~w~n',[v([Id0|Status])]).
|
||||
'$close_thread'(Exception, Detached, Id0) :-
|
||||
( recorded('$thread_exit_status', [Id0|_], R), erase(R), fail
|
||||
; recorda('$thread_exit_status', [Id0|exception(Exception)], _)
|
||||
),
|
||||
'$run_at_thread_exit'(Id0),
|
||||
( Detached == true ->
|
||||
'$erase_thread_info'(Id0)
|
||||
; true
|
||||
).
|
||||
'$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
|
||||
;
|
||||
Stat = '$thread_finished'(Status) ->
|
||||
recorda('$thread_exit_status', [Id0|Status], _)
|
||||
;
|
||||
recorda('$thread_exit_status', [Id0|exception(Stat)], _)
|
||||
).
|
||||
|
||||
thread_create(Goal) :-
|
||||
G0 = thread_create(Goal),
|
||||
'$check_callable'(Goal, G0),
|
||||
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
'$erase_thread_info'(Id),
|
||||
% '$erase_thread_info'(Id), % this should not be here
|
||||
'$record_thread_info'(Id, [Stack, Trail, System], Detached, AtExit),
|
||||
'$create_thread_mq'(Id),
|
||||
(
|
||||
|
|
@ -92,7 +85,7 @@ thread_create(Goal, Id) :-
|
|||
( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
|
||||
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
'$erase_thread_info'(Id),
|
||||
% '$erase_thread_info'(Id), % this should not be here
|
||||
'$record_thread_info'(Id, [Stack, Trail, System], Detached, AtExit),
|
||||
'$create_thread_mq'(Id),
|
||||
(
|
||||
|
|
@ -109,7 +102,7 @@ thread_create(Goal, Id, Options) :-
|
|||
( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
|
||||
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, AtExit, G0),
|
||||
'$thread_new_tid'(Id),
|
||||
'$erase_thread_info'(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)
|
||||
|
|
@ -123,10 +116,6 @@ thread_create(Goal, Id, Options) :-
|
|||
recorda('$thread_exit_status', [Id|exception(resource_error(memory))],_)
|
||||
).
|
||||
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_exit_status', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_alias',[Id|_],R),
|
||||
erase(R),
|
||||
|
|
@ -135,10 +124,6 @@ thread_create(Goal, Id, Options) :-
|
|||
recorded('$thread_sizes', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_detached', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
recorded('$thread_at_exit', [Id|_], R),
|
||||
erase(R),
|
||||
|
|
@ -147,6 +132,9 @@ thread_create(Goal, Id, Options) :-
|
|||
recorded('$thread_exit_hook', [Id|_], R),
|
||||
erase(R),
|
||||
fail.
|
||||
'$erase_thread_info'(Id) :-
|
||||
message_queue_destroy(Id),
|
||||
fail.
|
||||
'$erase_thread_info'(_).
|
||||
|
||||
|
||||
|
|
@ -190,7 +178,6 @@ thread_create(Goal, Id, Options) :-
|
|||
|
||||
'$record_thread_info'(Id, Sizes, Detached, AtExit) :-
|
||||
recorda('$thread_sizes', [Id|Sizes], _),
|
||||
recorda('$thread_detached', [Id|Detached], _),
|
||||
( AtExit == true ->
|
||||
true
|
||||
; recorda('$thread_at_exit', [Id|AtExit], _)
|
||||
|
|
@ -311,8 +298,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], _),
|
||||
'$erase_thread_info'(Id0),
|
||||
recorded('$thread_exit_status', [Id0|Status], R),
|
||||
erase(R),
|
||||
'$thread_destroy'(Id0).
|
||||
|
||||
thread_cancel(Id) :-
|
||||
|
|
@ -324,16 +311,7 @@ thread_cancel(Id) :-
|
|||
thread_detach(Id) :-
|
||||
'$check_thread_or_alias'(Id, thread_detach(Id)),
|
||||
'$thread_id_alias'(Id0, Id),
|
||||
(
|
||||
recorded('$thread_detached', [Id0|_], R),
|
||||
erase(R),
|
||||
fail
|
||||
;
|
||||
recordz('$thread_detached', [Id0|true], _),
|
||||
fail
|
||||
;
|
||||
'$detach_thread'(Id0)
|
||||
),
|
||||
'$detach_thread'(Id0),
|
||||
( recorded('$thread_exit_status', [Id0|_], _) ->
|
||||
'$erase_thread_info'(Id0),
|
||||
'$thread_destroy'(Id0)
|
||||
|
|
@ -355,8 +333,7 @@ thread_exit(Term) :-
|
|||
recorded('$thread_exit_hook',[Id0|Hook],R), erase(R),
|
||||
catch(once(Hook),_,fail),
|
||||
fail.
|
||||
'$run_at_thread_exit'(Id0) :-
|
||||
message_queue_destroy(Id0).
|
||||
'$run_at_thread_exit'(_).
|
||||
|
||||
thread_at_exit(Goal) :-
|
||||
'$check_callable'(Goal,thread_at_exit(Goal)),
|
||||
|
|
@ -639,8 +616,8 @@ message_queue_destroy(Queue) :-
|
|||
erase(R),
|
||||
'$cond_destroy'(Cond),
|
||||
'$destroy_mutex'(Mutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
'$clean_mqueue'(QKey).
|
||||
'$clean_mqueue'(QKey),
|
||||
'$unlock_mutex'(QMutex).
|
||||
message_queue_destroy(Queue) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
|
|
@ -713,7 +690,7 @@ thread_send_message(Queue, Term) :-
|
|||
'$lock_mutex'(Mutex),
|
||||
'$unlock_mutex'(QMutex),
|
||||
recordz(Key,Term,_),
|
||||
'$cond_broadcast'(Cond),
|
||||
'$cond_signal'(Cond),
|
||||
'$unlock_mutex'(Mutex).
|
||||
thread_send_message(Queue, Term) :-
|
||||
'$global_queue_mutex'(QMutex),
|
||||
|
|
@ -863,7 +840,7 @@ thread_property(Id, Prop) :-
|
|||
; Status = running
|
||||
).
|
||||
'$thread_property'(Id, detached(Detached)) :-
|
||||
recorded('$thread_detached', [Id|Detached], _).
|
||||
'$thread_detached'(Detached).
|
||||
'$thread_property'(Id, at_exit(AtExit)) :-
|
||||
recorded('$thread_at_exit', [Id|AtExit], _).
|
||||
'$thread_property'(Id, stack(Stack)) :-
|
||||
|
|
|
|||
Reference in New Issue