debugger fixes

initial support for JPL
bad calls to garbage collector and gc
debugger fixes


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1096 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-07-22 21:32:23 +00:00
parent fec65e106a
commit 21a3377248
24 changed files with 617 additions and 445 deletions

View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-07-03 03:29:24 $,$Author: vsc $ *
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.139 2004/07/03 03:29:24 vsc
* make it compile again on non-linux machines
*
* Revision 1.138 2004/06/29 19:04:40 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
@ -384,10 +387,8 @@ Yap_absmi(int inp)
noheapleft:
saveregs();
if (NOfAtoms > 2*AtomHashTableSize) {
Yap_growatomtable();
} else if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs();
FAIL();
}
@ -11649,8 +11650,9 @@ Yap_absmi(int inp)
/* setup GB */
WRITEBACK_Y_AS_ENV();
YREG[E_CB] = (CELL) B;
if (ActiveSignals)
if (ActiveSignals) {
goto creep_pe;
}
saveregs_and_ycache();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -11920,6 +11922,9 @@ Yap_absmi(int inp)
}
}
if (ActiveSignals) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
goto noheapleft;
}
goto creep;
}
saveregs();

View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.51 2004-06-23 17:24:19 vsc Exp $ *
* version:$Id: alloc.c,v 1.52 2004-07-22 21:32:20 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -881,11 +881,8 @@ ExtendWorkSpace(Int s, int fixed_allocation)
return FALSE;
}
} else if (a < WorkSpaceTop) {
Yap_ErrorMessage = Yap_ErrorSay;
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
"mmap could grew memory at lower addresses than %p, got %p", WorkSpaceTop, a );
Yap_PrologMode = OldPrologMode;
return FALSE;
/* try again */
return ExtendWorkSpace(s, fixed_allocation);
}
WorkSpaceTop = (char *) a + s;
Yap_PrologMode = OldPrologMode;

View File

@ -10,8 +10,15 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.50 2004/06/29 19:04:41 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
* new predicat atomic_concat
* allow multithreaded-debugging
* small fixes
*
* Revision 1.49 2004/06/09 03:32:02 vsc
* fix bugs
*
@ -50,6 +57,7 @@
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#include "threads.h"
#define YAP_BOOT_FROM_PROLOG 0
#define YAP_BOOT_FROM_SAVED_CODE 1
@ -146,6 +154,11 @@ X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int)
X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,Term));
X_API Int STD_PROTO(YAP_CurrentModule,(void));
X_API int STD_PROTO(YAP_ThreadSelf,(void));
X_API int STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *));
X_API int STD_PROTO(YAP_ThreadAttachEngine,(int));
X_API int STD_PROTO(YAP_ThreadDetachEngine,(int));
X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int));
static int (*do_getf)(void);
@ -1240,3 +1253,53 @@ YAP_CurrentModule(void)
return(CurrentModule);
}
X_API int
YAP_ThreadSelf(void)
{
#if USE_THREADS
return Yap_thread_self();
#else
return 0;
#endif
}
X_API int
YAP_ThreadCreateEngine(thread_attr *attr)
{
#if USE_THREADS
return Yap_thread_create_engine(attr);
#else
return FALSE;
#endif
}
X_API int
YAP_ThreadAttachEngine(int wid)
{
#if USE_THREADS
return Yap_thread_attach_engine(wid);
#else
return FALSE;
#endif
}
X_API int
YAP_ThreadDetachEngine(int wid)
{
#if USE_THREADS
return Yap_thread_detach_engine(wid);
#else
return FALSE;
#endif
}
X_API int
YAP_ThreadDestroyEngine(int wid)
{
#if USE_THREADS
return Yap_thread_destroy_engine(wid);
#else
return FALSE;
#endif
}

View File

