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

Merge branch 'master' of https://www.github.com/vscosta/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2014-11-09 17:30:15 +00:00
commit 24920a230f
4 changed files with 927 additions and 756 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

496
C/threads.c
View File

@ -910,36 +910,36 @@ p_new_mutex( USES_REGS1 )
} }
static Int static Int
p_destroy_mutex( USES_REGS1 ) p_destroy_mutex( USES_REGS1 )
{ {
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
if (pthread_mutex_destroy(&mut->m) < 0) if (pthread_mutex_destroy(&mut->m) < 0)
return FALSE; return FALSE;
Yap_FreeCodeSpace((void *)mut); Yap_FreeCodeSpace((void *)mut);
return TRUE; return TRUE;
} }
static Int static Int
p_lock_mutex( USES_REGS1 ) p_lock_mutex( USES_REGS1 )
{ {
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
#if DEBUG_LOCKS #if DEBUG_LOCKS
MUTEX_LOCK(&mut->m); MUTEX_LOCK(&mut->m);
#else #else
if (MUTEX_LOCK(&mut->m) < 0) if (MUTEX_LOCK(&mut->m) < 0)
return FALSE; return FALSE;
#endif #endif
mut->owners++; mut->owners++;
mut->tid_own = worker_id; mut->tid_own = worker_id;
return TRUE; return TRUE;
} }
static Int static Int
p_trylock_mutex( USES_REGS1 ) p_trylock_mutex( USES_REGS1 )
{ {
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
if (MUTEX_TRYLOCK(&mut->m) == EBUSY) if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
@ -947,26 +947,26 @@ p_trylock_mutex( USES_REGS1 )
mut->owners++; mut->owners++;
mut->tid_own = worker_id; mut->tid_own = worker_id;
return TRUE; return TRUE;
} }
static Int static Int
p_unlock_mutex( USES_REGS1 ) p_unlock_mutex( USES_REGS1 )
{ {
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
#if DEBUG_LOCKS #if DEBUG_LOCKS
MUTEX_UNLOCK(&mut->m); MUTEX_UNLOCK(&mut->m);
#else #else
if (MUTEX_UNLOCK(&mut->m) < 0) if (MUTEX_UNLOCK(&mut->m) < 0)
return FALSE; return FALSE;
#endif #endif
mut->owners--; mut->owners--;
return TRUE; return TRUE;
} }
static Int static Int
p_with_mutex( USES_REGS1 ) p_with_mutex( USES_REGS1 )
{ {
SWIMutex *mut; SWIMutex *mut;
Term t1 = Deref(ARG1), excep; Term t1 = Deref(ARG1), excep;
Int rc = FALSE; Int rc = FALSE;
@ -1037,12 +1037,12 @@ p_with_mutex( USES_REGS1 )
return Yap_JumpToEnv(excep); return Yap_JumpToEnv(excep);
} }
return rc; return rc;
} }
static Int static Int
p_with_with_mutex( USES_REGS1 ) p_with_with_mutex( USES_REGS1 )
{ {
if (GLOBAL_WithMutex == NULL) { if (GLOBAL_WithMutex == NULL) {
p_new_mutex( PASS_REGS1 ); p_new_mutex( PASS_REGS1 );
GLOBAL_WithMutex = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); GLOBAL_WithMutex = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
@ -1050,30 +1050,30 @@ p_with_with_mutex( USES_REGS1 )
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex); ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
} }
return p_lock_mutex( PASS_REGS1 ); return p_lock_mutex( PASS_REGS1 );
} }
static Int static Int
p_unlock_with_mutex( USES_REGS1 ) p_unlock_with_mutex( USES_REGS1 )
{ {
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex); ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
return p_unlock_mutex( PASS_REGS1 ); return p_unlock_mutex( PASS_REGS1 );
} }
static Int static Int
p_mutex_info( USES_REGS1 ) p_mutex_info( USES_REGS1 )
{ {
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) && return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) &&
Yap_unify(ARG3, MkIntegerTerm(mut->tid_own)); Yap_unify(ARG3, MkIntegerTerm(mut->tid_own));
return TRUE; return TRUE;
} }
static Int static Int
p_cond_create( USES_REGS1 ) p_cond_create( USES_REGS1 )
{ {
pthread_cond_t* condp; pthread_cond_t* condp;
condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t)); condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
@ -1082,16 +1082,16 @@ p_cond_create( USES_REGS1 )
} }
pthread_cond_init(condp, NULL); pthread_cond_init(condp, NULL);
return Yap_unify(ARG1, MkIntegerTerm((Int)condp)); return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
} }
typedef struct { typedef struct {
UInt indx; UInt indx;
mbox_t mbox; mbox_t mbox;
} counted_mbox; } counted_mbox;
static Int static Int
p_mbox_create( USES_REGS1 ) p_mbox_create( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = GLOBAL_named_mboxes; mbox_t* mboxp = GLOBAL_named_mboxes;
@ -1125,11 +1125,11 @@ p_mbox_create( USES_REGS1 )
bool rc = mboxCreate( namet, mboxp PASS_REGS ); bool rc = mboxCreate( namet, mboxp PASS_REGS );
UNLOCK(GLOBAL_mboxq_lock); UNLOCK(GLOBAL_mboxq_lock);
return rc; return rc;
} }
static Int static Int
p_mbox_destroy( USES_REGS1 ) p_mbox_destroy( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = GLOBAL_named_mboxes, *prevp; mbox_t* mboxp = GLOBAL_named_mboxes, *prevp;
@ -1157,11 +1157,11 @@ p_mbox_destroy( USES_REGS1 )
mboxDestroy(mboxp PASS_REGS); mboxDestroy(mboxp PASS_REGS);
Yap_FreeCodeSpace( (char *)mboxp ); Yap_FreeCodeSpace( (char *)mboxp );
return TRUE; return TRUE;
} }
static mbox_t* static mbox_t*
getMbox(Term t) getMbox(Term t)
{ {
mbox_t* mboxp; mbox_t* mboxp;
if (IsAtomTerm(t=Deref(t))) { if (IsAtomTerm(t=Deref(t))) {
@ -1199,98 +1199,98 @@ getMbox(Term t)
return NULL; return NULL;
} }
return mboxp; return mboxp;
} }
static Int static Int
p_mbox_send( USES_REGS1 ) p_mbox_send( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ; mbox_t* mboxp = getMbox(namet) ;
if (!mboxp) if (!mboxp)
return FALSE; return FALSE;
return mboxSend(mboxp, Deref(ARG2) PASS_REGS); return mboxSend(mboxp, Deref(ARG2) PASS_REGS);
} }
static Int static Int
p_mbox_size( USES_REGS1 ) p_mbox_size( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ; mbox_t* mboxp = getMbox(namet) ;
if (!mboxp) if (!mboxp)
return FALSE; return FALSE;
return Yap_unify( ARG2, MkIntTerm(mboxp->nmsgs)); return Yap_unify( ARG2, MkIntTerm(mboxp->nmsgs));
} }
static Int static Int
p_mbox_receive( USES_REGS1 ) p_mbox_receive( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ; mbox_t* mboxp = getMbox(namet) ;
if (!mboxp) if (!mboxp)
return FALSE; return FALSE;
return mboxReceive(mboxp, Deref(ARG2) PASS_REGS); return mboxReceive(mboxp, Deref(ARG2) PASS_REGS);
} }
static Int static Int
p_mbox_peek( USES_REGS1 ) p_mbox_peek( USES_REGS1 )
{ {
Term namet = Deref(ARG1); Term namet = Deref(ARG1);
mbox_t* mboxp = getMbox(namet) ; mbox_t* mboxp = getMbox(namet) ;
if (!mboxp) if (!mboxp)
return FALSE; return FALSE;
return mboxPeek(mboxp, Deref(ARG2) PASS_REGS); return mboxPeek(mboxp, Deref(ARG2) PASS_REGS);
} }
static Int static Int
p_cond_destroy( USES_REGS1 ) p_cond_destroy( USES_REGS1 )
{ {
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1)); pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_destroy(condp) < 0) if (pthread_cond_destroy(condp) < 0)
return FALSE; return FALSE;
Yap_FreeCodeSpace((void *)condp); Yap_FreeCodeSpace((void *)condp);
return TRUE; return TRUE;
} }
static Int static Int
p_cond_signal( USES_REGS1 ) p_cond_signal( USES_REGS1 )
{ {
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1)); pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_signal(condp) < 0) if (pthread_cond_signal(condp) < 0)
return FALSE; return FALSE;
return TRUE; return TRUE;
} }
static Int static Int
p_cond_broadcast( USES_REGS1 ) p_cond_broadcast( USES_REGS1 )
{ {
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1)); pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
if (pthread_cond_broadcast(condp) < 0) if (pthread_cond_broadcast(condp) < 0)
return FALSE; return FALSE;
return TRUE; v return TRUE;
} }
static Int static Int
p_cond_wait( USES_REGS1 ) p_cond_wait( USES_REGS1 )
{ {
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1)); pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2)); SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
pthread_cond_wait(condp, &mut->m); pthread_cond_wait(condp, &mut->m);
return TRUE; return TRUE;
} }
static Int static Int
p_thread_stacks( USES_REGS1 ) p_thread_stacks( USES_REGS1 )
{ /* '$thread_signal'(+P) */ { /* '$thread_signal'(+P) */
Int tid = IntegerOfTerm(Deref(ARG1)); Int tid = IntegerOfTerm(Deref(ARG1));
Int status= TRUE; Int status= TRUE;
@ -1305,11 +1305,11 @@ p_thread_stacks( USES_REGS1 )
} }
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(tid).tlock)); MUTEX_UNLOCK(&(REMOTE_ThreadHandle(tid).tlock));
return FALSE; return FALSE;
} }
static Int static Int
p_thread_atexit( USES_REGS1 ) p_thread_atexit( USES_REGS1 )
{ /* '$thread_signal'(+P) */ { /* '$thread_signal'(+P) */
Term t; Term t;
if (LOCAL_ThreadHandle.texit == NULL || if (LOCAL_ThreadHandle.texit == NULL ||
@ -1338,13 +1338,13 @@ p_thread_atexit( USES_REGS1 )
} while (t == 0); } while (t == 0);
LOCAL_ThreadHandle.texit = NULL; LOCAL_ThreadHandle.texit = NULL;
return Yap_unify(ARG1, t) && Yap_unify(ARG2, LOCAL_ThreadHandle.texit_mod); return Yap_unify(ARG1, t) && Yap_unify(ARG2, LOCAL_ThreadHandle.texit_mod);
} }
static Int static Int
p_thread_signal( USES_REGS1 ) p_thread_signal( USES_REGS1 )
{ /* '$thread_signal'(+P) */ { /* '$thread_signal'(+P) */
Int wid = IntegerOfTerm(Deref(ARG1)); Int wid = IntegerOfTerm(Deref(ARG1));
/* make sure the lock is available */ /* make sure the lock is available */
MUTEX_LOCK(&(REMOTE_ThreadHandle(wid).tlock)); MUTEX_LOCK(&(REMOTE_ThreadHandle(wid).tlock));
@ -1356,17 +1356,17 @@ p_thread_signal( USES_REGS1 )
Yap_external_signal( wid, YAP_ITI_SIGNAL ); Yap_external_signal( wid, YAP_ITI_SIGNAL );
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock)); MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
return TRUE; return TRUE;
} }
static Int static Int
p_no_threads( USES_REGS1 ) p_no_threads( USES_REGS1 )
{ /* '$thread_signal'(+P) */ { /* '$thread_signal'(+P) */
return FALSE; return FALSE;
} }
static Int static Int
p_nof_threads( USES_REGS1 ) p_nof_threads( USES_REGS1 )
{ /* '$nof_threads'(+P) */ { /* '$nof_threads'(+P) */
int i = 0, wid; int i = 0, wid;
LOCK(GLOBAL_ThreadHandlesLock); LOCK(GLOBAL_ThreadHandlesLock);
for (wid = 0; wid < MAX_THREADS; wid++) { for (wid = 0; wid < MAX_THREADS; wid++) {
@ -1376,70 +1376,70 @@ p_nof_threads( USES_REGS1 )
} }
UNLOCK(GLOBAL_ThreadHandlesLock); UNLOCK(GLOBAL_ThreadHandlesLock);
return Yap_unify(ARG1,MkIntegerTerm(i)); return Yap_unify(ARG1,MkIntegerTerm(i));
} }
static Int static Int
p_max_workers( USES_REGS1 ) p_max_workers( USES_REGS1 )
{ /* '$max_workers'(+P) */ { /* '$max_workers'(+P) */
return Yap_unify(ARG1,MkIntegerTerm(MAX_WORKERS)); return Yap_unify(ARG1,MkIntegerTerm(MAX_WORKERS));
} }
static Int static Int
p_max_threads( USES_REGS1 ) p_max_threads( USES_REGS1 )
{ /* '$max_threads'(+P) */ { /* '$max_threads'(+P) */
return Yap_unify(ARG1,MkIntegerTerm(MAX_THREADS)); return Yap_unify(ARG1,MkIntegerTerm(MAX_THREADS));
} }
static Int static Int
p_nof_threads_created( USES_REGS1 ) p_nof_threads_created( USES_REGS1 )
{ /* '$nof_threads'(+P) */ { /* '$nof_threads'(+P) */
return Yap_unify(ARG1,MkIntTerm(GLOBAL_NOfThreadsCreated)); return Yap_unify(ARG1,MkIntTerm(GLOBAL_NOfThreadsCreated));
} }
static Int static Int
p_thread_runtime( USES_REGS1 ) p_thread_runtime( USES_REGS1 )
{ /* '$thread_runtime'(+P) */ { /* '$thread_runtime'(+P) */
return Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ThreadsTotalTime)); return Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ThreadsTotalTime));
} }
static Int static Int
p_thread_self_lock( USES_REGS1 ) p_thread_self_lock( USES_REGS1 )
{ /* '$thread_unlock' */ { /* '$thread_unlock' */
MUTEX_LOCK(&(LOCAL_ThreadHandle.tlock)); MUTEX_LOCK(&(LOCAL_ThreadHandle.tlock));
return Yap_unify(ARG1,MkIntegerTerm(worker_id)); return Yap_unify(ARG1,MkIntegerTerm(worker_id));
} }
static Int static Int
p_thread_unlock( USES_REGS1 ) p_thread_unlock( USES_REGS1 )
{ /* '$thread_unlock' */ { /* '$thread_unlock' */
Int wid = IntegerOfTerm(Deref(ARG1)); Int wid = IntegerOfTerm(Deref(ARG1));
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock)); MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
return TRUE; return TRUE;
} }
intptr_t intptr_t
system_thread_id(PL_thread_info_t *info) system_thread_id(PL_thread_info_t *info)
{ if ( !info ) { if ( !info )
{ CACHE_REGS { CACHE_REGS
if ( LOCAL ) if ( LOCAL )
info = SWI_thread_info(worker_id, NULL); info = SWI_thread_info(worker_id, NULL);
else else
return -1; return -1;
} }
#ifdef __linux__ #ifdef __linux__
return info->pid; return info->pid;
#else #else
#ifdef __WINDOWS__ #ifdef __WINDOWS__
return info->w32id; return info->w32id;
#else #else
return (intptr_t)info->tid; return (intptr_t)info->tid;
#endif #endif
#endif #endif
} }
void void
Yap_InitFirstWorkerThreadHandle(void) Yap_InitFirstWorkerThreadHandle(void)
{ {
CACHE_REGS CACHE_REGS
set_system_thread_id(0, NULL); set_system_thread_id(0, NULL);
LOCAL_ThreadHandle.id = 0; LOCAL_ThreadHandle.id = 0;
@ -1455,12 +1455,12 @@ Yap_InitFirstWorkerThreadHandle(void)
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL); pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse); LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
LOCAL_ThreadHandle.ref_count = 1; LOCAL_ThreadHandle.ref_count = 1;
} }
FILE *debugf; FILE *debugf;
void Yap_InitThreadPreds(void) void Yap_InitThreadPreds(void)
{ {
Yap_InitCPred("$no_threads", 0, p_no_threads, 0); Yap_InitCPred("$no_threads", 0, p_no_threads, 0);
@ -1475,31 +1475,31 @@ void Yap_InitThreadPreds(void)
Yap_InitCPred("$thread_join", 1, p_thread_join, 0); Yap_InitCPred("$thread_join", 1, p_thread_join, 0);
Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, 0); Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, 0);
Yap_InitCPred("thread_yield", 0, p_thread_yield, 0); Yap_InitCPred("thread_yield", 0, p_thread_yield, 0);
/** @pred thread_yield /** @pred thread_yield
Voluntarily relinquish the processor. Voluntarily relinquish the processor.
*/ */
Yap_InitCPred("$detach_thread", 1, p_thread_detach, 0); Yap_InitCPred("$detach_thread", 1, p_thread_detach, 0);
Yap_InitCPred("$thread_detached", 1, p_thread_detached, 0); Yap_InitCPred("$thread_detached", 1, p_thread_detached, 0);
Yap_InitCPred("$thread_detached", 2, p_thread_detached2, 0); Yap_InitCPred("$thread_detached", 2, p_thread_detached2, 0);
Yap_InitCPred("$thread_exit", 0, p_thread_exit, 0); Yap_InitCPred("$thread_exit", 0, p_thread_exit, 0);
Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0); Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0);
/** @pred thread_setconcurrency(+ _Old_, - _New_) /** @pred thread_setconcurrency(+ _Old_, - _New_)
Determine the concurrency of the process, which is defined as the Determine the concurrency of the process, which is defined as the
maximum number of concurrently active threads. `Active` here means maximum number of concurrently active threads. `Active` here means
they are using CPU time. This option is provided if the they are using CPU time. This option is provided if the
thread-implementation provides thread-implementation provides
`pthread_setconcurrency()`. Solaris is a typical example of this `pthread_setconcurrency()`. Solaris is a typical example of this
family. On other systems this predicate unifies _Old_ to 0 (zero) family. On other systems this predicate unifies _Old_ to 0 (zero)
and succeeds silently. and succeeds silently.
*/ */
Yap_InitCPred("$valid_thread", 1, p_valid_thread, 0); Yap_InitCPred("$valid_thread", 1, p_valid_thread, 0);
Yap_InitCPred("$new_mutex", 1, p_new_mutex, SafePredFlag); Yap_InitCPred("$new_mutex", 1, p_new_mutex, SafePredFlag);
Yap_InitCPred("$destroy_mutex", 1, p_destroy_mutex, SafePredFlag); Yap_InitCPred("$destroy_mutex", 1, p_destroy_mutex, SafePredFlag);
@ -1530,78 +1530,156 @@ and succeeds silently.
Yap_InitCPred("$thread_self_lock", 1, p_thread_self_lock, SafePredFlag); 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_run_at_exit", 2, p_thread_atexit, SafePredFlag);
Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag); Yap_InitCPred("$thread_unlock", 1, p_thread_unlock, SafePredFlag);
#if DEBUG_LOCKS||DEBUG_PE_LOCKS #if DEBUG_LOCKS||DEBUG_PE_LOCKS
Yap_InitCPred("debug_locks", 0, p_debug_locks, SafePredFlag); Yap_InitCPred("debug_locks", 0, p_debug_locks, SafePredFlag);
Yap_InitCPred("nodebug_locks", 0, p_nodebug_locks, SafePredFlag); Yap_InitCPred("nodebug_locks", 0, p_nodebug_locks, SafePredFlag);
#endif #endif
} }
#else #else
int int
Yap_NOfThreads(void) { Yap_NOfThreads(void) {
// GLOBAL_ThreadHandlesLock is held // GLOBAL_ThreadHandlesLock is held
#ifdef YAPOR #ifdef YAPOR
return 2; return 2;
#else #else
return 1; return 1;
#endif #endif
} }
static Int static Int
p_no_threads(void) p_no_threads(void)
{ /* '$thread_signal'(+P) */ { /* '$thread_signal'(+P) */
return TRUE; return TRUE;
} }
static Int static Int
p_nof_threads(void) p_nof_threads(void)
{ /* '$nof_threads'(+P) */ { /* '$nof_threads'(+P) */
return Yap_unify(ARG1,MkIntTerm(1)); return Yap_unify(ARG1,MkIntTerm(1));
} }
static Int static Int
p_max_threads(void) p_max_threads(void)
{ /* '$nof_threads'(+P) */ { /* '$nof_threads'(+P) */
return Yap_unify(ARG1,MkIntTerm(1)); return Yap_unify(ARG1,MkIntTerm(1));
} }
static Int static Int
p_nof_threads_created(void) p_nof_threads_created(void)
{ /* '$nof_threads'(+P) */ { /* '$nof_threads'(+P) */
return Yap_unify(ARG1,MkIntTerm(1)); return Yap_unify(ARG1,MkIntTerm(1));
} }
static Int static Int
p_thread_runtime(void) p_thread_runtime(void)
{ /* '$thread_runtime'(+P) */ { /* '$thread_runtime'(+P) */
return Yap_unify(ARG1,MkIntTerm(0)); return Yap_unify(ARG1,MkIntTerm(0));
} }
static Int static Int
p_thread_self(void) p_thread_self(void)
{ /* '$thread_runtime'(+P) */ { /* '$thread_runtime'(+P) */
return Yap_unify(ARG1,MkIntTerm(0)); return Yap_unify(ARG1,MkIntTerm(0));
} }
static Int static Int
p_thread_stacks(void) p_thread_stacks(void)
{ /* '$thread_runtime'(+P) */ { /* '$thread_runtime'(+P) */
return FALSE; return FALSE;
} }
static Int static Int
p_thread_unlock(void) p_thread_unlock(void)
{ /* '$thread_runtime'(+P) */ { /* '$thread_runtime'(+P) */
return TRUE; return TRUE;
}
static Int
p_max_workers(void)
{ /* '$max_workers'(+P) */
return Yap_unify(ARG1,MkIntTerm(1));
}
static Int
p_new_mutex(void)
{ /* '$max_workers'(+P) */
static int mutexes = 1;
return Yap_unify(ARG1, MkIntegerTerm(mutexes++) );
} }
static Int static Int
p_max_workers(void) p_with_mutex( USES_REGS1 )
{ /* '$max_workers'(+P) */ {
return Yap_unify(ARG1,MkIntTerm(1)); Int mut;
} Term t1 = Deref(ARG1), excep;
Int rc = FALSE;
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term tm = CurrentModule;
Term tg = Deref(ARG2);
if (IsVarTerm(t1)) {
p_new_mutex( PASS_REGS1 );
t1 = Deref(ARG1);
mut = IntOfTerm(t1);
}
tg = Yap_StripModule(tg, &tm);
if (IsVarTerm(tg)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "with_mutex/2");
goto end;
} else if (IsApplTerm(tg)) {
register Functor f = FunctorOfTerm(tg);
register CELL *pt;
size_t i, arity;
f = FunctorOfTerm(tg);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
arity = ArityOfFunctor(f);
if (arity > MaxTemps) {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
pe = RepPredProp(PredPropByFunc(f, tm));
pt = RepAppl(tg)+1;
for (i= 0; i < arity; i++ )
XREGS[i+1] = pt[i];
} else if (IsAtomTerm(tg)) {
pe = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
} else if (IsPairTerm(tg)) {
register CELL *pt;
Functor f;
f = FunctorDot;
pe = RepPredProp(PredPropByFunc(f, tm));
pt = RepPair(tg);
XREGS[1] = pt[0];
XREGS[2] = pt[1];
} else {
Yap_Error(TYPE_ERROR_CALLABLE, tg, "with_mutex/2");
goto end;
}
if (
pe->OpcodeOfPred != FAIL_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS) ) {
rc = TRUE;
}
end:
ARG1 = MkIntegerTerm(mut);
excep = Yap_GetException();
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
} else if ( excep != 0) {
return Yap_JumpToEnv(excep);
}
return rc;
}
void void
Yap_InitFirstWorkerThreadHandle(void) Yap_InitFirstWorkerThreadHandle(void)
@ -1610,6 +1688,8 @@ Yap_InitFirstWorkerThreadHandle(void)
void Yap_InitThreadPreds(void) void Yap_InitThreadPreds(void)
{ {
Yap_InitCPred("$with_mutex", 2, p_with_mutex, MetaPredFlag);
Yap_InitCPred("$new_mutex", 1, p_new_mutex, SafePredFlag);
Yap_InitCPred("$max_workers", 1, p_max_workers, 0); Yap_InitCPred("$max_workers", 1, p_max_workers, 0);
Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag); Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag);
Yap_InitCPred("$no_threads", 0, p_no_threads, SafePredFlag); Yap_InitCPred("$no_threads", 0, p_no_threads, SafePredFlag);

