Merge branch 'master' of https://www.github.com/vscosta/yap-6.3
This commit is contained in:
Vitor Santos Costa
commit
24920a230f
496
C/threads.c
496
C/threads.c
@ -910,36 +910,36 @@ p_new_mutex( USES_REGS1 )
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_destroy_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_destroy_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_mutex_destroy(&mut->m) < 0)
|
||||
return FALSE;
|
||||
Yap_FreeCodeSpace((void *)mut);
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_lock_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_lock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_LOCK(&mut->m);
|
||||
#else
|
||||
#else
|
||||
if (MUTEX_LOCK(&mut->m) < 0)
|
||||
return FALSE;
|
||||
#endif
|
||||
#endif
|
||||
mut->owners++;
|
||||
mut->tid_own = worker_id;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_trylock_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_trylock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
|
||||
@ -947,26 +947,26 @@ p_trylock_mutex( USES_REGS1 )
|
||||
mut->owners++;
|
||||
mut->tid_own = worker_id;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_unlock_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_unlock_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
#if DEBUG_LOCKS
|
||||
#if DEBUG_LOCKS
|
||||
MUTEX_UNLOCK(&mut->m);
|
||||
#else
|
||||
#else
|
||||
if (MUTEX_UNLOCK(&mut->m) < 0)
|
||||
return FALSE;
|
||||
#endif
|
||||
#endif
|
||||
mut->owners--;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_with_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_with_mutex( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut;
|
||||
Term t1 = Deref(ARG1), excep;
|
||||
Int rc = FALSE;
|
||||
@ -1037,12 +1037,12 @@ p_with_mutex( USES_REGS1 )
|
||||
return Yap_JumpToEnv(excep);
|
||||
}
|
||||
return rc;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_with_with_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_with_with_mutex( USES_REGS1 )
|
||||
{
|
||||
if (GLOBAL_WithMutex == NULL) {
|
||||
p_new_mutex( PASS_REGS1 );
|
||||
GLOBAL_WithMutex = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
@ -1050,30 +1050,30 @@ p_with_with_mutex( USES_REGS1 )
|
||||
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
|
||||
}
|
||||
return p_lock_mutex( PASS_REGS1 );
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_unlock_with_mutex( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_unlock_with_mutex( USES_REGS1 )
|
||||
{
|
||||
ARG1 = MkIntegerTerm((Int)GLOBAL_WithMutex);
|
||||
return p_unlock_mutex( PASS_REGS1 );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
static Int
|
||||
p_mutex_info( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mutex_info( USES_REGS1 )
|
||||
{
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
return Yap_unify(ARG2, MkIntegerTerm(mut->owners)) &&
|
||||
Yap_unify(ARG3, MkIntegerTerm(mut->tid_own));
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_create( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_cond_create( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t* condp;
|
||||
|
||||
condp = (pthread_cond_t *)Yap_AllocCodeSpace(sizeof(pthread_cond_t));
|
||||
@ -1082,16 +1082,16 @@ p_cond_create( USES_REGS1 )
|
||||
}
|
||||
pthread_cond_init(condp, NULL);
|
||||
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
|
||||
}
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
typedef struct {
|
||||
UInt indx;
|
||||
mbox_t mbox;
|
||||
} counted_mbox;
|
||||
} counted_mbox;
|
||||
|
||||
static Int
|
||||
p_mbox_create( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_create( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = GLOBAL_named_mboxes;
|
||||
|
||||
@ -1125,11 +1125,11 @@ p_mbox_create( USES_REGS1 )
|
||||
bool rc = mboxCreate( namet, mboxp PASS_REGS );
|
||||
UNLOCK(GLOBAL_mboxq_lock);
|
||||
return rc;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_mbox_destroy( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_destroy( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = GLOBAL_named_mboxes, *prevp;
|
||||
|
||||
@ -1157,11 +1157,11 @@ p_mbox_destroy( USES_REGS1 )
|
||||
mboxDestroy(mboxp PASS_REGS);
|
||||
Yap_FreeCodeSpace( (char *)mboxp );
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static mbox_t*
|
||||
getMbox(Term t)
|
||||
{
|
||||
static mbox_t*
|
||||
getMbox(Term t)
|
||||
{
|
||||
mbox_t* mboxp;
|
||||
|
||||
if (IsAtomTerm(t=Deref(t))) {
|
||||
@ -1199,98 +1199,98 @@ getMbox(Term t)
|
||||
return NULL;
|
||||
}
|
||||
return mboxp;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_send( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_send( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxSend(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_mbox_size( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_size( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return Yap_unify( ARG2, MkIntTerm(mboxp->nmsgs));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_receive( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_receive( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxReceive(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_mbox_peek( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_mbox_peek( USES_REGS1 )
|
||||
{
|
||||
Term namet = Deref(ARG1);
|
||||
mbox_t* mboxp = getMbox(namet) ;
|
||||
|
||||
if (!mboxp)
|
||||
return FALSE;
|
||||
return mboxPeek(mboxp, Deref(ARG2) PASS_REGS);
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_destroy( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_cond_destroy( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_destroy(condp) < 0)
|
||||
return FALSE;
|
||||
Yap_FreeCodeSpace((void *)condp);
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_signal( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_cond_signal( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_signal(condp) < 0)
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_broadcast( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_cond_broadcast( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
|
||||
if (pthread_cond_broadcast(condp) < 0)
|
||||
return FALSE;
|
||||
return TRUE;
|
||||
}
|
||||
v return TRUE;
|
||||
}
|
||||
|
||||
static Int
|
||||
p_cond_wait( USES_REGS1 )
|
||||
{
|
||||
static Int
|
||||
p_cond_wait( USES_REGS1 )
|
||||
{
|
||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
|
||||
pthread_cond_wait(condp, &mut->m);
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_stacks( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
static Int
|
||||
p_thread_stacks( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
Int tid = IntegerOfTerm(Deref(ARG1));
|
||||
Int status= TRUE;
|
||||
|
||||
@ -1305,11 +1305,11 @@ p_thread_stacks( USES_REGS1 )
|
||||
}
|
||||
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(tid).tlock));
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_atexit( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
static Int
|
||||
p_thread_atexit( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
Term t;
|
||||
|
||||
if (LOCAL_ThreadHandle.texit == NULL ||
|
||||
@ -1338,13 +1338,13 @@ p_thread_atexit( USES_REGS1 )
|
||||
} while (t == 0);
|
||||
LOCAL_ThreadHandle.texit = NULL;
|
||||
return Yap_unify(ARG1, t) && Yap_unify(ARG2, LOCAL_ThreadHandle.texit_mod);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
static Int
|
||||
p_thread_signal( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
static Int
|
||||
p_thread_signal( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
Int wid = IntegerOfTerm(Deref(ARG1));
|
||||
/* make sure the lock is available */
|
||||
MUTEX_LOCK(&(REMOTE_ThreadHandle(wid).tlock));
|
||||
@ -1356,17 +1356,17 @@ p_thread_signal( USES_REGS1 )
|
||||
Yap_external_signal( wid, YAP_ITI_SIGNAL );
|
||||
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_no_threads( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
static Int
|
||||
p_no_threads( USES_REGS1 )
|
||||
{ /* '$thread_signal'(+P) */
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nof_threads( USES_REGS1 )
|
||||
{ /* '$nof_threads'(+P) */
|
||||
static Int
|
||||
p_nof_threads( USES_REGS1 )
|
||||
{ /* '$nof_threads'(+P) */
|
||||
int i = 0, wid;
|
||||
LOCK(GLOBAL_ThreadHandlesLock);
|
||||
for (wid = 0; wid < MAX_THREADS; wid++) {
|
||||
@ -1376,70 +1376,70 @@ p_nof_threads( USES_REGS1 )
|
||||
}
|
||||
UNLOCK(GLOBAL_ThreadHandlesLock);
|
||||
return Yap_unify(ARG1,MkIntegerTerm(i));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_max_workers( USES_REGS1 )
|
||||
{ /* '$max_workers'(+P) */
|
||||
static Int
|
||||
p_max_workers( USES_REGS1 )
|
||||
{ /* '$max_workers'(+P) */
|
||||
return Yap_unify(ARG1,MkIntegerTerm(MAX_WORKERS));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_max_threads( USES_REGS1 )
|
||||
{ /* '$max_threads'(+P) */
|
||||
static Int
|
||||
p_max_threads( USES_REGS1 )
|
||||
{ /* '$max_threads'(+P) */
|
||||
return Yap_unify(ARG1,MkIntegerTerm(MAX_THREADS));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nof_threads_created( USES_REGS1 )
|
||||
{ /* '$nof_threads'(+P) */
|
||||
static Int
|
||||
p_nof_threads_created( USES_REGS1 )
|
||||
{ /* '$nof_threads'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(GLOBAL_NOfThreadsCreated));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_runtime( USES_REGS1 )
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
static Int
|
||||
p_thread_runtime( USES_REGS1 )
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
return Yap_unify(ARG1,MkIntegerTerm(GLOBAL_ThreadsTotalTime));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_self_lock( USES_REGS1 )
|
||||
{ /* '$thread_unlock' */
|
||||
static Int
|
||||
p_thread_self_lock( USES_REGS1 )
|
||||
{ /* '$thread_unlock' */
|
||||
MUTEX_LOCK(&(LOCAL_ThreadHandle.tlock));
|
||||
return Yap_unify(ARG1,MkIntegerTerm(worker_id));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_unlock( USES_REGS1 )
|
||||
{ /* '$thread_unlock' */
|
||||
static Int
|
||||
p_thread_unlock( USES_REGS1 )
|
||||
{ /* '$thread_unlock' */
|
||||
Int wid = IntegerOfTerm(Deref(ARG1));
|
||||
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
intptr_t
|
||||
system_thread_id(PL_thread_info_t *info)
|
||||
{ if ( !info )
|
||||
intptr_t
|
||||
system_thread_id(PL_thread_info_t *info)
|
||||
{ if ( !info )
|
||||
{ CACHE_REGS
|
||||
if ( LOCAL )
|
||||
info = SWI_thread_info(worker_id, NULL);
|
||||
else
|
||||
return -1;
|
||||
}
|
||||
#ifdef __linux__
|
||||
#ifdef __linux__
|
||||
return info->pid;
|
||||
#else
|
||||
#ifdef __WINDOWS__
|
||||
#else
|
||||
#ifdef __WINDOWS__
|
||||
return info->w32id;
|
||||
#else
|
||||
#else
|
||||
return (intptr_t)info->tid;
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitFirstWorkerThreadHandle(void)
|
||||
{
|
||||
void
|
||||
Yap_InitFirstWorkerThreadHandle(void)
|
||||
{
|
||||
CACHE_REGS
|
||||
set_system_thread_id(0, NULL);
|
||||
LOCAL_ThreadHandle.id = 0;
|
||||
@ -1455,12 +1455,12 @@ Yap_InitFirstWorkerThreadHandle(void)
|
||||
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
|
||||
LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
|
||||
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);
|
||||
@ -1475,31 +1475,31 @@ void Yap_InitThreadPreds(void)
|
||||
Yap_InitCPred("$thread_join", 1, p_thread_join, 0);
|
||||
Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, 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("$thread_detached", 1, p_thread_detached, 0);
|
||||
Yap_InitCPred("$thread_detached", 2, p_thread_detached2, 0);
|
||||
Yap_InitCPred("$thread_exit", 0, p_thread_exit, 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
|
||||
maximum number of concurrently active threads. `Active` here means
|
||||
they are using CPU time. This option is provided if the
|
||||
thread-implementation provides
|
||||
`pthread_setconcurrency()`. Solaris is a typical example of this
|
||||
family. On other systems this predicate unifies _Old_ to 0 (zero)
|
||||
and succeeds silently.
|
||||
Determine the concurrency of the process, which is defined as the
|
||||
maximum number of concurrently active threads. `Active` here means
|
||||
they are using CPU time. This option is provided if the
|
||||
thread-implementation provides
|
||||
`pthread_setconcurrency()`. Solaris is a typical example of this
|
||||
family. On other systems this predicate unifies _Old_ to 0 (zero)
|
||||
and succeeds silently.
|
||||
|
||||
|
||||
*/
|
||||
*/
|
||||
Yap_InitCPred("$valid_thread", 1, p_valid_thread, 0);
|
||||
Yap_InitCPred("$new_mutex", 1, p_new_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_run_at_exit", 2, p_thread_atexit, 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("nodebug_locks", 0, p_nodebug_locks, SafePredFlag);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
#else
|
||||
#else
|
||||
|
||||
int
|
||||
Yap_NOfThreads(void) {
|
||||
int
|
||||
Yap_NOfThreads(void) {
|
||||
// GLOBAL_ThreadHandlesLock is held
|
||||
#ifdef YAPOR
|
||||
#ifdef YAPOR
|
||||
return 2;
|
||||
#else
|
||||
#else
|
||||
return 1;
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_no_threads(void)
|
||||
{ /* '$thread_signal'(+P) */
|
||||
static Int
|
||||
p_no_threads(void)
|
||||
{ /* '$thread_signal'(+P) */
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nof_threads(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
static Int
|
||||
p_nof_threads(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(1));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_max_threads(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
static Int
|
||||
p_max_threads(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(1));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_nof_threads_created(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
static Int
|
||||
p_nof_threads_created(void)
|
||||
{ /* '$nof_threads'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(1));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_runtime(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
static Int
|
||||
p_thread_runtime(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(0));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_self(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
static Int
|
||||
p_thread_self(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(0));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_stacks(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
static Int
|
||||
p_thread_stacks(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_unlock(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
static Int
|
||||
p_thread_unlock(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
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
|
||||
p_max_workers(void)
|
||||
{ /* '$max_workers'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(1));
|
||||
}
|
||||
static Int
|
||||
p_with_mutex( USES_REGS1 )
|
||||
{
|
||||
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
|
||||
Yap_InitFirstWorkerThreadHandle(void)
|
||||
@ -1610,6 +1688,8 @@ Yap_InitFirstWorkerThreadHandle(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("$thread_self", 1, p_thread_self, SafePredFlag);
|
||||
Yap_InitCPred("$no_threads", 0, p_no_threads, SafePredFlag);
|
||||
|
||||
@ -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))))
|
||||
; \+ 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))))
|
||||
; \+ callable(Handler) ->
|
||||
strip_module(Handler, Mod, G),
|
||||
throw(error(type_error(callable, G), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
; \+ callable(Handler) -> % the Handler comes from: strip_module(MHandler, Module, Handler)
|
||||
throw(error(type_error(callable, Handler), message('Flag handler needs to be callable.', flag_define(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler))))
|
||||
;
|
||||
validate(FlagType, Module:Handler, DefaultValue, FlagName),
|
||||
assertz('$defined_flag$'(FlagName, FlagGroup, FlagType, DefaultValue, Description, Access, Module:Handler)),
|
||||
|
||||
@ -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);
|
||||
set_depth_breadth_reduction_current_data(NULL);
|
||||
/* We only need to simplify the trie once! */
|
||||
/* This can be a 10% overhead for sld cases :-( */
|
||||
if (TrNode_child(TrEntry_trie(trie)))
|
||||
simplification_reduction(trie);
|
||||
while (TrNode_child(TrEntry_trie(trie))) {
|
||||
|
||||
@ -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);
|
||||
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);
|
||||
void check_attach_childs(TrNode search_child, TrNode existing_child);
|
||||
TrNode get_simplification_sibling(TrNode node);
|
||||
TrNode check_parent_first(TrNode node);
|
||||
TrNode TrNode_myparent(TrNode node);
|
||||
@ -220,8 +221,12 @@ TrNode TrNode_myparent(TrNode node);
|
||||
/* Debug Procedures */
|
||||
/* -------------------------- */
|
||||
|
||||
inline void displaynode(TrNode node);
|
||||
inline void displayentry(TrNode node);
|
||||
void displaynode(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);
|
||||
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
|
||||
@ -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);
|
||||
return;
|
||||
} else if (IS_HASH_NODE(node)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
abort();
|
||||
TrNode *first_bucket, *bucket;
|
||||
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) {
|
||||
child = TrNode_child(node);
|
||||
if (IS_HASH_NODE(child)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
abort();
|
||||
TrNode *first_bucket, *bucket;
|
||||
TrHash hash = (TrHash) child;
|
||||
@ -372,6 +343,7 @@ void traverse_and_replace_nested_trie(TrNode node, YAP_Int nested_trie_id, YAP_T
|
||||
/* fixmeeee */
|
||||
TrNode replace_nested_trie(TrNode node, TrNode child, YAP_Term new_term) {
|
||||
TrNode newnode, temp, newnodef = NULL;
|
||||
YAP_Term term_search = (YAP_Term) NULL;
|
||||
if (YAP_IsApplTerm(new_term)) {
|
||||
YAP_Term new_term_functor = ApplTag | ((YAP_Term) 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_child(newnodef) = newnode;
|
||||
} 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);
|
||||
TrNode_previous(TrNode_child(TrNode_parent(node))) = newnode;
|
||||
TrNode_child(TrNode_parent(node)) = newnode;
|
||||
}
|
||||
}
|
||||
temp = TrNode_child(child);
|
||||
if (IS_HASH_NODE(temp)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
abort();
|
||||
TrNode *first_bucket, *bucket;
|
||||
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) {
|
||||
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));
|
||||
if (IS_HASH_NODE(temp)) {
|
||||
printf("HASH NODE ERROR: db_tries do not support hash nodes.\n");
|
||||
abort();
|
||||
TrNode *first_bucket, *bucket;
|
||||
TrHash hash = (TrHash) temp;
|
||||
first_bucket = TrHash_buckets(hash);
|
||||
@ -618,7 +635,9 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
|
||||
child = TrNode_child(node);
|
||||
// printf("Chosen start node: "); displaynode(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;
|
||||
TrHash hash = (TrHash) child;
|
||||
first_bucket = TrHash_buckets(hash);
|
||||
@ -658,7 +677,7 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node,
|
||||
}
|
||||
//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
|
||||
return child;
|
||||
}
|
||||
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 (bucket != first_bucket);
|
||||
*/
|
||||
} else {
|
||||
do {
|
||||
if (TrNode_entry(child) == PairEndTag) {
|
||||
/* 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);
|
||||
DATA_DESTRUCT_FUNCTION = destruct_function;
|
||||
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);
|
||||
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
|
||||
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)) {
|
||||
child = TrNode_child(child);
|
||||
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;
|
||||
TrHash hash = (TrHash) child;
|
||||
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_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 */
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
PUSH_DOWN(stack_args, TrNode_entry(child), stack_top);
|
||||
count++;
|
||||
@ -816,7 +814,7 @@ int traverse_get_counter(TrNode node) {
|
||||
|
||||
YAP_Term generate_label(YAP_Int Index) {
|
||||
char label[20];
|
||||
sprintf(label,"L" Int_FORMAT, Index);
|
||||
sprintf(label,"L%ld", Index);
|
||||
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) {
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user