@ -11,8 +11,15 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.125 2004/06/29 19:04:41 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
* new predicat atomic_concat
* allow multithreaded-debugging
* small fixes
*
* Revision 1.124 2004/06/05 03:36:59 vsc
* coroutining is now a part of attvars.
* some more fixes.
@ -3254,15 +3261,27 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (first_time) {
if (!Yap_gc(4, YENV, P)) {
ARG5 = th;
ARG6 = tb;
ARG7 = tr;
if (!Yap_gc(7, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
th = ARG5;
tb = ARG6;
tr = ARG7;
} else {
if (!Yap_gc(5, ENV, CP)) {
ARG6 = th;
ARG7 = tb;
ARG8 = tr;
if (!Yap_gc(8, ENV, CP)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
th = ARG6;
tb = ARG7;
tr = ARG8;
}
}
return(Yap_unify(th, ArgOfTerm(1,t)) &&

View File

@ -211,7 +211,7 @@ EnterCreepMode(Term t, Term mod) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ARG1 = t;
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at meta-call");
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call");
}
if (!ActiveSignals) {
return do_execute(ARG1, mod);

135
C/grow.c
View File

@ -730,12 +730,87 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
return FALSE;
}
static int
growatomtable(void)
{
AtomHashEntry *ntb;
UInt nsize = 4*AtomHashTableSize-1, i;
UInt start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
LOCK(SignalLock);
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(SignalLock);
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))
return FALSE;
}
atom_table_overflows++;
if (gc_verbose) {
fprintf(Yap_stderr, "%% Atom Table overflow %d\n", atom_table_overflows);
fprintf(Yap_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize));
}
YAPEnterCriticalSection();
for (i = 0; i < nsize; ++i) {
INIT_RWLOCK(ntb[i].AERWLock);
ntb[i].Entry = NIL;
}
for (i = 0; i < AtomHashTableSize; i++) {
Atom catom;
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
while (catom != NIL) {
AtomEntry *ap = RepAtom(catom);
Atom natom;
CELL hash;
hash = HashFunction(ap->StrOfAE) % nsize;
natom = ap->NextOfAE;
ap->NextOfAE = ntb[hash].Entry;
ntb[hash].Entry = catom;
catom = natom;
}
READ_UNLOCK(HashChain[i].AERWLock);
}
Yap_FreeCodeSpace((char *)HashChain);
HashChain = ntb;
AtomHashTableSize = nsize;
YAPLeaveCriticalSection();
growth_time = Yap_cputime()-start_growth_time;
total_atom_table_overflow_time += growth_time;
if (gc_verbose) {
fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000);
fprintf(Yap_stderr, "%% Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000);
}
if (HeapTop + sizeof(YAP_SEG_SIZE) < HeapLim) {
/* make sure there is no heap overflow */
int res;
YAPEnterCriticalSection();
res = do_growheap(FALSE, 0, NULL);
YAPLeaveCriticalSection();
return res;
} else {
return TRUE;
}
}
int
Yap_growheap(int fix_code, UInt in_size, void *cip)
{
int res;
Yap_PrologMode |= GrowHeapMode;
if (NOfAtoms > 2*AtomHashTableSize) {
res = growatomtable();
Yap_PrologMode &= ~GrowHeapMode;
return res;
}
res=do_growheap(fix_code, in_size, (struct intermediates *)cip);
Yap_PrologMode &= ~GrowHeapMode;
return res;
@ -1065,66 +1140,6 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
#endif
}
void
Yap_growatomtable(void)
{
AtomHashEntry *ntb;
UInt nsize = 4*AtomHashTableSize-1, i;
UInt start_growth_time = Yap_cputime(), growth_time;
int gc_verbose = Yap_is_gc_verbose();
LOCK(SignalLock);
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
CreepFlag = CalculateStackGap();
}
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
UNLOCK(SignalLock);
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
/* leave for next time */
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))
return;
}
atom_table_overflows++;
if (gc_verbose) {
fprintf(Yap_stderr, "%% Atom Table overflow %d\n", atom_table_overflows);
fprintf(Yap_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize));
}
YAPEnterCriticalSection();
for (i = 0; i < nsize; ++i) {
INIT_RWLOCK(ntb[i].AERWLock);
ntb[i].Entry = NIL;
}
for (i = 0; i < AtomHashTableSize; i++) {
Atom catom;
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
while (catom != NIL) {
AtomEntry *ap = RepAtom(catom);
Atom natom;
CELL hash;
hash = HashFunction(ap->StrOfAE) % nsize;
natom = ap->NextOfAE;
ap->NextOfAE = ntb[hash].Entry;
ntb[hash].Entry = catom;
catom = natom;
}
READ_UNLOCK(HashChain[i].AERWLock);
}
Yap_FreeCodeSpace((char *)HashChain);
HashChain = ntb;
AtomHashTableSize = nsize;
YAPLeaveCriticalSection();
growth_time = Yap_cputime()-start_growth_time;
total_atom_table_overflow_time += growth_time;
if (gc_verbose) {
fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000);
fprintf(Yap_stderr, "%% Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000);
}
}
static Int
p_inform_trail_overflows(void)
{

View File

@ -3729,7 +3729,10 @@ format_has_tabs(const char *seq)
while ((ch = *seq++)) {
if (ch == '~') {
ch = *seq++;
if (ch == 't') {
if (ch == '*') {
ch = *seq++;
}
if (ch == 't' || ch == '|') {
return TRUE;
}
}
@ -3797,19 +3800,20 @@ format(Term tail, Term args, int sno)
tnum = 0;
targs = mytargs;
}
format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
format_max = format_base+FORMAT_MAX_SIZE;
if (format_ptr == NULL) {
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
return(FALSE);
}
format_buf_size = FORMAT_MAX_SIZE;
format_error = FALSE;
if ((has_tabs = format_has_tabs(fptr))) {
format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
format_max = format_base+FORMAT_MAX_SIZE;
if (format_ptr == NULL) {
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
return(FALSE);
}
format_buf_size = FORMAT_MAX_SIZE;
f_putc = format_putc;
} else {
f_putc = Stream[sno].stream_putc;
format_base = NULL;
}
while ((ch = *fptr++)) {
Term t = TermNil;
@ -4179,7 +4183,7 @@ format(Term tail, Term args, int sno)
static Int
p_format(void)
{ /* '$format'(Control,Args) */
{ /* 'format'(Control,Args) */
Int res;
LOCK(BGL);
res = format(Deref(ARG1),Deref(ARG2), Yap_c_output_stream);
@ -4190,7 +4194,7 @@ p_format(void)
static Int
p_format2(void)
{ /* '$format'(Stream,Control,Args) */
{ /* 'format'(Stream,Control,Args) */
int old_c_stream = Yap_c_output_stream;
Int out;
@ -4789,8 +4793,8 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$write", 2, p_write, SyncPredFlag);
Yap_InitCPred ("$write", 3, p_write2, SyncPredFlag);
Yap_InitCPred ("$format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("$format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$line_position", 2, p_line_position, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$character_count", 2, p_character_count, SafePredFlag|SyncPredFlag);

View File

@ -30,6 +30,8 @@ static char SccsId[] = "%W% %G%";
#if THREADS
#include "threads.h"
/*
* This file includes the definition of threads in Yap. Threads
* are supposed to be compatible with the SWI-Prolog thread package.
@ -70,10 +72,30 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
}
static void
kill_thread_engine (int wid)
{
Prop p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
/* kill all thread local preds */
while(p0) {
PredEntry *ap = RepPredProp(p0);
p0 = ap->NextOfPE;
Yap_Abolish(ap);
Yap_FreeCodeSpace((char *)ap);
}
Yap_KillStacks(wid);
heap_regs->wl[wid].active_signals = 0L;
free(heap_regs->wl[wid].scratchpad.ptr);
free(ThreadHandle[wid].default_yaam_regs);
free(ThreadHandle[wid].start_of_timesp);
free(ThreadHandle[wid].last_timep);
ThreadHandle[wid].in_use = FALSE;
pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
}
static void
thread_die(int wid, int always_die)
{
Prop p0;
LOCK(ThreadHandlesLock);
if (!always_die) {
@ -81,50 +103,49 @@ thread_die(int wid, int always_die)
ThreadsTotalTime += Yap_cputime();
}
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
always_die) {
p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
/* kill all thread local preds */
while(p0) {
PredEntry *ap = RepPredProp(p0);
p0 = ap->NextOfPE;
Yap_Abolish(ap);
Yap_FreeCodeSpace((char *)ap);
}
Yap_KillStacks(wid);
heap_regs->wl[wid].active_signals = 0L;
heap_regs->wl[wid].active_signals = 0L;
free(heap_regs->wl[wid].scratchpad.ptr);
free(ThreadHandle[wid].default_yaam_regs);
free(ThreadHandle[wid].start_of_timesp);
free(ThreadHandle[wid].last_timep);
ThreadHandle[wid].in_use = FALSE;
pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
}
always_die)
kill_thread_engine(wid);
UNLOCK(ThreadHandlesLock);
}
static void
setup_engine(int myworker_id)
{
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
int oldworker_id = worker_id;
/* create the YAAM descriptor */
ThreadHandle[myworker_id].default_yaam_regs = standard_regs;
pthread_setspecific(Yap_yaamregs_key, (void *)standard_regs);
Yap_InitExStacks(ThreadHandle[myworker_id].ssize, ThreadHandle[myworker_id].tsize);
CurrentModule = ThreadHandle[myworker_id].cmod;
worker_id = myworker_id;
Yap_InitTime();
Yap_InitYaamRegs();
worker_id = oldworker_id;
{
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
}
/* I exist */
NOfThreadsCreated++;
}
static void
start_thread(int myworker_id)
{
setup_engine(myworker_id);
worker_id = myworker_id;
}
static void *
thread_run(void *widp)
{
Term tgoal;
Term tgs[2];
int out;
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
int myworker_id = *((int *)widp);
/* create the YAAM descriptor */
ThreadHandle[myworker_id].default_yaam_regs = standard_regs;
pthread_setspecific(Yap_yaamregs_key, (void *)standard_regs);
worker_id = myworker_id;
/* I exist */
NOfThreadsCreated++;
Yap_InitExStacks(ThreadHandle[myworker_id].ssize, ThreadHandle[myworker_id].tsize);
CurrentModule = ThreadHandle[myworker_id].cmod;
Yap_InitTime();
Yap_InitYaamRegs();
{
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
}
start_thread(myworker_id);
tgs[0] = Yap_FetchTermFromDB(ThreadHandle[worker_id].tgoal);
tgs[1] = ThreadHandle[worker_id].tdetach;
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
@ -139,6 +160,13 @@ p_thread_new_tid(void)
return Yap_unify(MkIntegerTerm(allocate_new_tid()), ARG1);
}
static void
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
{
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
}
static Int
p_create_thread(void)
{
@ -153,33 +181,9 @@ p_create_thread(void)
/* YAP ERROR */
return FALSE;
}
init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach);
ThreadHandle[new_worker_id].id = new_worker_id;
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
return TRUE;
}
/* YAP ERROR */
return FALSE;
}
static Int
Yap_new_thread(void)
{
UInt ssize = IntegerOfTerm(Deref(ARG2));
UInt tsize = IntegerOfTerm(Deref(ARG3));
/* UInt systemsize = IntegerOfTerm(Deref(ARG4)); */
Term tgoal = Deref(ARG1);
Term tdetach = Deref(ARG5);
int new_worker_id = IntegerOfTerm(Deref(ARG6));
if (new_worker_id == -1) {
/* YAP ERROR */
return FALSE;
}
ThreadHandle[new_worker_id].id = new_worker_id;
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
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) {
return TRUE;
}
@ -194,11 +198,62 @@ p_thread_self(void)
}
int
Yap_self(void)
Yap_thread_self(void)
{
return worker_id;
}
int
Yap_thread_create_engine(thread_attr *ops)
{
int new_id = allocate_new_tid();
if (new_id == -1) {
/* YAP ERROR */
return FALSE;
}
init_thread_engine(new_id, ops->ssize, ops->tsize, TermNil, TermNil);
ThreadHandle[new_id].id = new_id;
ThreadHandle[new_id].handle = pthread_self();
ThreadHandle[new_id].ref_count = 0;
setup_engine(new_id);
return TRUE;
}
int
Yap_thread_attach_engine(int wid)
{
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
ThreadHandle[wid].handle = pthread_self();
ThreadHandle[wid].ref_count++;
worker_id = wid;
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
return TRUE;
}
int
Yap_thread_detach_engine(int wid)
{
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
ThreadHandle[wid].handle = 0;
ThreadHandle[wid].ref_count--;
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
return TRUE;
}
int
Yap_thread_destroy_engine(int wid)
{
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
if (ThreadHandle[wid].ref_count == 0) {
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
kill_thread_engine(wid);
return TRUE;
} else {
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
return FALSE;
}
}
static Int
p_thread_join(void)
{

View File

@ -1,16 +1,11 @@
:- module(clpbn, [{}/1,
clpbn_findall/3,
clpbn_setof/3]).
:- module(clpbn, [{}/1).
:- use_module(library(atts)).
:- use_module(library(lists)).
:- use_module(library(terms)).
:- op(1200, xfx, '<--').
:- op(1200, fx, '<--').
:- op( 500, xfx, '=>').
:- op( 500, xfy, with).
%
@ -40,15 +35,13 @@
execute_pre_evidence/0
]).
:- include('clpbn/aggs').
use(vel).
{Var = Key with Dist} :-
% key_entry(Key,Indx),
% array_element(clpbn,Indx,El),
% attributes:put_att(El,3,indx(Indx)),
clpbn:put_atts(El,[key(Key),dist(E=>Domain)]),
put_atts(El,[key(Key),dist(E=>Domain)]),
extract_dist(Dist, E, Domain),
add_evidence(Var,El).
@ -257,25 +250,6 @@ starter_vars([Var|Vs]) :-
starter_vars(Vs).
/* attribute_goal(Var, Goal) :-
get_atts(Var, [key(_)]),
get_bnode(Var, Goal).
get_value(clpbn_key, Max),
Max1 is Max-1,
run_through_array(0, Max1, Goal).
run_through_array(Max,Max,Goal) :- !,
array_element(clpbn, Max, V),
get_bnode(V, Goal).
run_through_array(I,Max,(G,Goal)) :- !,
array_element(clpbn, I, V),
get_bnode(V, G),
I1 is I+1,
run_through_array(I1,Max,Goal).
*/
get_bnode(Var, Goal) :-
get_atts(Var, [key(Key),dist(X)]),
dist_goal(X, Key, Goal0),

