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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
C/absmi.c
View File

@ -10,8 +10,11 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * 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 $ * $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 * Revision 1.138 2004/06/29 19:04:40 vsc
* fix multithreaded version * fix multithreaded version
* include new version of Ricardo's profiler * include new version of Ricardo's profiler
@ -384,10 +387,8 @@ Yap_absmi(int inp)
noheapleft: noheapleft:
saveregs(); saveregs();
if (NOfAtoms > 2*AtomHashTableSize) { if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_growatomtable(); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
} else if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
setregs(); setregs();
FAIL(); FAIL();
} }
@ -11649,8 +11650,9 @@ Yap_absmi(int inp)
/* setup GB */ /* setup GB */
WRITEBACK_Y_AS_ENV(); WRITEBACK_Y_AS_ENV();
YREG[E_CB] = (CELL) B; YREG[E_CB] = (CELL) B;
if (ActiveSignals) if (ActiveSignals) {
goto creep_pe; goto creep_pe;
}
saveregs_and_ycache(); saveregs_and_ycache();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) { if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -11920,6 +11922,9 @@ Yap_absmi(int inp)
} }
} }
if (ActiveSignals) { if (ActiveSignals) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
goto noheapleft;
}
goto creep; goto creep;
} }
saveregs(); saveregs();

9
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * 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 #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -881,11 +881,8 @@ ExtendWorkSpace(Int s, int fixed_allocation)
return FALSE; return FALSE;
} }
} else if (a < WorkSpaceTop) { } else if (a < WorkSpaceTop) {
Yap_ErrorMessage = Yap_ErrorSay; /* try again */
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, return ExtendWorkSpace(s, fixed_allocation);
"mmap could grew memory at lower addresses than %p, got %p", WorkSpaceTop, a );
Yap_PrologMode = OldPrologMode;
return FALSE;
} }
WorkSpaceTop = (char *) a + s; WorkSpaceTop = (char *) a + s;
Yap_PrologMode = OldPrologMode; Yap_PrologMode = OldPrologMode;

65
C/c_interface.c
View File

@ -10,8 +10,15 @@
* File: c_interface.c * * File: c_interface.c *
* comments: c_interface primitives definition * * 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 $ * $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 * Revision 1.49 2004/06/09 03:32:02 vsc
* fix bugs * fix bugs
* *
@ -50,6 +57,7 @@
#ifdef YAPOR #ifdef YAPOR
#include "or.macros.h" #include "or.macros.h"
#endif /* YAPOR */ #endif /* YAPOR */
#include "threads.h"
#define YAP_BOOT_FROM_PROLOG 0 #define YAP_BOOT_FROM_PROLOG 0
#define YAP_BOOT_FROM_SAVED_CODE 1 #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_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,Term)); 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_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); static int (*do_getf)(void);
@ -1240,3 +1253,53 @@ YAP_CurrentModule(void)
return(CurrentModule); 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
}

25
C/cdmgr.c
View File