5
library/flags.yap
View File

@ -264,9 +264,8 @@ flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, MH
throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) throw(error(permission_error(create, flag, FlagName), message('Re-defining a flag is not allowed.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]), ; \+ memberchk(Access, [read_write, read_only, hidden, hidden_read_only]),
throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)))) throw(error(domain_error(access, Access), message('Wrong access attribute, available are: read_write, read_only, hidden, hidden_read_only.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; \+ callable(Handler) -> ; \+ callable(Handler) -> % the Handler comes from: strip_module(MHandler, Module, Handler)
strip_module(Handler, Mod, G), throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
throw(error(type_error(callable, G), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
; ;
validate(FlagType, Module:Handler, DefaultValue, FlagName), validate(FlagType, Module:Handler, DefaultValue, FlagName),
assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)), assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)),

1
library/tries/base_dbtries.c
View File

@ -237,6 +237,7 @@ YAP_Term trie_depth_breadth(TrEntry trie, TrEntry db_trie, YAP_Int opt_level, YA
core_initialize_depth_breadth_trie(TrEntry_trie(db_trie), &depth_node, &breadth_node); core_initialize_depth_breadth_trie(TrEntry_trie(db_trie), &depth_node, &breadth_node);
set_depth_breadth_reduction_current_data(NULL); set_depth_breadth_reduction_current_data(NULL);
/* We only need to simplify the trie once! */ /* We only need to simplify the trie once! */
/* This can be a 10% overhead for sld cases :-( */
if (TrNode_child(TrEntry_trie(trie))) if (TrNode_child(TrEntry_trie(trie)))
simplification_reduction(trie); simplification_reduction(trie);
while (TrNode_child(TrEntry_trie(trie))) { while (TrNode_child(TrEntry_trie(trie))) {

231
library/tries/core_dbtries.c
View File

@ -212,6 +212,7 @@ YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_lev
YAP_Term get_return_node_term(TrNode node); YAP_Term get_return_node_term(TrNode node);
void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term); void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_Term new_term);
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term); TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term);
void check_attach_childs(TrNode search_child, TrNode existing_child);
TrNode get_simplification_sibling(TrNode node); TrNode get_simplification_sibling(TrNode node);
TrNode check_parent_first(TrNode node); TrNode check_parent_first(TrNode node);
TrNode TrNode_myparent(TrNode node); TrNode TrNode_myparent(TrNode node);
@ -220,8 +221,12 @@ TrNode TrNode_myparent(TrNode node);
/* Debug Procedures */ /* Debug Procedures */
/* -------------------------- */ /* -------------------------- */
inline void displaynode(TrNode node); void displaynode(TrNode node);
inline void displayentry(TrNode node); void displayentry(TrNode node);
void displayterm(YAP_Term term);
void displaytrie(TrNode node);
void display_trie_inner(TrNode node);
void trie_display_node(TrNode node);
/* -------------------------- */ /* -------------------------- */
@ -256,42 +261,6 @@ void core_depth_breadth_trie_replace_nested_trie(TrNode node, YAP_Int nested_tri
traverse_and_replace_nested_trie(node, nested_trie_id, new_term); traverse_and_replace_nested_trie(node, nested_trie_id, new_term);
return; return;
} }
inline
void displaynode(TrNode node) {
if (node != NULL) {
/* printf("hi\n");
if (IS_HASH_NODE(node))
{printf("1\n");} else {printf("2\n");}
printf("bye\n");*/
if (IS_HASH_NODE(node))
printf("HASH n%i, b%i, p%p\n", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag\n");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(" Int_FORMAT ")\n", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}
inline
void displayentry(TrNode node) {
printf("Entry Contains Bottom Up:\n");
while (node) {
displaynode(node);
node = TrNode_parent(node);
}
printf("--- End of Entry ---\n");
}
inline inline
@ -302,6 +271,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term); traverse_and_replace_nested_trie(TrNode_next(node), nested_trie_id, new_term);
return; return;
} else if (IS_HASH_NODE(node)) { } else if (IS_HASH_NODE(node)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort(); abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) node; TrHash hash = (TrHash) node;
@ -322,6 +292,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
if (arity == 1 && strcmp(YAP_AtomName(YAP_NameOfFunctor(f)), NESTED_TRIE_TERM) == 0) { if (arity == 1 && strcmp(YAP_AtomName(YAP_NameOfFunctor(f)), NESTED_TRIE_TERM) == 0) {
child = TrNode_child(node); child = TrNode_child(node);
if (IS_HASH_NODE(child)) { if (IS_HASH_NODE(child)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort(); abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
@ -372,6 +343,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
/* fixmeeee */ /* fixmeeee */
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) { TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
TrNode newnode, temp, newnodef = NULL; TrNode newnode, temp, newnodef = NULL;
YAP_Term term_search = (YAP_Term) NULL;
if (YAP_IsApplTerm(new_term)) { if (YAP_IsApplTerm(new_term)) {
YAP_Term new_term_functor = ApplTag | ((YAP_Term) YAP_FunctorOfTerm(new_term)); YAP_Term new_term_functor = ApplTag | ((YAP_Term) YAP_FunctorOfTerm(new_term));
YAP_Int arity = YAP_ArityOfFunctor(YAP_FunctorOfTerm(new_term)); YAP_Int arity = YAP_ArityOfFunctor(YAP_FunctorOfTerm(new_term));
@ -397,12 +369,38 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
TrNode_previous(TrNode_child(newnodef)) = newnode; TrNode_previous(TrNode_child(newnodef)) = newnode;
TrNode_child(newnodef) = newnode; TrNode_child(newnodef) = newnode;
} else { } else {
// Rewind to first uncle node
temp = TrNode_parent(node);
if (IS_FUNCTOR_NODE(temp))
term_search = TrNode_entry(temp);
while (TrNode_previous(temp))
temp = TrNode_previous(temp);
// Handles cases like not(t(?)) but doesn't handle case like not(not(...)
if (term_search) {
while (temp && TrNode_entry(temp) != term_search)
temp = TrNode_next(temp);
if (temp)
temp = TrNode_child(temp);
}
while (temp && TrNode_entry(temp) != new_term)
temp = TrNode_next(temp);
if (temp) { // Found a node we can reuse
newnode = temp;
// Check if the childs of node/child exist already otherwise attach them
check_attach_childs(TrNode_child(child), TrNode_child(newnode));
//DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(child));
remove_entry(child);
return newnode;
} else { // Make a new node
new_trie_node(newnode, new_term, TrNode_parent(node), TrNode_child(child), TrNode_child(TrNode_parent(node)), NULL); new_trie_node(newnode, new_term, TrNode_parent(node), TrNode_child(child), TrNode_child(TrNode_parent(node)), NULL);
TrNode_previous(TrNode_child(TrNode_parent(node))) = newnode; TrNode_previous(TrNode_child(TrNode_parent(node))) = newnode;
TrNode_child(TrNode_parent(node)) = newnode; TrNode_child(TrNode_parent(node)) = newnode;
} }
}
temp = TrNode_child(child); temp = TrNode_child(child);
if (IS_HASH_NODE(temp)) { if (IS_HASH_NODE(temp)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort(); abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp; TrHash hash = (TrHash) temp;
@ -428,6 +426,23 @@ TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
} }
void check_attach_childs(TrNode search_child, TrNode existing_child) {
// Check if the childs of node/child exist already otherwise attach them
do {
while(existing_child && (TrNode_entry(existing_child) != TrNode_entry(search_child)))
existing_child = TrNode_next(existing_child);
if (existing_child) {
if (TrNode_entry(existing_child) != PairEndTag) {
check_attach_childs(TrNode_child(search_child), TrNode_child(existing_child));
}
} else {
printf("Need to attach child!\n");
abort();
}
search_child = TrNode_next(search_child);
} while(search_child);
}
YAP_Term core_get_trie_db_return_term(void) { YAP_Term core_get_trie_db_return_term(void) {
return TRIE_DEPTH_BREADTH_RETURN_TERM; return TRIE_DEPTH_BREADTH_RETURN_TERM;
@ -557,6 +572,8 @@ TrNode core_depth_reduction(TrEngine engine, TrNode node, TrNode depth_node, YAP
} }
TrNode temp = TrNode_child(TrNode_parent(node)); TrNode temp = TrNode_child(TrNode_parent(node));
if (IS_HASH_NODE(temp)) { if (IS_HASH_NODE(temp)) {
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp; TrHash hash = (TrHash) temp;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -618,7 +635,9 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
child = TrNode_child(node); child = TrNode_child(node);
// printf("Chosen start node: "); displaynode(child); // printf("Chosen start node: "); displaynode(child);
if (IS_HASH_NODE(child)) { if (IS_HASH_NODE(child)) {
printf("warning\n"); printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
/* Comment code for HASH NODES - the commented code 100% has a bug
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -658,7 +677,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} }
//Nested Trie code //Nested Trie code
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) { if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) {
/* nested trie: stop procedure and return nested trie node */ // nested trie: stop procedure and return nested trie node
return child; return child;
} }
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top); PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
@ -676,11 +695,14 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} while (child); } while (child);
} }
} while (bucket != first_bucket); } while (bucket != first_bucket);
*/
} else { } else {
do { do {
if (TrNode_entry(child) == PairEndTag) { if (TrNode_entry(child) == PairEndTag) {
/* do breadth reduction simplification */ /* do breadth reduction simplification */
printf("I should never arrive here, please contact Theo!\n"); printf("SIMPLIFICATION ERROR: I should never arrive here, please contact Theo!\n");
abort();
/*
node = TrNode_parent(child); node = TrNode_parent(child);
DATA_DESTRUCT_FUNCTION = destruct_function; DATA_DESTRUCT_FUNCTION = destruct_function;
remove_child_nodes(TrNode_child(node)); remove_child_nodes(TrNode_child(node));
@ -688,11 +710,13 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
node = trie_node_check_insert(node, PairEndTag); node = trie_node_check_insert(node, PairEndTag);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
return node; return node;
//return core_breadth_reduction(engine, node, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function); */
} }
while (IS_FUNCTOR_NODE(child)) { while (IS_FUNCTOR_NODE(child)) {
child = TrNode_child(child); child = TrNode_child(child);
if (IS_HASH_NODE(child)) { // gets first child in the hash if (IS_HASH_NODE(child)) { // gets first child in the hash
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
abort();
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) child; TrHash hash = (TrHash) child;
first_bucket = TrHash_buckets(hash); first_bucket = TrHash_buckets(hash);
@ -702,35 +726,9 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
} }
if (TrNode_child(child) == NULL) return NULL; if (TrNode_child(child) == NULL) return NULL;
if (TrNode_entry(TrNode_child(child)) != PairEndTag) return NULL; if (TrNode_entry(TrNode_child(child)) != PairEndTag) return NULL;
/* TrNode temp = TrNode_child(child);
if (temp == NULL)
return NULL;
printf("Chosen start node child: "); displaynode(temp);
if (IS_HASH_NODE(temp)) {
TrNode *first_bucket, *bucket;
TrHash hash = (TrHash) temp;
first_bucket = TrHash_buckets(hash);
bucket = first_bucket + TrHash_num_buckets(hash);
do {
if ((temp = *--bucket)) {
while((temp != NULL) && (TrNode_entry(temp) != PairEndTag)) {
temp = TrNode_next(temp);
}
}
} while (bucket != first_bucket && temp == NULL);
} else {
while((temp != NULL) && (TrNode_entry(temp) != PairEndTag))
temp = TrNode_next(temp);
}*/
// printf("while end\n");
//Nested Trie code
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0)) {
/* nested trie: stop procedure and return nested trie node */ /* nested trie: stop procedure and return nested trie node */
if (IS_FUNCTOR_NODE(TrNode_parent(child)) && (strcmp(YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & TrNode_entry(TrNode_parent(child))))), NESTED_TRIE_TERM) == 0))
return child; return child;
}
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top); PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
count++; count++;
@ -816,7 +814,7 @@ int traverse_get_counter(TrNode node) {
YAP_Term generate_label(YAP_Int Index) { YAP_Term generate_label(YAP_Int Index) {
char label[20]; char label[20];
sprintf(label,"L" Int_FORMAT, Index); sprintf(label,"L%ld", Index);
return YAP_MkAtomTerm(YAP_LookupAtom(label)); return YAP_MkAtomTerm(YAP_LookupAtom(label));
} }
@ -968,3 +966,96 @@ YAP_Term update_depth_breadth_trie(TrEngine engine, TrNode root, YAP_Int opt_lev
YAP_Int core_db_trie_get_optimization_level_count(YAP_Int opt_level) { YAP_Int core_db_trie_get_optimization_level_count(YAP_Int opt_level) {
return TRIE_DEPTH_BREADTH_OPT_COUNT[opt_level - 1]; return TRIE_DEPTH_BREADTH_OPT_COUNT[opt_level - 1];
} }
/* -------------------------- */
/* Debug Procedures */
/* -------------------------- */
void displaynode(TrNode node) {
if (node != NULL) {
if (IS_HASH_NODE(node))
printf("HASH n%i, b%i, p%li\n", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), (long) node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag\n");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(%ld)\n", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}
void displayentry(TrNode node) {
printf("Entry Contains Bottom Up:\n");
while (node) {
displaynode(node);
node = TrNode_parent(node);
}
printf("--- End of Entry ---\n");
}
void displayterm(YAP_Term term) {
if (term) {
if (term == PairInitTag)
printf("PairInitTag\n");
else if (term == PairEndTag)
printf("PairEndTag\n");
else if (YAP_IsApplTerm(term))
printf("functor(%s)\n", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & term))));
else if (YAP_IsIntTerm(term))
printf("int(%ld)\n", YAP_IntOfTerm(term));
else if (YAP_IsAtomTerm(term))
printf("atom(%s)\n", YAP_AtomName(YAP_AtomOfTerm(term)));
else
printf("What?\n");
} else
printf("null\n");
return;
}
void displaytrie(TrNode node) {
while(TrNode_entry(node) != PairInitTag){
printf("?: "); displaynode(node);
node = TrNode_parent(node);
}
display_trie_inner(node);
}
void display_trie_inner(TrNode node) {
trie_display_node(node);
if (TrNode_entry(node) != PairEndTag && TrNode_child(node))
display_trie_inner(TrNode_child(node));
if (TrNode_next(node)) {
trie_display_node(TrNode_parent(node)); display_trie_inner(TrNode_next(node));
}
}
void trie_display_node(TrNode node) {
if (node != NULL) {
if (IS_HASH_NODE(node))
printf("HASH(n%i, b%i, p%li), ", TrHash_num_nodes((TrHash) node), TrHash_num_buckets((TrHash) node), (long) node);
else if (TrNode_entry(node) == PairInitTag)
printf("PairInitTag, ");
else if (TrNode_entry(node) == PairEndTag)
printf("PairEndTag\n");
else if (IS_FUNCTOR_NODE(node))
printf("functor(%s), ", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)( ~ApplTag & TrNode_entry(node)))));
else if (YAP_IsIntTerm(TrNode_entry(node)))
printf("int(%ld), ", YAP_IntOfTerm(TrNode_entry(node)));
else if (YAP_IsAtomTerm(TrNode_entry(node)))
printf("atom(%s), ", YAP_AtomName(YAP_AtomOfTerm(TrNode_entry(node))));
else
printf("What?\n");
} else
printf("null\n");
return;
}