View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.63 2004-07-15 15:47:08 vsc Exp $ *
* version: $Id: Heap.h,v 1.64 2004-07-22 21:32:21 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -76,6 +76,7 @@ typedef struct thandle {
REGSTORE *current_yaam_regs;
struct pred_entry *local_preds;
pthread_t handle;
int ref_count;
pthread_mutex_t tlock;
#if HAVE_GETRUSAGE
struct timeval *start_of_timesp;

View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.52 2004-06-05 03:37:00 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.53 2004-07-22 21:32:21 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -162,7 +162,6 @@ int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **));
void STD_PROTO(Yap_growatomtable, (void));
CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***));
/* heapgc.c */

View File

@ -695,7 +695,7 @@ Macros to check the limits of stacks
(GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label
#else
#define check_stack(Label, GLOB) \
if ( (Int)(Unsigned(E_YREG) - CFREG) < (Int)(GLOB) ) goto Label
if ( (Int)(Unsigned(E_YREG) - Unsigned(GLOB)) < CFREG ) goto Label
#endif /* SBA && YAPOR */
/***************************************************************

View File

@ -339,9 +339,15 @@ extern X_API void *PROTO(YAP_Predicate,(YAP_Atom,unsigned long int,int));
/* int YAP_Predicate() */
extern X_API void PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,int*));
/* int YAP_Predicate() */
/* int YAP_CurrentModule() */
extern X_API int PROTO(YAP_CurrentModule,(void));
extern X_API int PROTO(YAP_ThreadSelf,(void));
extern X_API int PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
__END_DECLS

View File

@ -96,3 +96,11 @@ typedef struct {
char **Argv;
} YAP_init_args;
/* from thread.h */
typedef struct {
unsigned long int ssize;
unsigned long int tsize;
int (*cancel)(int);
} YAP_thread_attr;

View File

@ -1083,6 +1083,17 @@ X_API void PL_register_extensions(PL_extension *ptr)
}
}
X_API int PL_thread_self(void)
{
return YAP_ThreadSelf();
}
X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
{
/* YAP_thread_attr yap; */
return YAP_ThreadSelf();
}
/* note: fprintf may be called from anywhere, so please don't try
to be smart and allocate stack from somewhere else */
X_API int Sprintf(char *format,...)

View File

@ -39,6 +39,17 @@ typedef struct _PL_extension
short flags; /* Or of PL_FA_... */
} PL_extension;
typedef struct
{ unsigned long local_size; /* Stack sizes */
unsigned long global_size;
unsigned long trail_size;
unsigned long argument_size;
char * alias; /* alias name */
int (*cancel)(int id); /* cancel function */
void * reserved[5]; /* reserved for extensions */
} PL_thread_attr_t;
#define PL_FA_NOTRACE (0x01) /* foreign cannot be traced */
#define PL_FA_TRANSPARENT (0x02) /* foreign is module transparent */
#define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */
@ -181,6 +192,8 @@ extern X_API term_t PL_exception(qid_t);
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_extensions(PL_extension *);
extern X_API int PL_thread_self(void);
extern X_API int PL_thread_attach_engine(const PL_thread_attr_t *);
extern X_API int Sprintf(char *,...);