@ -11,8 +11,15 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * 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 $ * $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 * Revision 1.124 2004/06/05 03:36:59 vsc
* coroutining is now a part of attvars. * coroutining is now a part of attvars.
* some more fixes. * 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) { while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (first_time) { 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
th = ARG5;
tb = ARG6;
tr = ARG7;
} else { } 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); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
th = ARG6;
tb = ARG7;
tr = ARG8;
} }
} }
return(Yap_unify(th, ArgOfTerm(1,t)) && return(Yap_unify(th, ArgOfTerm(1,t)) &&

2
C/exec.c
View File

@ -211,7 +211,7 @@ EnterCreepMode(Term t, Term mod) {
if (ActiveSignals & YAP_CDOVF_SIGNAL) { if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ARG1 = t; ARG1 = t;
if (!Yap_growheap(FALSE, 0, NULL)) { 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) { if (!ActiveSignals) {
return do_execute(ARG1, mod); 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; 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 int
Yap_growheap(int fix_code, UInt in_size, void *cip) Yap_growheap(int fix_code, UInt in_size, void *cip)
{ {
int res; int res;
Yap_PrologMode |= GrowHeapMode; Yap_PrologMode |= GrowHeapMode;
if (NOfAtoms > 2*AtomHashTableSize) {
res = growatomtable();
Yap_PrologMode &= ~GrowHeapMode;
return res;
}
res=do_growheap(fix_code, in_size, (struct intermediates *)cip); res=do_growheap(fix_code, in_size, (struct intermediates *)cip);
Yap_PrologMode &= ~GrowHeapMode; Yap_PrologMode &= ~GrowHeapMode;
return res; return res;
@ -1065,66 +1140,6 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
#endif #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 static Int
p_inform_trail_overflows(void) p_inform_trail_overflows(void)
{ {

28
C/iopreds.c
View File

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

179
C/threads.c
View File

@ -30,6 +30,8 @@ static char SccsId[] = "%W% %G%";
#if THREADS #if THREADS
#include "threads.h"
/* /*
* This file includes the definition of threads in Yap. Threads * This file includes the definition of threads in Yap. Threads
* are supposed to be compatible with the SWI-Prolog thread package. * 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 static void
thread_die(int wid, int always_die) thread_die(int wid, int always_die)
{ {
Prop p0;
LOCK(ThreadHandlesLock); LOCK(ThreadHandlesLock);
if (!always_die) { if (!always_die) {
@ -81,50 +103,49 @@ thread_die(int wid, int always_die)
ThreadsTotalTime += Yap_cputime(); ThreadsTotalTime += Yap_cputime();
} }
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) || if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
always_die) { always_die)
p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds); kill_thread_engine(wid);
/* 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));
}
UNLOCK(ThreadHandlesLock); 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 * static void *
thread_run(void *widp) thread_run(void *widp)
{ {
Term tgoal; Term tgoal;
Term tgs[2]; Term tgs[2];
int out; int out;
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
int myworker_id = *((int *)widp); int myworker_id = *((int *)widp);
/* create the YAAM descriptor */ start_thread(myworker_id);
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());
}
tgs[0] = Yap_FetchTermFromDB(ThreadHandle[worker_id].tgoal); tgs[0] = Yap_FetchTermFromDB(ThreadHandle[worker_id].tgoal);
tgs[1] = ThreadHandle[worker_id].tdetach; tgs[1] = ThreadHandle[worker_id].tdetach;
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs); tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
@ -139,6 +160,13 @@ p_thread_new_tid(void)
return Yap_unify(MkIntegerTerm(allocate_new_tid()), ARG1); 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 static Int
p_create_thread(void) p_create_thread(void)
{ {
@ -153,33 +181,9 @@ p_create_thread(void)
/* YAP ERROR */ /* YAP ERROR */
return FALSE; return FALSE;
} }
init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach);
ThreadHandle[new_worker_id].id = new_worker_id; ThreadHandle[new_worker_id].id = new_worker_id;
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach); ThreadHandle[new_worker_id].ref_count = 1;
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);
if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) { 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; return TRUE;
} }
@ -194,11 +198,62 @@ p_thread_self(void)
} }
int int
Yap_self(void) Yap_thread_self(void)
{ {
return worker_id; 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 static Int
p_thread_join(void) p_thread_join(void)
{ {

30
CLPBN/clpbn.yap
View File

@ -1,16 +1,11 @@
:- module(clpbn, [{}/1, :- module(clpbn, [{}/1).
clpbn_findall/3,
clpbn_setof/3]).
:- use_module(library(atts)). :- use_module(library(atts)).
:- use_module(library(lists)). :- use_module(library(lists)).
:- use_module(library(terms)). :- use_module(library(terms)).
:- op(1200, xfx, '<--').
:- op(1200, fx, '<--').
:- op( 500, xfx, '=>').
:- op( 500, xfy, with). :- op( 500, xfy, with).
% %
@ -40,15 +35,13 @@
execute_pre_evidence/0 execute_pre_evidence/0
]). ]).
:- include('clpbn/aggs').
use(vel). use(vel).
{Var = Key with Dist} :- {Var = Key with Dist} :-
% key_entry(Key,Indx), % key_entry(Key,Indx),
% array_element(clpbn,Indx,El), % array_element(clpbn,Indx,El),
% attributes:put_att(El,3,indx(Indx)), % 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), extract_dist(Dist, E, Domain),
add_evidence(Var,El). add_evidence(Var,El).
@ -257,25 +250,6 @@ starter_vars([Var|Vs]) :-
starter_vars(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_bnode(Var, Goal) :-
get_atts(Var, [key(Key),dist(X)]), get_atts(Var, [key(Key),dist(X)]),
dist_goal(X, Key, Goal0), dist_goal(X, Key, Goal0),

3
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * 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 */ /* information that can be stored in Code Space */
@ -76,6 +76,7 @@ typedef struct thandle {
REGSTORE *current_yaam_regs; REGSTORE *current_yaam_regs;
struct pred_entry *local_preds; struct pred_entry *local_preds;
pthread_t handle; pthread_t handle;
int ref_count;
pthread_mutex_t tlock; pthread_mutex_t tlock;
#if HAVE_GETRUSAGE #if HAVE_GETRUSAGE
struct timeval *start_of_timesp; struct timeval *start_of_timesp;

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * 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 */ /* 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_growstack, (long));
int STD_PROTO(Yap_growtrail, (long)); int STD_PROTO(Yap_growtrail, (long));
int STD_PROTO(Yap_growglobal, (CELL **)); int STD_PROTO(Yap_growglobal, (CELL **));
void STD_PROTO(Yap_growatomtable, (void));
CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***)); CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***));
/* heapgc.c */ /* heapgc.c */

2
H/absmi.h
View File

@ -695,7 +695,7 @@ Macros to check the limits of stacks
(GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label (GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label
#else #else
#define check_stack(Label, GLOB) \ #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 */ #endif /* SBA && YAPOR */
/*************************************************************** /***************************************************************

8
include/YapInterface.h
View File

@ -339,9 +339,15 @@ extern X_API void *PROTO(YAP_Predicate,(YAP_Atom,unsigned long int,int));
/* int YAP_Predicate() */ /* int YAP_Predicate() */
extern X_API void PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,int*)); 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_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) #define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
__END_DECLS __END_DECLS

8
include/yap_structs.h
View File

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

11
library/yap2swi/yap2swi.c
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 /* note: fprintf may be called from anywhere, so please don't try
to be smart and allocate stack from somewhere else */ to be smart and allocate stack from somewhere else */
X_API int Sprintf(char *format,...) X_API int Sprintf(char *format,...)

13
library/yap2swi/yap2swi.h
View File

@ -39,6 +39,17 @@ typedef struct _PL_extension
short flags; /* Or of PL_FA_... */ short flags; /* Or of PL_FA_... */
} PL_extension; } 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_NOTRACE (0x01) /* foreign cannot be traced */
#define PL_FA_TRANSPARENT (0x02) /* foreign is module transparent */ #define PL_FA_TRANSPARENT (0x02) /* foreign is module transparent */
#define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */ #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_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t); extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_extensions(PL_extension *); 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 *,...); extern X_API int Sprintf(char *,...);