View File

@ -84,3 +84,8 @@ YAP_UserCPredicate
YAP_UserBackCPredicate
YAP_UserCPredicateWithArgs
YAP_CurrentModule
YAP_ThreadSelf
YAP_ThreadCreateEngine
YAP_ThreadAttachEngine
YAP_ThreadDetachEngine
YAP_ThreadDestroyEngine

View File

@ -34,7 +34,7 @@ true :- true.
( Module=user ->
'$compile_mode'(_,0)
;
'$format'(user_error,'[~w]~n', [Module])
format(user_error,'[~w]~n', [Module])
),
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
@ -125,10 +125,10 @@ read_sig.
fail.
'$enter_top_level' :-
( recorded('$trace',on,_) ->
'$format'(user_error, '% trace~n', [])
format(user_error, '% trace~n', [])
;
recorded('$debug', on, _) ->
'$format'(user_error, '% debug~n', [])
format(user_error, '% debug~n', [])
),
fail.
'$enter_top_level' :-
@ -292,7 +292,7 @@ repeat :- '$repeat'.
% but YAP and SICStus does.
%
'$process_directive'(G, _, M) :-
( '$do_yes_no'(G,M) -> true ; '$format'(user_error,':- ~w:~w failed.~n',[M,G]) ).
( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$all_directives'(_:G1) :- !,
'$all_directives'(G1).
@ -440,7 +440,7 @@ repeat :- '$repeat'.
'$extract_goal_vars_for_dump'(VL,LIV).
'$write_query_answer_true'([]) :- !,
'$format'(user_error,'~ntrue',[]).
format(user_error,'~ntrue',[]).
'$write_query_answer_true'(_).
'$show_frozen'(_,_,[]) :-
@ -461,16 +461,16 @@ repeat :- '$repeat'.
fail.
'$present_answer'((?-), Answ) :-
get_value('$break',BL),
( BL \= 0 -> '$format'(user_error, '[~p] ',[BL]) ;
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ),
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,Answ,Opts) ;
'$format'(user_error,'~w',[Answ])
format(user_error,'~w',[Answ])
),
'$format'(user_error,'~n', []).
format(user_error,'~n', []).
'$another' :-
'$format'(user_error,' ? ',[]),
format(user_error,' ? ',[]),
'$get0'(user_input,C),
( C== 0'; -> '$skip'(user_input,10),
'$add_nl_outside_console',
@ -478,7 +478,7 @@ repeat :- '$repeat'.
;
C== 10 -> '$add_nl_outside_console',
( '$undefined'('$print_message'(_,_),prolog) ->
'$format'(user_error,'yes~n', [])
format(user_error,'yes~n', [])
;
print_message(help,yes)
)
@ -491,10 +491,10 @@ repeat :- '$repeat'.
'$add_nl_outside_console' :-
'$is_same_tty'(user_input, user_error), !.
'$add_nl_outside_console' :-
'$format'(user_error,'~n',[]).
format(user_error,'~n',[]).
'$ask_again_for_another' :-
'$format'(user_error,'Action (\";\" for more choices, <return> for exit)', []),
format(user_error,'Action (\";\" for more choices, <return> for exit)', []),
'$another'.
'$write_answer'(_,_,_) :-
@ -551,25 +551,25 @@ repeat :- '$repeat'.
'$write_remaining_vars_and_goals'([]).
'$write_remaining_vars_and_goals'([G1|LG]) :-
'$format'(user_error,',~n',[]),
format(user_error,',~n',[]),
'$write_goal_output'(G1),
'$write_remaining_vars_and_goals'(LG).
'$write_goal_output'(var([V|VL])) :-
'$format'(user_error,'~s',[V]),
format(user_error,'~s',[V]),
'$write_output_vars'(VL).
'$write_goal_output'(nonvar([V|VL],B)) :-
'$format'(user_error,'~s',[V]),
format(user_error,'~s',[V]),
'$write_output_vars'(VL),
'$format'(user_error,' = ', []),
format(user_error,' = ', []),
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,B,Opts) ;
'$format'(user_error,'~w',[B])
format(user_error,'~w',[B])
).
'$write_goal_output'(_-G) :-
( recorded('$print_options','$toplevel'(Opts),_) ->
write_term(user_error,G,Opts) ;
'$format'(user_error,'~w',[G])
format(user_error,'~w',[G])
).
'$name_vars_in_goals'(G, VL0, NG) :-
@ -597,7 +597,7 @@ repeat :- '$repeat'.
'$write_output_vars'([]).
'$write_output_vars'([V|VL]) :-
'$format'(user_error,' = ~s',[V]),
format(user_error,' = ~s',[V]),
'$write_output_vars'(VL).
call(G) :- '$execute'(G).
@ -806,7 +806,7 @@ break :- get_value('$break',BL), NBL is BL+1,
get_value(spy_leap,_Leap),
set_value('$break',NBL),
current_output(OutStream), current_input(InpStream),
'$format'(user_error, '% Break (level ~w)~n', [NBL]),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!,
set_value('$live','$true'),
@ -865,7 +865,7 @@ break :- get_value('$break',BL), NBL is BL+1,
recorda('$initialisation','$',_),
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
'$format'(user_error, '~*|% consulting ~w...~n', [LC,F])
format(user_error, '~*|% consulting ~w...~n', [LC,F])
; true )
;
'$print_message'(informational, loading(consulting, File))
@ -881,7 +881,7 @@ break :- get_value('$break',BL), NBL is BL+1,
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
'$format'(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
;
true
)

View File

@ -417,9 +417,9 @@ debugging :-
( recorded('$debug',on, R), erase(R), fail ; true),
( Module\=prolog,
Module\=user ->
'$format'(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
format(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
;
'$format'(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
format(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
),
'$debugger_write'(user_error,G),
( nonvar(R0), recordaifnot('$debug',on,_), fail ; true),
@ -558,32 +558,28 @@ debugging :-
fail.
% if we are in the interpreter, don't need to care about forcing a trace, do we?
'$continue_debugging'(_) :-
recorded('$trace',on, _),
fail.
'$continue_debugging'(no) :- !.
'$continue_debugging'(_) :-
'$access_yap_flags'(10,1), !,
'$creep'.
'$continue_debugging'(_) :-
recorded('$spy_stop', _, _).
'$continue_debugging'(_).
'$stop_debugging' :-
'$stop_creep'.
'$action_help' :-
'$format'(user_error,"newline creep a abort~n", []),
'$format'(user_error,"c creep e exit~n", []),
'$format'(user_error,"f Goal fail h help~n", []),
'$format'(user_error,"l leap r Goal retry~n", []),
'$format'(user_error,"s skip t fastskip~n", []),
'$format'(user_error,"q quasiskip k quasileap~n", []),
'$format'(user_error,"b break n no debug~n", []),
'$format'(user_error,"p print d display~n", []),
'$format'(user_error,"<D depth D < full term~n", []),
'$format'(user_error,"+ spy this - nospy this~n", []),
'$format'(user_error,"^ view subg ^^ view using~n", []),
'$format'(user_error,"! g execute goal~n", []).
format(user_error,"newline creep a abort~n", []),
format(user_error,"c creep e exit~n", []),
format(user_error,"f Goal fail h help~n", []),
format(user_error,"l leap r Goal retry~n", []),
format(user_error,"s skip t fastskip~n", []),
format(user_error,"q quasiskip k quasileap~n", []),
format(user_error,"b break n no debug~n", []),
format(user_error,"p print d display~n", []),
format(user_error,"<D depth D < full term~n", []),
format(user_error,"+ spy this - nospy this~n", []),
format(user_error,"^ view subg ^^ view using~n", []),
format(user_error,"! g execute goal~n", []).
'$ilgl'(C) :-
'$print_message'(warning, trace_command(C)),
@ -619,7 +615,7 @@ debugging :-
'$get_sterm_list'(L), !,
'$deb_get_sterm_in_g'(L,G,A),
recorda('$debug_sub_skel',L,_),
'$format'(user_error,"~n~w~n~n",[A]).
format(user_error,"~n~w~n~n",[A]).
'$print_deb_sterm'(_) :- '$skipeol'(94).
'$get_sterm_list'(L) :-

View File

@ -11,8 +11,15 @@
* File: errors.yap *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2004-06-23 17:24:20 $,$Author: vsc $ *
* Last rev: $Date: 2004-07-22 21:32:22 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.53 2004/06/23 17:24:20 vsc
* New comment-based message style
* Fix thread support (at least don't deadlock with oneself)
* small fixes for coroutining predicates
* force Yap to recover space in arrays of dbrefs
* use private predicates in debugger.
*
* Revision 1.52 2004/06/18 15:41:19 vsc
* fix extraneous line in yes/no messages
*
@ -65,7 +72,7 @@ print_message(Level, Mss) :-
user:portray_message(Severity, Msg), !.
'$print_message'(error,error(Msg,Info)) :-
( var(Msg) ; var(Info) ), !,
'$format'(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
format(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
@ -76,94 +83,94 @@ print_message(Level, Mss) :-
'$print_message'(error,error(Type,Where)) :-
'$output_error_message'(Type, Where), !.
'$print_message'(error,Throw) :-
'$format'(user_error,'% YAP: no handler for error ~w~n', [Throw]).
format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
'$print_message'(informational,M) :-
( get_value('$verbose',on) ->
'$do_informational_message'(M) ;
true
).
'$print_message'(warning,M) :-
'$format'(user_error, '% ', []),
format(user_error, '% ', []),
'$do_print_message'(M),
'$format'(user_error, '~n', []).
format(user_error, '~n', []).
'$print_message'(help,M) :-
'$do_print_message'(M),
'$format'(user_error, '~n', []).
format(user_error, '~n', []).
'$do_informational_message'(halt) :- !,
'$format'(user_error, '% YAP execution halted~n', []).
format(user_error, '% YAP execution halted~n', []).
'$do_informational_message'(abort(_)) :- !,
'$format'(user_error, '% YAP execution aborted~n', []).
format(user_error, '% YAP execution aborted~n', []).
'$do_informational_message'(loading(_,user)) :- !.
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC),
'$format'(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
format(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
'$show_consult_level'(LC0),
LC is LC0+1,
'$format'(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
format(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
'$do_informational_message'(M) :-
'$format'(user_error,'% ', []),
format(user_error,'% ', []),
'$do_print_message'(M),
'$format'(user_error,'~n', []).
format(user_error,'~n', []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'('$format'(Msg, Args)) :- !,
'$format'(user_error,Msg,Args).
'$do_print_message'(format(Msg, Args)) :- !,
format(user_error,Msg,Args).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
'$format'(user_error,'There is already a spy point on ~w:~w/~w.',
format(user_error,'There is already a spy point on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !,
'$format'(user_error,'Spy point set on ~w:~w/~w.',
format(user_error,'Spy point set on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !,
'$format'(user_error,'Spy point on ~w:~w/~w removed.',
format(user_error,'Spy point on ~w:~w/~w removed.',
[M,F,N]).
'$do_print_message'(breakp(no,breakpoint_for,M:F/N)) :- !,
'$format'(user_error,'There is no spy point on ~w:~w/~w.',
format(user_error,'There is no spy point on ~w:~w/~w.',
[M,F,N]).
'$do_print_message'(breakpoints([])) :- !,
'$format'(user_error,'There are no spy-points set.',
format(user_error,'There are no spy-points set.',
[M,F,N]).
'$do_print_message'(breakpoints(L)) :- !,
'$format'(user_error,'Spy-points set on:', []),
format(user_error,'Spy-points set on:', []),
'$print_list_of_preds'(L).
'$do_print_message'(debug(debug)) :- !,
'$format'(user_error,'Debug mode on.',[]).
format(user_error,'Debug mode on.',[]).
'$do_print_message'(debug(off)) :- !,
'$format'(user_error,'Debug mode off.',[]).
format(user_error,'Debug mode off.',[]).
'$do_print_message'(debug(trace)) :- !,
'$format'(user_error,'Trace mode on.',[]).
format(user_error,'Trace mode on.',[]).
'$do_print_message'(import(Pred,To,From,private)) :- !,
'$format'(user_error,'Importing private predicate ~w:~w to ~w.',
format(user_error,'Importing private predicate ~w:~w to ~w.',
[From,Pred,To]).
'$do_print_message'(leash([])) :- !,
'$format'(user_error,'No leashing.',
format(user_error,'No leashing.',
[M,F,N]).
'$do_print_message'(leash([A|B])) :- !,
'$format'(user_error,'Leashing set to ~w.',
format(user_error,'Leashing set to ~w.',
[[A|B]]).
'$do_print_message'(no) :- !,
'$format'(user_error, 'no', []).
format(user_error, 'no', []).
'$do_print_message'(no_match(P)) :- !,
'$format'(user_error,'No matching predicate for ~w.',
format(user_error,'No matching predicate for ~w.',
[P]).
'$do_print_message'(trace_command(C)) :- !,
'$format'(user_error,'Invalid trace command: ~c', [C]).
format(user_error,'Invalid trace command: ~c', [C]).
'$do_print_message'(trace_help) :- !,
'$format'(user_error,' Please enter a valid debugger command (h for help).', []).
format(user_error,' Please enter a valid debugger command (h for help).', []).
'$do_print_message'(version(Version)) :- !,
'$format'(user_error,'YAP version ~a', [Version]).
format(user_error,'YAP version ~a', [Version]).
'$do_print_message'(yes) :- !,
'$format'(user_error, 'yes', []).
format(user_error, 'yes', []).
'$do_print_message'(Messg) :-
'$format'(user_error,'~q',Messg).
format(user_error,'~q',Messg).
'$print_list_of_preds'([]).
'$print_list_of_preds'([P|L]) :-
'$format'(user_error,'~n ~w',[P]),
format(user_error,'~n ~w',[P]),
'$print_list_of_preds'(L).
'$do_stack_dump'(Envs, CPs) :-
@ -266,20 +273,20 @@ print_message(Level, Mss) :-
'$say_stack_dump'([], []) :- !.
'$say_stack_dump'(_, _) :-
'$format'(user_error,'% Stack dump for error:', []).
format(user_error,'% Stack dump for error:', []).
'$close_stack_dump'([], []) :- !.
'$close_stack_dump'(_, _) :-
'$format'(user_error,'~n', []).
format(user_error,'~n', []).
'$show_cps'([]) :- !.
'$show_cps'(List) :-
'$format'(user_error,'% ~n choice-points (goals with alternatives left):',[]),
format(user_error,'% ~n choice-points (goals with alternatives left):',[]),
'$print_stack'(List).
'$show_envs'([]) :- !.
'$show_envs'(List) :-
'$format'(user_error,'% ~n environments (partially executed clauses):',[]),
format(user_error,'% ~n environments (partially executed clauses):',[]),
'$print_stack'(List).
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
@ -289,16 +296,16 @@ print_message(Level, Mss) :-
'$print_stack'([]).
'$print_stack'([overflow]) :- !,
'$format'(user_error,'~n% ...',[]).
format(user_error,'~n% ...',[]).
'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
'$show_goal'(Clause,Name,Arity,Mod),
'$print_stack'(List).
'$show_goal'(-1,Name,Arity,Mod) :- !,
'$format'('~n% ~a:~a/~d at indexing code',[Mod,Name,Arity]).
format('~n% ~a:~a/~d at indexing code',[Mod,Name,Arity]).
'$show_goal'(0,Name,Arity,Mod) :- !.
'$show_goal'(I,Name,Arity,Mod) :-
'$format'(user_error,'~n% ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
format(user_error,'~n% ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode),
@ -313,350 +320,350 @@ print_message(Level, Mss) :-
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
'$output_error_message'(consistency_error(Who),Where) :-
'$format'(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
format(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
[Who,Where]).
'$output_error_message'(context_error(Goal,Who),Where) :-
'$format'(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
format(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
[Goal,Who,Where]).
'$output_error_message'(domain_error(array_overflow,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
[Where,Opt]).
'$output_error_message'(domain_error(array_type,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(builtin_procedure,P), P) :-
'$format'(user_error,'% DOMAIN ERROR- non-iso built-in procedure ~w~n',
format(user_error,'% DOMAIN ERROR- non-iso built-in procedure ~w~n',
[P]).
'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
[Where,Op]).
'$output_error_message'(domain_error(out_of_range,Value), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
format(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
[Where,Value]).
'$output_error_message'(domain_error(close_option,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(radix,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
[Where,Opt]).
'$output_error_message'(domain_error(flag_value,F+V), W) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
[W,V,F]).
'$output_error_message'(domain_error(io_mode,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
[Where,N]).
'$output_error_message'(domain_error(mutable,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
[Where,N]).
'$output_error_message'(domain_error(module_decl_options,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
[Where,N]).
'$output_error_message'(domain_error(not_empty_list,_), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
format(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
[Where]).
'$output_error_message'(domain_error(not_less_than_zero,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
format(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
[Where,N]).
'$output_error_message'(domain_error(not_newline,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
format(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
[Where,N]).
'$output_error_message'(domain_error(not_zero,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
[Where,N]).
'$output_error_message'(domain_error(operator_priority,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
[Where,N]).
'$output_error_message'(domain_error(operator_specifier,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~n',
[Where,N]).
'$output_error_message'(domain_error(predicate_spec,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid predicate specifier~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid predicate specifier~n',
[Where,N]).
'$output_error_message'(domain_error(read_option,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
[Where,N]).
'$output_error_message'(domain_error(semantics_indicator,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
[Where,W]).
'$output_error_message'(domain_error(source_sink,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
[Where,N]).
'$output_error_message'(domain_error(stream,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
[Where,What]).
'$output_error_message'(domain_error(stream_or_alias,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
[Where,What]).
'$output_error_message'(domain_error(stream_option,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
[Where,What]).
'$output_error_message'(domain_error(stream_position,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
[Where,What]).
'$output_error_message'(domain_error(stream_property,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
[Where,What]).
'$output_error_message'(domain_error(syntax_error_handler,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
[Where,What]).
'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
[Where,Option, Opts]).
'$output_error_message'(domain_error(time_out_spec,What), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
[Where,What]).
'$output_error_message'(domain_error(write_option,N), Where) :-
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
[Where,N]).
'$output_error_message'(existence_error(array,F), W) :-
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
format(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
[W,F]).
'$output_error_message'(existence_error(mutex,F), W) :-
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
format(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
[W,F]).
'$output_error_message'(existence_error(queue,F), W) :-
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
format(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
[W,F]).
'$output_error_message'(existence_error(procedure,P), _) :-
'$format'(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
[P]).
'$output_error_message'(existence_error(source_sink,F), W) :-
'$format'(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
format(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
[W,F]).
'$output_error_message'(existence_error(stream,Stream), Where) :-
'$format'(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
format(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
[Where,Stream]).
'$output_error_message'(evaluation_error(int_overflow), Where) :-
'$format'(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
format(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
[Where]).
'$output_error_message'(evaluation_error(float_overflow), Where) :-
'$format'(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
format(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
[Where]).
'$output_error_message'(evaluation_error(undefined), Where) :-
'$format'(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
format(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
[Where]).
'$output_error_message'(evaluation_error(underflow), Where) :-
'$format'(user_error,'% UNDERFLOW ERROR- ~w~n',
format(user_error,'% UNDERFLOW ERROR- ~w~n',
[Where]).
'$output_error_message'(evaluation_error(float_underflow), Where) :-
'$format'(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
format(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
[Where]).
'$output_error_message'(evaluation_error(zero_divisor), Where) :-
'$format'(user_error,'% ZERO DIVISOR ERROR- ~w~n',
format(user_error,'% ZERO DIVISOR ERROR- ~w~n',
[Where]).
'$output_error_message'(instantiation_error, Where) :-
'$format'(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
[Where]).
'$output_error_message'(out_of_heap_error, Where) :-
'$format'(user_error,'% OUT OF HEAP SPACE ERROR- ~w~n',
format(user_error,'% OUT OF HEAP SPACE ERROR- ~w~n',
[Where]).
'$output_error_message'(out_of_stack_error, Where) :-
'$format'(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
[Where]).
'$output_error_message'(out_of_trail_error, Where) :-
'$format'(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
format(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
[Where]).
'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
[Where,P]).
'$output_error_message'(permission_error(access,static_procedure,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
[Where,P]).
'$output_error_message'(permission_error(alias,new,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
[Where,P]).
'$output_error_message'(permission_error(create,array,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
[Where,P]).
'$output_error_message'(permission_error(create,mutex,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
[Where,P]).
'$output_error_message'(permission_error(create,queue,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create queue ~a~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot create queue ~a~n',
[Where,P]).
'$output_error_message'(permission_error(create,operator,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
[Where,P]).
'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(input,text_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
[Where]).
'$output_error_message'(permission_error(modify,flag,W), _) :-
'$format'(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
format(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
[W]).
'$output_error_message'(permission_error(modify,operator,W), _) :-
'$format'(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
format(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
[W]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
[Where]).
'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
[Where]).
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
[Where]).
'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
'$format'(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
format(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
[Who,Mod]).
'$output_error_message'(permission_error(open,source_sink,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(output,text_stream,Stream), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
[Where,Stream]).
'$output_error_message'(permission_error(resize,array,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
[Where,P]).
'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
format(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
[Where,P]).
'$output_error_message'(representation_error(character), Where) :-
'$format'(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
format(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
[Where]).
'$output_error_message'(representation_error(character_code), Where) :-
'$format'(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
format(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
[Where]).
'$output_error_message'(representation_error(max_arity), Where) :-
'$format'(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
format(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
[Where]).
'$output_error_message'(syntax_error(G,0,Msg,[],0,0), Where) :- !,
'$format'(user_error,'% SYNTAX ERROR in ~w: ~a~n',[G,Msg]).
format(user_error,'% SYNTAX ERROR in ~w: ~a~n',[G,Msg]).
'$output_error_message'(syntax_error(_,Position,_,Term,Pos,Start), Where) :-
'$format'(user_error,'% ~w ',[Where]),
format(user_error,'% ~w ',[Where]),
'$dump_syntax_error_line'(Start,Position),
'$dump_syntax_error_term'(10,Pos, Term),
'$format'(user_error,'.~n]~n',[]).
format(user_error,'.~n]~n',[]).
'$output_error_message'(system_error, Where) :-
'$format'(user_error,'% SYSTEM ERROR- ~w~n',
format(user_error,'% SYSTEM ERROR- ~w~n',
[Where]).
'$output_error_message'(system_error(Message), Where) :-
'$format'(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
format(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
[Message,Where]).
'$output_error_message'(type_error(T,_,Err,M), _Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
[T,Err,M]).
'$output_error_message'(type_error(array,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(atom,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(atomic,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(byte,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(callable,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(char,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(character,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(character_code,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(compound,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(db_reference,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(db_term,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(evaluable,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(float,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(in_byte,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(in_character,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(in_character_code,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(integer,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(key,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(leash_mode,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(list,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(number,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(pointer,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(predicate_indicator,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(unsigned_byte,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(unsigned_char,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
[Where,W]).
'$output_error_message'(type_error(variable,W), Where) :-
'$format'(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
format(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
[Where,W]).
'$output_error_message'(unknown, Where) :-
'$format'(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
[Where]).
'$dump_syntax_error_line'(Pos,_) :-
'$format'(user_error,'at line ~d:~n',
format(user_error,'at line ~d:~n',
[Pos]).
'$dump_syntax_error_term'(0,J,L) :- !,
'$format'(user_error,'~n', []),
format(user_error,'~n', []),
'$dump_syntax_error_term'(10,J,L).
'$dump_syntax_error_term'(_,0,L) :- !,
'$format'(user_error,'~n<==== HERE ====>~n', []),
format(user_error,'~n<==== HERE ====>~n', []),
'$dump_syntax_error_term'(10,-1,L).
'$dump_syntax_error_term'(_,_,[]) :- !.
'$dump_syntax_error_term'(I,J,[T-P|R]) :-
@ -666,19 +673,19 @@ print_message(Level, Mss) :-
'$dump_syntax_error_term'(I1,J1,R).
'$dump_error_token'(atom(A)) :- !,
'$format'(user_error,' ~a', [A]).
format(user_error,' ~a', [A]).
'$dump_error_token'(number(N)) :- !,
'$format'(user_error,' ~w', [N]).
format(user_error,' ~w', [N]).
'$dump_error_token'(var(_,S,_)) :- !,
'$format'(user_error,' ~s ', [S]).
format(user_error,' ~s ', [S]).
'$dump_error_token'(string(S)) :- !,
'$format'(user_error,' ""~s""', [S]).
format(user_error,' ""~s""', [S]).
'$dump_error_token'('(') :- !,
'$format'(user_error,"(", []).
format(user_error,"(", []).
'$dump_error_token'(')') :- !,
'$format'(user_error," )", []).
format(user_error," )", []).
'$dump_error_token'(',') :- !,
'$format'(user_error," ,", []).
format(user_error," ,", []).
'$dump_error_token'(A) :-
'$format'(user_error," ~a", [A]).
format(user_error," ~a", [A]).

View File

@ -77,17 +77,17 @@ portray_clause(_).
'$portray_clause'(Stream, (Pred :- true)) :- !,
'$beautify_vars'(Pred),
writeq(Stream, Pred),
'$format'(Stream, ".~n", []).
format(Stream, ".~n", []).
'$portray_clause'(Stream, (Pred:-Body)) :- !,
'$beautify_vars'((Pred:-Body)),
writeq(Stream, Pred),
'$format'(Stream, " :-", []),
format(Stream, " :-", []),
'$write_body'(Body, 3, ',', Stream),
'$format'(Stream, ".~n", []).
format(Stream, ".~n", []).
'$portray_clause'(Stream, Pred) :- !,
'$beautify_vars'(Pred),
writeq(Stream, Pred),
'$format'(Stream, ".~n", []).
format(Stream, ".~n", []).
'$write_body'(X,I,T,Stream) :- var(X), !,
'$beforelit'(T,I,Stream),
@ -99,40 +99,40 @@ portray_clause(_).
'$write_body'(Q,I,',',Stream).
'$write_body'((P->Q;S),I,_, Stream) :-
!,
'$format'(Stream, "~n~*c(",[I,0' ]),
format(Stream, "~n~*c(",[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',Stream),
'$format'(Stream, " ->",[]),
format(Stream, " ->",[]),
'$write_disj'((Q;S),I,I1,'->',Stream),
'$format'(Stream, "~n~*c)",[I,0' ]).
format(Stream, "~n~*c)",[I,0' ]).
'$write_body'((P->Q|S),I,_,Stream) :-
!,
'$format'(Stream, "~n~*c(",[I,0' ]),
format(Stream, "~n~*c(",[I,0' ]),
I1 is I+2,
'$write_body'(P,I,'(',Stream),
'$format'(Stream, " ->",[]),
format(Stream, " ->",[]),
'$write_disj'((Q|S),I,I1,'->',Stream),
'$format'(Stream, "~n~*c)",[I,0' ]).
format(Stream, "~n~*c)",[I,0' ]).
'$write_body'((P->Q),I,_,Stream) :-
!,
'$format'(Stream, "~n~*c(",[I,0' ]),
format(Stream, "~n~*c(",[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',Stream),
'$format'(Stream, " ->",[]),
format(Stream, " ->",[]),
'$write_body'(Q,I1,'->',Stream),
'$format'(Stream, "~n~*c)",[I,0' ]).
format(Stream, "~n~*c)",[I,0' ]).
'$write_body'((P;Q),I,_,Stream) :-
!,
'$format'(Stream, "~n~*c(",[I,0' ]),
format(Stream, "~n~*c(",[I,0' ]),
I1 is I+2,
'$write_disj'((P;Q),I,I1,'->',Stream),
'$format'(Stream, "~n~*c)",[I,0' ]).
format(Stream, "~n~*c)",[I,0' ]).
'$write_body'((P|Q),I,_,Stream) :-
!,
'$format'(Stream, "~n~*c(",[I,0' ]),
format(Stream, "~n~*c(",[I,0' ]),
I1 is I+2,
'$write_disj'((P|Q),I,I1,'->',Stream),
'$format'(Stream, "~n~*c)",[I,0' ]).
format(Stream, "~n~*c)",[I,0' ]).
'$write_body'(X,I,T,Stream) :-
'$beforelit'(T,I,Stream),
writeq(Stream,X).
@ -140,18 +140,18 @@ portray_clause(_).
'$write_disj'((Q;S),I0,I,C,Stream) :- !,
'$write_body'(Q,I,C,Stream),
'$format'(Stream, "~n~*c;",[I0,0' ]),
format(Stream, "~n~*c;",[I0,0' ]),
'$write_disj'(S,I0,I,';',Stream).
'$write_disj'((Q|S),I0,I,C,Stream) :- !,
'$write_body'(Q,I,C,Stream),
'$format'(Stream, "~n~*c|",[I0,0' ]),
format(Stream, "~n~*c|",[I0,0' ]),
'$write_disj'(S,I0,I,'|',Stream).
'$write_disj'(S,I0,I,C,Stream) :-
'$write_body'(S,I,C,Stream).
'$beforelit'('(',_,Stream) :- !, '$format'(Stream," ",[]).
'$beforelit'(_,I,Stream) :- '$format'(Stream,"~n~*c",[I,0' ]).
'$beforelit'('(',_,Stream) :- !, format(Stream," ",[]).
'$beforelit'(_,I,Stream) :- format(Stream,"~n~*c",[I,0' ]).
'$beautify_vars'(T) :-
'$list_get_vars'(T,[],L),

View File

@ -196,7 +196,7 @@ module(N) :-
recorda('$module','$module'(F,Mod,Exports),_).
'$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :-
repeat,
'$format'(user_error, "The module ~a is being redefined.~n Old file: ~a~n New file: ~a~nDo you really want to redefine it? (y or n)",[Mod,F0,F]),
format(user_error, "The module ~a is being redefined.~n Old file: ~a~n New file: ~a~nDo you really want to redefine it? (y or n)",[Mod,F0,F]),
'$mod_scan'(C), !,
( C is "y" ->
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R)
@ -227,8 +227,8 @@ module(N) :-
'$check_import'(M,T,N,K) :-
recorded('$import','$import'(M1,T,N,K),R), M1 \= M, /* ZP */ !,
'$format'(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[M1:N/K,T]),
'$format'(user_error," Do you want to import it from ~w ? [y or n] ",M),
format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[M1:N/K,T]),
format(user_error," Do you want to import it from ~w ? [y or n] ",M),
repeat,
get0(C), '$skipeol'(C),
( C is "y" -> erase(R), !;
@ -249,7 +249,7 @@ module(N) :-
print_message(warning,import(N/K,Mod,M,private))
),
( '$check_import'(M,Mod,N,K) ->
% '$format'(user_error,'[ Importing ~w to ~w]~n',[M:N/K,Mod]),
% format(user_error,'[ Importing ~w to ~w]~n',[M:N/K,Mod]),
% '$trace_module'(importing(M:N/K,Mod)),
(Mod = user ->
( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true )
@ -486,7 +486,7 @@ module(N) :-
'$meta_predicate'(F,Mod,N,D), !,
functor(G1,F,N),
'$meta_expansion_loop'(N,D,G,G1,HVars,MP).
% '$format'(user_error," gives ~w~n]",[G1]).
% format(user_error," gives ~w~n]",[G1]).
% expand argument
'$meta_expansion_loop'(0,_,_,_,_,_) :- !.

View File

@ -37,42 +37,42 @@ statistics :-
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
TotalMemory is HpSpa+StkSpa+TrlSpa,
'$format'(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
'$format'(user_error," program space~t~d bytes~35+", [HpSpa]),
'$format'(user_error,":~t ~d in use~19+", [HpInUse]),
format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
format(user_error," program space~t~d bytes~35+", [HpSpa]),
format(user_error,":~t ~d in use~19+", [HpInUse]),
HpFree is HpSpa-HpInUse,
'$format'(user_error,",~t ~d free~19+~n", [HpFree]),
'$format'(user_error,"~t ~d max~73+~n", [HpMax]),
'$format'(user_error," stack space~t~d bytes~35+", [StkSpa]),
format(user_error,",~t ~d free~19+~n", [HpFree]),
format(user_error,"~t ~d max~73+~n", [HpMax]),
format(user_error," stack space~t~d bytes~35+", [StkSpa]),
StackInUse is GlobInU+LocInU,
'$format'(user_error,":~t ~d in use~19+", [StackInUse]),
format(user_error,":~t ~d in use~19+", [StackInUse]),
StackFree is StkSpa-StackInUse,
'$format'(user_error,",~t ~d free~19+~n", [StackFree]),
'$format'(user_error," global stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [GlobInU]),
'$format'(user_error,",~t ~d max~19+~n", [GlobMax]),
'$format'(user_error," local stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [LocInU]),
'$format'(user_error,",~t ~d max~19+~n", [LocMax]),
'$format'(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
'$format'(user_error,":~t ~d in use~19+", [TrlInUse]),
format(user_error,",~t ~d free~19+~n", [StackFree]),
format(user_error," global stack:~t~35+", []),
format(user_error," ~t ~d in use~19+", [GlobInU]),
format(user_error,",~t ~d max~19+~n", [GlobMax]),
format(user_error," local stack:~t~35+", []),
format(user_error," ~t ~d in use~19+", [LocInU]),
format(user_error,",~t ~d max~19+~n", [LocMax]),
format(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
format(user_error,":~t ~d in use~19+", [TrlInUse]),
TrlFree is TrlSpa-TrlInUse,
'$format'(user_error,",~t ~d free~19+~n", [TrlFree]),
format(user_error,",~t ~d free~19+~n", [TrlFree]),
OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000,
'$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
[OvfTime,NOfHO,NOfSO,NOfTO]),
TotGCTimeF is float(TotGCTime)/1000,
'$format'(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
format(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
[TotGCTimeF,NOfGC,TotGCSize]),
TotAGCTimeF is float(TotAGCTime)/1000,
'$format'(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
format(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
[TotAGCTimeF,NOfAGC,TotAGCSize]),
RTime is float(Runtime)/1000,
'$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
format(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
CPUTime is float(CPUtime)/1000,
'$format'(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
format(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
WallTime is float(Walltime)/1000,
'$format'(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
format(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
fail.
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).

View File

@ -505,12 +505,6 @@ print(Stream,T) :-
print(_,_).
format(N,A) :- atom(N), !, atom_codes(N, S), '$format'(S,A).
format(F,A) :- '$format'(F,A).
format(Stream, N, A) :- atom(N), !, atom_codes(N, S), '$format'(Stream, S ,A).
format(Stream, S, A) :- '$format'(Stream, S, A).
/* interface to user portray */
'$portray'(T) :-
\+ '$undefined'(portray(_),user),