5
misc/yap.def
View File

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

44
pl/boot.yap
View File

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

36
pl/debug.yap
View File

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

335
pl/errors.yap
View File

@ -11,8 +11,15 @@
* File: errors.yap * * File: errors.yap *
* comments: error messages for 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 $ * $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 * Revision 1.52 2004/06/18 15:41:19 vsc
* fix extraneous line in yes/no messages * fix extraneous line in yes/no messages
* *
@ -65,7 +72,7 @@ print_message(Level, Mss) :-
user:portray_message(Severity, Msg), !. user:portray_message(Severity, Msg), !.
'$print_message'(error,error(Msg,Info)) :- '$print_message'(error,error(Msg,Info)) :-
( var(Msg) ; var(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),_)) :- !, '$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'). '$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :- '$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)) :- '$print_message'(error,error(Type,Where)) :-
'$output_error_message'(Type, Where), !. '$output_error_message'(Type, Where), !.
'$print_message'(error,Throw) :- '$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) :- '$print_message'(informational,M) :-
( get_value('$verbose',on) -> ( get_value('$verbose',on) ->
'$do_informational_message'(M) ; '$do_informational_message'(M) ;
true true
). ).
'$print_message'(warning,M) :- '$print_message'(warning,M) :-
'$format'(user_error, '% ', []), format(user_error, '% ', []),
'$do_print_message'(M), '$do_print_message'(M),
'$format'(user_error, '~n', []). format(user_error, '~n', []).
'$print_message'(help,M) :- '$print_message'(help,M) :-
'$do_print_message'(M), '$do_print_message'(M),
'$format'(user_error, '~n', []). format(user_error, '~n', []).
'$do_informational_message'(halt) :- !, '$do_informational_message'(halt) :- !,
'$format'(user_error, '% YAP execution halted~n', []). format(user_error, '% YAP execution halted~n', []).
'$do_informational_message'(abort(_)) :- !, '$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(_,user)) :- !.
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !, '$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC), '$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(_,user,_,_,_)) :- !.
'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !, '$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
'$show_consult_level'(LC0), '$show_consult_level'(LC0),
LC is LC0+1, 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) :- '$do_informational_message'(M) :-
'$format'(user_error,'% ', []), format(user_error,'% ', []),
'$do_print_message'(M), '$do_print_message'(M),
'$format'(user_error,'~n', []). format(user_error,'~n', []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'('$format'(Msg, Args)) :- !, '$do_print_message'(format(Msg, Args)) :- !,
'$format'(user_error,Msg,Args). format(user_error,Msg,Args).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !, '$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]). [M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !, '$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]). [M,F,N]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !, '$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]). [M,F,N]).
'$do_print_message'(breakp(no,breakpoint_for,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]). [M,F,N]).
'$do_print_message'(breakpoints([])) :- !, '$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]). [M,F,N]).
'$do_print_message'(breakpoints(L)) :- !, '$do_print_message'(breakpoints(L)) :- !,
'$format'(user_error,'Spy-points set on:', []), format(user_error,'Spy-points set on:', []),
'$print_list_of_preds'(L). '$print_list_of_preds'(L).
'$do_print_message'(debug(debug)) :- !, '$do_print_message'(debug(debug)) :- !,
'$format'(user_error,'Debug mode on.',[]). format(user_error,'Debug mode on.',[]).
'$do_print_message'(debug(off)) :- !, '$do_print_message'(debug(off)) :- !,
'$format'(user_error,'Debug mode off.',[]). format(user_error,'Debug mode off.',[]).
'$do_print_message'(debug(trace)) :- !, '$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)) :- !, '$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]). [From,Pred,To]).
'$do_print_message'(leash([])) :- !, '$do_print_message'(leash([])) :- !,
'$format'(user_error,'No leashing.', format(user_error,'No leashing.',
[M,F,N]). [M,F,N]).
'$do_print_message'(leash([A|B])) :- !, '$do_print_message'(leash([A|B])) :- !,
'$format'(user_error,'Leashing set to ~w.', format(user_error,'Leashing set to ~w.',
[[A|B]]). [[A|B]]).
'$do_print_message'(no) :- !, '$do_print_message'(no) :- !,
'$format'(user_error, 'no', []). format(user_error, 'no', []).
'$do_print_message'(no_match(P)) :- !, '$do_print_message'(no_match(P)) :- !,
'$format'(user_error,'No matching predicate for ~w.', format(user_error,'No matching predicate for ~w.',
[P]). [P]).
'$do_print_message'(trace_command(C)) :- !, '$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) :- !, '$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)) :- !, '$do_print_message'(version(Version)) :- !,
'$format'(user_error,'YAP version ~a', [Version]). format(user_error,'YAP version ~a', [Version]).
'$do_print_message'(yes) :- !, '$do_print_message'(yes) :- !,
'$format'(user_error, 'yes', []). format(user_error, 'yes', []).
'$do_print_message'(Messg) :- '$do_print_message'(Messg) :-
'$format'(user_error,'~q',Messg). format(user_error,'~q',Messg).
'$print_list_of_preds'([]). '$print_list_of_preds'([]).
'$print_list_of_preds'([P|L]) :- '$print_list_of_preds'([P|L]) :-
'$format'(user_error,'~n ~w',[P]), format(user_error,'~n ~w',[P]),
'$print_list_of_preds'(L). '$print_list_of_preds'(L).
'$do_stack_dump'(Envs, CPs) :- '$do_stack_dump'(Envs, CPs) :-
@ -266,20 +273,20 @@ print_message(Level, Mss) :-
'$say_stack_dump'([], []) :- !. '$say_stack_dump'([], []) :- !.
'$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'([], []) :- !.
'$close_stack_dump'(_, _) :- '$close_stack_dump'(_, _) :-
'$format'(user_error,'~n', []). format(user_error,'~n', []).
'$show_cps'([]) :- !. '$show_cps'([]) :- !.
'$show_cps'(List) :- '$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). '$print_stack'(List).
'$show_envs'([]) :- !. '$show_envs'([]) :- !.
'$show_envs'(List) :- '$show_envs'(List) :-
'$format'(user_error,'% ~n environments (partially executed clauses):',[]), format(user_error,'% ~n environments (partially executed clauses):',[]),
'$print_stack'(List). '$print_stack'(List).
'$prepare_loc'(Info,Where,Location) :- integer(Where), !, '$prepare_loc'(Info,Where,Location) :- integer(Where), !,
@ -289,16 +296,16 @@ print_message(Level, Mss) :-
'$print_stack'([]). '$print_stack'([]).
'$print_stack'([overflow]) :- !, '$print_stack'([overflow]) :- !,
'$format'(user_error,'~n% ...',[]). format(user_error,'~n% ...',[]).
'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :- '$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
'$show_goal'(Clause,Name,Arity,Mod), '$show_goal'(Clause,Name,Arity,Mod),
'$print_stack'(List). '$print_stack'(List).
'$show_goal'(-1,Name,Arity,Mod) :- !, '$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'(0,Name,Arity,Mod) :- !.
'$show_goal'(I,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) :- !, '$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
number_codes(Arity,ArityCode), number_codes(Arity,ArityCode),
@ -313,350 +320,350 @@ print_message(Level, Mss) :-
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location). atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
'$output_error_message'(consistency_error(Who),Where) :- '$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]). [Who,Where]).
'$output_error_message'(context_error(Goal,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]). [Goal,Who,Where]).
'$output_error_message'(domain_error(array_overflow,Opt), 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]). [Where,Opt]).
'$output_error_message'(domain_error(array_type,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(builtin_procedure,P), P) :- '$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]). [P]).
'$output_error_message'(domain_error(character_code_list,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(operator_specifier,Op), Where) :- '$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]). [Where,Op]).
'$output_error_message'(domain_error(out_of_range,Value), Where) :- '$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]). [Where,Value]).
'$output_error_message'(domain_error(close_option,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(radix,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :- '$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]). [Where,Opt]).
'$output_error_message'(domain_error(flag_value,F+V), W) :- '$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]). [W,V,F]).
'$output_error_message'(domain_error(io_mode,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(mutable,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(module_decl_options,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(not_empty_list,_), Where) :- '$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]). [Where]).
'$output_error_message'(domain_error(not_less_than_zero,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]). [Where,N]).
'$output_error_message'(domain_error(not_newline,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(not_zero,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(operator_priority,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(operator_specifier,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(predicate_spec,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(read_option,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(semantics_indicator,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(domain_error(source_sink,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(domain_error(stream,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(stream_or_alias,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(stream_option,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(stream_position,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(stream_property,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(syntax_error_handler,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :- '$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]). [Where,Option, Opts]).
'$output_error_message'(domain_error(time_out_spec,What), Where) :- '$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]). [Where,What]).
'$output_error_message'(domain_error(write_option,N), Where) :- '$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]). [Where,N]).
'$output_error_message'(existence_error(array,F), W) :- '$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]). [W,F]).
'$output_error_message'(existence_error(mutex,F), W) :- '$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]). [W,F]).
'$output_error_message'(existence_error(queue,F), W) :- '$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]). [W,F]).
'$output_error_message'(existence_error(procedure,P), _) :- '$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]). [P]).
'$output_error_message'(existence_error(source_sink,F), W) :- '$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]). [W,F]).
'$output_error_message'(existence_error(stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(evaluation_error(int_overflow), Where) :- '$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]). [Where]).
'$output_error_message'(evaluation_error(float_overflow), 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]). [Where]).
'$output_error_message'(evaluation_error(undefined), 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]). [Where]).
'$output_error_message'(evaluation_error(underflow), Where) :- '$output_error_message'(evaluation_error(underflow), Where) :-
'$format'(user_error,'% UNDERFLOW ERROR- ~w~n', format(user_error,'% UNDERFLOW ERROR- ~w~n',
[Where]). [Where]).
'$output_error_message'(evaluation_error(float_underflow), 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]). [Where]).
'$output_error_message'(evaluation_error(zero_divisor), 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]). [Where]).
'$output_error_message'(instantiation_error, 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]). [Where]).
'$output_error_message'(out_of_heap_error, 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]). [Where]).
'$output_error_message'(out_of_stack_error, 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]). [Where]).
'$output_error_message'(out_of_trail_error, 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]). [Where]).
'$output_error_message'(permission_error(access,private_procedure,P), 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]). [Where,P]).
'$output_error_message'(permission_error(access,static_procedure,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(alias,new,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(create,array,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(create,mutex,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(create,queue,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(create,operator,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(input,stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(input,text_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :- '$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]). [Where]).
'$output_error_message'(permission_error(modify,flag,W), _) :- '$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]). [W]).
'$output_error_message'(permission_error(modify,operator,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]). [W]).
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :- '$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]). [Where]).
'$output_error_message'(permission_error(modify,static_procedure,_), 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]). [Where]).
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), 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]). [Where]).
'$output_error_message'(permission_error(module,redefined,Mod), Who) :- '$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]). [Who,Mod]).
'$output_error_message'(permission_error(open,source_sink,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(output,stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(output,text_stream,Stream), Where) :- '$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]). [Where,Stream]).
'$output_error_message'(permission_error(resize,array,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(permission_error(unlock,mutex,P), Where) :- '$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]). [Where,P]).
'$output_error_message'(representation_error(character), Where) :- '$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]). [Where]).
'$output_error_message'(representation_error(character_code), 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]). [Where]).
'$output_error_message'(representation_error(max_arity), 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]). [Where]).
'$output_error_message'(syntax_error(G,0,Msg,[],0,0), 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) :- '$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_line'(Start,Position),
'$dump_syntax_error_term'(10,Pos, Term), '$dump_syntax_error_term'(10,Pos, Term),
'$format'(user_error,'.~n]~n',[]). format(user_error,'.~n]~n',[]).
'$output_error_message'(system_error, Where) :- '$output_error_message'(system_error, Where) :-
'$format'(user_error,'% SYSTEM ERROR- ~w~n', format(user_error,'% SYSTEM ERROR- ~w~n',
[Where]). [Where]).
'$output_error_message'(system_error(Message), 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]). [Message,Where]).
'$output_error_message'(type_error(T,_,Err,M), _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]). [T,Err,M]).
'$output_error_message'(type_error(array,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(atom,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(atomic,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(byte,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(callable,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(char,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(character,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(character_code,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(compound,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(db_reference,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(db_term,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(evaluable,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(float,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(in_byte,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(in_character,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(in_character_code,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(integer,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(key,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(leash_mode,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(list,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(number,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(pointer,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(predicate_indicator,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(unsigned_byte,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(unsigned_char,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(type_error(variable,W), Where) :- '$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]). [Where,W]).
'$output_error_message'(unknown, Where) :- '$output_error_message'(unknown, Where) :-
'$format'(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n', format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
[Where]). [Where]).
'$dump_syntax_error_line'(Pos,_) :- '$dump_syntax_error_line'(Pos,_) :-
'$format'(user_error,'at line ~d:~n', format(user_error,'at line ~d:~n',
[Pos]). [Pos]).
'$dump_syntax_error_term'(0,J,L) :- !, '$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'(10,J,L).
'$dump_syntax_error_term'(_,0,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'(10,-1,L).
'$dump_syntax_error_term'(_,_,[]) :- !. '$dump_syntax_error_term'(_,_,[]) :- !.
'$dump_syntax_error_term'(I,J,[T-P|R]) :- '$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_syntax_error_term'(I1,J1,R).
'$dump_error_token'(atom(A)) :- !, '$dump_error_token'(atom(A)) :- !,
'$format'(user_error,' ~a', [A]). format(user_error,' ~a', [A]).
'$dump_error_token'(number(N)) :- !, '$dump_error_token'(number(N)) :- !,
'$format'(user_error,' ~w', [N]). format(user_error,' ~w', [N]).
'$dump_error_token'(var(_,S,_)) :- !, '$dump_error_token'(var(_,S,_)) :- !,
'$format'(user_error,' ~s ', [S]). format(user_error,' ~s ', [S]).
'$dump_error_token'(string(S)) :- !, '$dump_error_token'(string(S)) :- !,
'$format'(user_error,' ""~s""', [S]). format(user_error,' ""~s""', [S]).
'$dump_error_token'('(') :- !, '$dump_error_token'('(') :- !,
'$format'(user_error,"(", []). format(user_error,"(", []).
'$dump_error_token'(')') :- !, '$dump_error_token'(')') :- !,
'$format'(user_error," )", []). format(user_error," )", []).
'$dump_error_token'(',') :- !, '$dump_error_token'(',') :- !,
'$format'(user_error," ,", []). format(user_error," ,", []).
'$dump_error_token'(A) :- '$dump_error_token'(A) :-
'$format'(user_error," ~a", [A]). format(user_error," ~a", [A]).

42
pl/listing.yap
View File

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

10
pl/modules.yap
View File

@ -196,7 +196,7 @@ module(N) :-
recorda('$module','$module'(F,Mod,Exports),_). recorda('$module','$module'(F,Mod,Exports),_).
'$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :- '$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :-
repeat, 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), !, '$mod_scan'(C), !,
( C is "y" -> ( C is "y" ->
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) '$add_preexisting_module_on_file'(F, F, Mod, Exports, R)
@ -227,8 +227,8 @@ module(N) :-
'$check_import'(M,T,N,K) :- '$check_import'(M,T,N,K) :-
recorded('$import','$import'(M1,T,N,K),R), M1 \= M, /* ZP */ !, 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,"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," Do you want to import it from ~w ? [y or n] ",M),
repeat, repeat,
get0(C), '$skipeol'(C), get0(C), '$skipeol'(C),
( C is "y" -> erase(R), !; ( C is "y" -> erase(R), !;
@ -249,7 +249,7 @@ module(N) :-
print_message(warning,import(N/K,Mod,M,private)) print_message(warning,import(N/K,Mod,M,private))
), ),
( '$check_import'(M,Mod,N,K) -> ( '$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)), % '$trace_module'(importing(M:N/K,Mod)),
(Mod = user -> (Mod = user ->
( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true ) ( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true )
@ -486,7 +486,7 @@ module(N) :-
'$meta_predicate'(F,Mod,N,D), !, '$meta_predicate'(F,Mod,N,D), !,
functor(G1,F,N), functor(G1,F,N),
'$meta_expansion_loop'(N,D,G,G1,HVars,MP). '$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 % expand argument
'$meta_expansion_loop'(0,_,_,_,_,_) :- !. '$meta_expansion_loop'(0,_,_,_,_,_) :- !.

46
pl/statistics.yap
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) :- '$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, TotalMemory is HpSpa+StkSpa+TrlSpa,
'$format'(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]), format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
'$format'(user_error," program space~t~d bytes~35+", [HpSpa]), format(user_error," program space~t~d bytes~35+", [HpSpa]),
'$format'(user_error,":~t ~d in use~19+", [HpInUse]), format(user_error,":~t ~d in use~19+", [HpInUse]),
HpFree is HpSpa-HpInUse, HpFree is HpSpa-HpInUse,
'$format'(user_error,",~t ~d free~19+~n", [HpFree]), format(user_error,",~t ~d free~19+~n", [HpFree]),
'$format'(user_error,"~t ~d max~73+~n", [HpMax]), format(user_error,"~t ~d max~73+~n", [HpMax]),
'$format'(user_error," stack space~t~d bytes~35+", [StkSpa]), format(user_error," stack space~t~d bytes~35+", [StkSpa]),
StackInUse is GlobInU+LocInU, 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, StackFree is StkSpa-StackInUse,
'$format'(user_error,",~t ~d free~19+~n", [StackFree]), format(user_error,",~t ~d free~19+~n", [StackFree]),
'$format'(user_error," global stack:~t~35+", []), format(user_error," global stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [GlobInU]), format(user_error," ~t ~d in use~19+", [GlobInU]),
'$format'(user_error,",~t ~d max~19+~n", [GlobMax]), format(user_error,",~t ~d max~19+~n", [GlobMax]),
'$format'(user_error," local stack:~t~35+", []), format(user_error," local stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [LocInU]), format(user_error," ~t ~d in use~19+", [LocInU]),
'$format'(user_error,",~t ~d max~19+~n", [LocMax]), format(user_error,",~t ~d max~19+~n", [LocMax]),
'$format'(user_error," trail stack~t~d bytes~35+", [TrlSpa]), format(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
'$format'(user_error,":~t ~d in use~19+", [TrlInUse]), format(user_error,":~t ~d in use~19+", [TrlInUse]),
TrlFree is TrlSpa-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, 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]), [OvfTime,NOfHO,NOfSO,NOfTO]),
TotGCTimeF is float(TotGCTime)/1000, 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]), [TotGCTimeF,NOfGC,TotGCSize]),
TotAGCTimeF is float(TotAGCTime)/1000, 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]), [TotAGCTimeF,NOfAGC,TotAGCSize]),
RTime is float(Runtime)/1000, 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, 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, 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. fail.
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_). '$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).

6
pl/yio.yap
View File

@ -505,12 +505,6 @@ print(Stream,T) :-
print(_,_). 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 */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),