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
parent
fec65e106a
commit
21a3377248
17
C/absmi.c
17
C/absmi.c
@ -10,8 +10,11 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2004-07-03 03:29:24 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.139 2004/07/03 03:29:24 vsc
|
||||
* make it compile again on non-linux machines
|
||||
*
|
||||
* Revision 1.138 2004/06/29 19:04:40 vsc
|
||||
* fix multithreaded version
|
||||
* include new version of Ricardo's profiler
|
||||
@ -384,10 +387,8 @@ Yap_absmi(int inp)
|
||||
|
||||
noheapleft:
|
||||
saveregs();
|
||||
if (NOfAtoms > 2*AtomHashTableSize) {
|
||||
Yap_growatomtable();
|
||||
} else if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
|
||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
|
||||
setregs();
|
||||
FAIL();
|
||||
}
|
||||
@ -11649,8 +11650,9 @@ Yap_absmi(int inp)
|
||||
/* setup GB */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
YREG[E_CB] = (CELL) B;
|
||||
if (ActiveSignals)
|
||||
if (ActiveSignals) {
|
||||
goto creep_pe;
|
||||
}
|
||||
saveregs_and_ycache();
|
||||
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
|
||||
@ -11920,6 +11922,9 @@ Yap_absmi(int inp)
|
||||
}
|
||||
}
|
||||
if (ActiveSignals) {
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
goto noheapleft;
|
||||
}
|
||||
goto creep;
|
||||
}
|
||||
saveregs();
|
||||
|
||||
@ -12,7 +12,7 @@
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: allocating space *
|
||||
* version:$Id: alloc.c,v 1.51 2004-06-23 17:24:19 vsc Exp $ *
|
||||
* version:$Id: alloc.c,v 1.52 2004-07-22 21:32:20 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
#ifdef SCCS
|
||||
static char SccsId[] = "%W% %G%";
|
||||
@ -881,11 +881,8 @@ ExtendWorkSpace(Int s, int fixed_allocation)
|
||||
return FALSE;
|
||||
}
|
||||
} else if (a < WorkSpaceTop) {
|
||||
Yap_ErrorMessage = Yap_ErrorSay;
|
||||
snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
|
||||
"mmap could grew memory at lower addresses than %p, got %p", WorkSpaceTop, a );
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
return FALSE;
|
||||
/* try again */
|
||||
return ExtendWorkSpace(s, fixed_allocation);
|
||||
}
|
||||
WorkSpaceTop = (char *) a + s;
|
||||
Yap_PrologMode = OldPrologMode;
|
||||
|
||||
@ -10,8 +10,15 @@
|
||||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.50 2004/06/29 19:04:41 vsc
|
||||
* fix multithreaded version
|
||||
* include new version of Ricardo's profiler
|
||||
* new predicat atomic_concat
|
||||
* allow multithreaded-debugging
|
||||
* small fixes
|
||||
*
|
||||
* Revision 1.49 2004/06/09 03:32:02 vsc
|
||||
* fix bugs
|
||||
*
|
||||
@ -50,6 +57,7 @@
|
||||
#ifdef YAPOR
|
||||
#include "or.macros.h"
|
||||
#endif /* YAPOR */
|
||||
#include "threads.h"
|
||||
|
||||
#define YAP_BOOT_FROM_PROLOG 0
|
||||
#define YAP_BOOT_FROM_SAVED_CODE 1
|
||||
@ -146,6 +154,11 @@ X_API void STD_PROTO(YAP_UserCPredicate,(char *,CPredicate,unsigned long int)
|
||||
X_API void STD_PROTO(YAP_UserBackCPredicate,(char *,CPredicate,CPredicate,unsigned long int,unsigned int));
|
||||
X_API void STD_PROTO(YAP_UserCPredicateWithArgs,(char *,CPredicate,unsigned long int,Term));
|
||||
X_API Int STD_PROTO(YAP_CurrentModule,(void));
|
||||
X_API int STD_PROTO(YAP_ThreadSelf,(void));
|
||||
X_API int STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *));
|
||||
X_API int STD_PROTO(YAP_ThreadAttachEngine,(int));
|
||||
X_API int STD_PROTO(YAP_ThreadDetachEngine,(int));
|
||||
X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int));
|
||||
|
||||
static int (*do_getf)(void);
|
||||
|
||||
@ -1240,3 +1253,53 @@ YAP_CurrentModule(void)
|
||||
return(CurrentModule);
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadSelf(void)
|
||||
{
|
||||
#if USE_THREADS
|
||||
return Yap_thread_self();
|
||||
#else
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadCreateEngine(thread_attr *attr)
|
||||
{
|
||||
#if USE_THREADS
|
||||
return Yap_thread_create_engine(attr);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadAttachEngine(int wid)
|
||||
{
|
||||
#if USE_THREADS
|
||||
return Yap_thread_attach_engine(wid);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadDetachEngine(int wid)
|
||||
{
|
||||
#if USE_THREADS
|
||||
return Yap_thread_detach_engine(wid);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_ThreadDestroyEngine(int wid)
|
||||
{
|
||||
#if USE_THREADS
|
||||
return Yap_thread_destroy_engine(wid);
|
||||
#else
|
||||
return FALSE;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
25
C/cdmgr.c
25
C/cdmgr.c
@ -11,8 +11,15 @@
|
||||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2004-06-29 19:04:41 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.125 2004/06/29 19:04:41 vsc
|
||||
* fix multithreaded version
|
||||
* include new version of Ricardo's profiler
|
||||
* new predicat atomic_concat
|
||||
* allow multithreaded-debugging
|
||||
* small fixes
|
||||
*
|
||||
* Revision 1.124 2004/06/05 03:36:59 vsc
|
||||
* coroutining is now a part of attvars.
|
||||
* some more fixes.
|
||||
@ -3254,15 +3261,27 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
||||
|
||||
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||
if (first_time) {
|
||||
if (!Yap_gc(4, YENV, P)) {
|
||||
ARG5 = th;
|
||||
ARG6 = tb;
|
||||
ARG7 = tr;
|
||||
if (!Yap_gc(7, YENV, P)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FALSE;
|
||||
}
|
||||
th = ARG5;
|
||||
tb = ARG6;
|
||||
tr = ARG7;
|
||||
} else {
|
||||
if (!Yap_gc(5, ENV, CP)) {
|
||||
ARG6 = th;
|
||||
ARG7 = tb;
|
||||
ARG8 = tr;
|
||||
if (!Yap_gc(8, ENV, CP)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
return FALSE;
|
||||
}
|
||||
th = ARG6;
|
||||
tb = ARG7;
|
||||
tr = ARG8;
|
||||
}
|
||||
}
|
||||
return(Yap_unify(th, ArgOfTerm(1,t)) &&
|
||||
|
||||
2
C/exec.c
2
C/exec.c
@ -211,7 +211,7 @@ EnterCreepMode(Term t, Term mod) {
|
||||
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
|
||||
ARG1 = t;
|
||||
if (!Yap_growheap(FALSE, 0, NULL)) {
|
||||
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at meta-call");
|
||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call");
|
||||
}
|
||||
if (!ActiveSignals) {
|
||||
return do_execute(ARG1, mod);
|
||||
|
||||
135
C/grow.c
135
C/grow.c
@ -730,12 +730,87 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static int
|
||||
growatomtable(void)
|
||||
{
|
||||
AtomHashEntry *ntb;
|
||||
UInt nsize = 4*AtomHashTableSize-1, i;
|
||||
UInt start_growth_time = Yap_cputime(), growth_time;
|
||||
int gc_verbose = Yap_is_gc_verbose();
|
||||
|
||||
LOCK(SignalLock);
|
||||
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
|
||||
CreepFlag = CalculateStackGap();
|
||||
}
|
||||
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
|
||||
UNLOCK(SignalLock);
|
||||
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
|
||||
/* leave for next time */
|
||||
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))
|
||||
return FALSE;
|
||||
}
|
||||
atom_table_overflows++;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% Atom Table overflow %d\n", atom_table_overflows);
|
||||
fprintf(Yap_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize));
|
||||
}
|
||||
YAPEnterCriticalSection();
|
||||
for (i = 0; i < nsize; ++i) {
|
||||
INIT_RWLOCK(ntb[i].AERWLock);
|
||||
ntb[i].Entry = NIL;
|
||||
}
|
||||
for (i = 0; i < AtomHashTableSize; i++) {
|
||||
Atom catom;
|
||||
|
||||
READ_LOCK(HashChain[i].AERWLock);
|
||||
catom = HashChain[i].Entry;
|
||||
while (catom != NIL) {
|
||||
AtomEntry *ap = RepAtom(catom);
|
||||
Atom natom;
|
||||
CELL hash;
|
||||
|
||||
hash = HashFunction(ap->StrOfAE) % nsize;
|
||||
natom = ap->NextOfAE;
|
||||
ap->NextOfAE = ntb[hash].Entry;
|
||||
ntb[hash].Entry = catom;
|
||||
catom = natom;
|
||||
}
|
||||
READ_UNLOCK(HashChain[i].AERWLock);
|
||||
}
|
||||
Yap_FreeCodeSpace((char *)HashChain);
|
||||
HashChain = ntb;
|
||||
AtomHashTableSize = nsize;
|
||||
YAPLeaveCriticalSection();
|
||||
growth_time = Yap_cputime()-start_growth_time;
|
||||
total_atom_table_overflow_time += growth_time;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000);
|
||||
fprintf(Yap_stderr, "%% Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000);
|
||||
}
|
||||
if (HeapTop + sizeof(YAP_SEG_SIZE) < HeapLim) {
|
||||
/* make sure there is no heap overflow */
|
||||
int res;
|
||||
YAPEnterCriticalSection();
|
||||
res = do_growheap(FALSE, 0, NULL);
|
||||
YAPLeaveCriticalSection();
|
||||
return res;
|
||||
} else {
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
Yap_growheap(int fix_code, UInt in_size, void *cip)
|
||||
{
|
||||
int res;
|
||||
|
||||
Yap_PrologMode |= GrowHeapMode;
|
||||
if (NOfAtoms > 2*AtomHashTableSize) {
|
||||
res = growatomtable();
|
||||
Yap_PrologMode &= ~GrowHeapMode;
|
||||
return res;
|
||||
}
|
||||
res=do_growheap(fix_code, in_size, (struct intermediates *)cip);
|
||||
Yap_PrologMode &= ~GrowHeapMode;
|
||||
return res;
|
||||
@ -1065,66 +1140,6 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
Yap_growatomtable(void)
|
||||
{
|
||||
AtomHashEntry *ntb;
|
||||
UInt nsize = 4*AtomHashTableSize-1, i;
|
||||
UInt start_growth_time = Yap_cputime(), growth_time;
|
||||
int gc_verbose = Yap_is_gc_verbose();
|
||||
|
||||
LOCK(SignalLock);
|
||||
if (ActiveSignals == YAP_CDOVF_SIGNAL) {
|
||||
CreepFlag = CalculateStackGap();
|
||||
}
|
||||
ActiveSignals &= ~YAP_CDOVF_SIGNAL;
|
||||
UNLOCK(SignalLock);
|
||||
while ((ntb = (AtomHashEntry *)Yap_AllocCodeSpace(nsize*sizeof(AtomHashEntry))) == NULL) {
|
||||
/* leave for next time */
|
||||
if (!do_growheap(FALSE, nsize*sizeof(AtomHashEntry), NULL))
|
||||
return;
|
||||
}
|
||||
atom_table_overflows++;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% Atom Table overflow %d\n", atom_table_overflows);
|
||||
fprintf(Yap_stderr, "%% growing the atom table to %ld entries\n", (long int)(nsize));
|
||||
}
|
||||
YAPEnterCriticalSection();
|
||||
for (i = 0; i < nsize; ++i) {
|
||||
INIT_RWLOCK(ntb[i].AERWLock);
|
||||
ntb[i].Entry = NIL;
|
||||
}
|
||||
for (i = 0; i < AtomHashTableSize; i++) {
|
||||
Atom catom;
|
||||
|
||||
READ_LOCK(HashChain[i].AERWLock);
|
||||
catom = HashChain[i].Entry;
|
||||
while (catom != NIL) {
|
||||
AtomEntry *ap = RepAtom(catom);
|
||||
Atom natom;
|
||||
CELL hash;
|
||||
|
||||
hash = HashFunction(ap->StrOfAE) % nsize;
|
||||
natom = ap->NextOfAE;
|
||||
ap->NextOfAE = ntb[hash].Entry;
|
||||
ntb[hash].Entry = catom;
|
||||
catom = natom;
|
||||
}
|
||||
READ_UNLOCK(HashChain[i].AERWLock);
|
||||
}
|
||||
Yap_FreeCodeSpace((char *)HashChain);
|
||||
HashChain = ntb;
|
||||
AtomHashTableSize = nsize;
|
||||
YAPLeaveCriticalSection();
|
||||
growth_time = Yap_cputime()-start_growth_time;
|
||||
total_atom_table_overflow_time += growth_time;
|
||||
if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% took %g sec\n", (double)growth_time/1000);
|
||||
fprintf(Yap_stderr, "%% Total of %g sec expanding atom table \n", (double)total_atom_table_overflow_time/1000);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_inform_trail_overflows(void)
|
||||
{
|
||||
|
||||
28
C/iopreds.c
28
C/iopreds.c
@ -3729,7 +3729,10 @@ format_has_tabs(const char *seq)
|
||||
while ((ch = *seq++)) {
|
||||
if (ch == '~') {
|
||||
ch = *seq++;
|
||||
if (ch == 't') {
|
||||
if (ch == '*') {
|
||||
ch = *seq++;
|
||||
}
|
||||
if (ch == 't' || ch == '|') {
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
@ -3797,19 +3800,20 @@ format(Term tail, Term args, int sno)
|
||||
tnum = 0;
|
||||
targs = mytargs;
|
||||
}
|
||||
format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
|
||||
format_max = format_base+FORMAT_MAX_SIZE;
|
||||
if (format_ptr == NULL) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
|
||||
return(FALSE);
|
||||
}
|
||||
format_buf_size = FORMAT_MAX_SIZE;
|
||||
format_error = FALSE;
|
||||
|
||||
if ((has_tabs = format_has_tabs(fptr))) {
|
||||
format_base = format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
|
||||
format_max = format_base+FORMAT_MAX_SIZE;
|
||||
if (format_ptr == NULL) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
|
||||
return(FALSE);
|
||||
}
|
||||
format_buf_size = FORMAT_MAX_SIZE;
|
||||
f_putc = format_putc;
|
||||
} else {
|
||||
f_putc = Stream[sno].stream_putc;
|
||||
format_base = NULL;
|
||||
}
|
||||
while ((ch = *fptr++)) {
|
||||
Term t = TermNil;
|
||||
@ -4179,7 +4183,7 @@ format(Term tail, Term args, int sno)
|
||||
|
||||
static Int
|
||||
p_format(void)
|
||||
{ /* '$format'(Control,Args) */
|
||||
{ /* 'format'(Control,Args) */
|
||||
Int res;
|
||||
LOCK(BGL);
|
||||
res = format(Deref(ARG1),Deref(ARG2), Yap_c_output_stream);
|
||||
@ -4190,7 +4194,7 @@ p_format(void)
|
||||
|
||||
static Int
|
||||
p_format2(void)
|
||||
{ /* '$format'(Stream,Control,Args) */
|
||||
{ /* 'format'(Stream,Control,Args) */
|
||||
int old_c_stream = Yap_c_output_stream;
|
||||
Int out;
|
||||
|
||||
@ -4789,8 +4793,8 @@ Yap_InitIOPreds(void)
|
||||
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$write", 2, p_write, SyncPredFlag);
|
||||
Yap_InitCPred ("$write", 3, p_write2, SyncPredFlag);
|
||||
Yap_InitCPred ("$format", 2, p_format, SyncPredFlag);
|
||||
Yap_InitCPred ("$format", 3, p_format2, SyncPredFlag);
|
||||
Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
|
||||
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
|
||||
Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$line_position", 2, p_line_position, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$character_count", 2, p_character_count, SafePredFlag|SyncPredFlag);
|
||||
|
||||
179
C/threads.c
179
C/threads.c
@ -30,6 +30,8 @@ static char SccsId[] = "%W% %G%";
|
||||
|
||||
#if THREADS
|
||||
|
||||
#include "threads.h"
|
||||
|
||||
/*
|
||||
* This file includes the definition of threads in Yap. Threads
|
||||
* are supposed to be compatible with the SWI-Prolog thread package.
|
||||
@ -70,10 +72,30 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
kill_thread_engine (int wid)
|
||||
{
|
||||
Prop p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
|
||||
/* kill all thread local preds */
|
||||
while(p0) {
|
||||
PredEntry *ap = RepPredProp(p0);
|
||||
p0 = ap->NextOfPE;
|
||||
Yap_Abolish(ap);
|
||||
Yap_FreeCodeSpace((char *)ap);
|
||||
}
|
||||
Yap_KillStacks(wid);
|
||||
heap_regs->wl[wid].active_signals = 0L;
|
||||
free(heap_regs->wl[wid].scratchpad.ptr);
|
||||
free(ThreadHandle[wid].default_yaam_regs);
|
||||
free(ThreadHandle[wid].start_of_timesp);
|
||||
free(ThreadHandle[wid].last_timep);
|
||||
ThreadHandle[wid].in_use = FALSE;
|
||||
pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
|
||||
}
|
||||
|
||||
static void
|
||||
thread_die(int wid, int always_die)
|
||||
{
|
||||
Prop p0;
|
||||
|
||||
LOCK(ThreadHandlesLock);
|
||||
if (!always_die) {
|
||||
@ -81,50 +103,49 @@ thread_die(int wid, int always_die)
|
||||
ThreadsTotalTime += Yap_cputime();
|
||||
}
|
||||
if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue) ||
|
||||
always_die) {
|
||||
p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
|
||||
/* kill all thread local preds */
|
||||
while(p0) {
|
||||
PredEntry *ap = RepPredProp(p0);
|
||||
p0 = ap->NextOfPE;
|
||||
Yap_Abolish(ap);
|
||||
Yap_FreeCodeSpace((char *)ap);
|
||||
}
|
||||
Yap_KillStacks(wid);
|
||||
heap_regs->wl[wid].active_signals = 0L;
|
||||
heap_regs->wl[wid].active_signals = 0L;
|
||||
free(heap_regs->wl[wid].scratchpad.ptr);
|
||||
free(ThreadHandle[wid].default_yaam_regs);
|
||||
free(ThreadHandle[wid].start_of_timesp);
|
||||
free(ThreadHandle[wid].last_timep);
|
||||
ThreadHandle[wid].in_use = FALSE;
|
||||
pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
|
||||
}
|
||||
always_die)
|
||||
kill_thread_engine(wid);
|
||||
UNLOCK(ThreadHandlesLock);
|
||||
}
|
||||
|
||||
static void
|
||||
setup_engine(int myworker_id)
|
||||
{
|
||||
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
|
||||
int oldworker_id = worker_id;
|
||||
|
||||
/* create the YAAM descriptor */
|
||||
ThreadHandle[myworker_id].default_yaam_regs = standard_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (void *)standard_regs);
|
||||
Yap_InitExStacks(ThreadHandle[myworker_id].ssize, ThreadHandle[myworker_id].tsize);
|
||||
CurrentModule = ThreadHandle[myworker_id].cmod;
|
||||
worker_id = myworker_id;
|
||||
Yap_InitTime();
|
||||
Yap_InitYaamRegs();
|
||||
worker_id = oldworker_id;
|
||||
{
|
||||
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
|
||||
}
|
||||
/* I exist */
|
||||
NOfThreadsCreated++;
|
||||
}
|
||||
|
||||
static void
|
||||
start_thread(int myworker_id)
|
||||
{
|
||||
setup_engine(myworker_id);
|
||||
worker_id = myworker_id;
|
||||
}
|
||||
|
||||
static void *
|
||||
thread_run(void *widp)
|
||||
{
|
||||
Term tgoal;
|
||||
Term tgs[2];
|
||||
int out;
|
||||
REGSTORE *standard_regs = (REGSTORE *)malloc(sizeof(REGSTORE));
|
||||
int myworker_id = *((int *)widp);
|
||||
|
||||
/* create the YAAM descriptor */
|
||||
ThreadHandle[myworker_id].default_yaam_regs = standard_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (void *)standard_regs);
|
||||
worker_id = myworker_id;
|
||||
/* I exist */
|
||||
NOfThreadsCreated++;
|
||||
Yap_InitExStacks(ThreadHandle[myworker_id].ssize, ThreadHandle[myworker_id].tsize);
|
||||
CurrentModule = ThreadHandle[myworker_id].cmod;
|
||||
Yap_InitTime();
|
||||
Yap_InitYaamRegs();
|
||||
{
|
||||
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
|
||||
}
|
||||
|
||||
start_thread(myworker_id);
|
||||
tgs[0] = Yap_FetchTermFromDB(ThreadHandle[worker_id].tgoal);
|
||||
tgs[1] = ThreadHandle[worker_id].tdetach;
|
||||
tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
|
||||
@ -139,6 +160,13 @@ p_thread_new_tid(void)
|
||||
return Yap_unify(MkIntegerTerm(allocate_new_tid()), ARG1);
|
||||
}
|
||||
|
||||
static void
|
||||
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
|
||||
{
|
||||
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
|
||||
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
|
||||
}
|
||||
|
||||
static Int
|
||||
p_create_thread(void)
|
||||
{
|
||||
@ -153,33 +181,9 @@ p_create_thread(void)
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
init_thread_engine(new_worker_id, ssize, tsize, tgoal, tdetach);
|
||||
ThreadHandle[new_worker_id].id = new_worker_id;
|
||||
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
|
||||
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
|
||||
if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
|
||||
return TRUE;
|
||||
}
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
static Int
|
||||
Yap_new_thread(void)
|
||||
{
|
||||
UInt ssize = IntegerOfTerm(Deref(ARG2));
|
||||
UInt tsize = IntegerOfTerm(Deref(ARG3));
|
||||
/* UInt systemsize = IntegerOfTerm(Deref(ARG4)); */
|
||||
Term tgoal = Deref(ARG1);
|
||||
Term tdetach = Deref(ARG5);
|
||||
int new_worker_id = IntegerOfTerm(Deref(ARG6));
|
||||
|
||||
if (new_worker_id == -1) {
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
ThreadHandle[new_worker_id].id = new_worker_id;
|
||||
store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
|
||||
pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
|
||||
ThreadHandle[new_worker_id].ref_count = 1;
|
||||
if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
|
||||
return TRUE;
|
||||
}
|
||||
@ -194,11 +198,62 @@ p_thread_self(void)
|
||||
}
|
||||
|
||||
int
|
||||
Yap_self(void)
|
||||
Yap_thread_self(void)
|
||||
{
|
||||
return worker_id;
|
||||
}
|
||||
|
||||
int
|
||||
Yap_thread_create_engine(thread_attr *ops)
|
||||
{
|
||||
int new_id = allocate_new_tid();
|
||||
if (new_id == -1) {
|
||||
/* YAP ERROR */
|
||||
return FALSE;
|
||||
}
|
||||
init_thread_engine(new_id, ops->ssize, ops->tsize, TermNil, TermNil);
|
||||
ThreadHandle[new_id].id = new_id;
|
||||
ThreadHandle[new_id].handle = pthread_self();
|
||||
ThreadHandle[new_id].ref_count = 0;
|
||||
setup_engine(new_id);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
int
|
||||
Yap_thread_attach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
ThreadHandle[wid].handle = pthread_self();
|
||||
ThreadHandle[wid].ref_count++;
|
||||
worker_id = wid;
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
int
|
||||
Yap_thread_detach_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
ThreadHandle[wid].handle = 0;
|
||||
ThreadHandle[wid].ref_count--;
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
int
|
||||
Yap_thread_destroy_engine(int wid)
|
||||
{
|
||||
pthread_mutex_lock(&(ThreadHandle[wid].tlock));
|
||||
if (ThreadHandle[wid].ref_count == 0) {
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
kill_thread_engine(wid);
|
||||
return TRUE;
|
||||
} else {
|
||||
pthread_mutex_unlock(&(ThreadHandle[wid].tlock));
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_join(void)
|
||||
{
|
||||
|
||||
@ -1,16 +1,11 @@
|
||||
|
||||
|
||||
:- module(clpbn, [{}/1,
|
||||
clpbn_findall/3,
|
||||
clpbn_setof/3]).
|
||||
:- module(clpbn, [{}/1).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(terms)).
|
||||
|
||||
:- op(1200, xfx, '<--').
|
||||
:- op(1200, fx, '<--').
|
||||
:- op( 500, xfx, '=>').
|
||||
:- op( 500, xfy, with).
|
||||
|
||||
%
|
||||
@ -40,15 +35,13 @@
|
||||
execute_pre_evidence/0
|
||||
]).
|
||||
|
||||
:- include('clpbn/aggs').
|
||||
|
||||
use(vel).
|
||||
|
||||
{Var = Key with Dist} :-
|
||||
% key_entry(Key,Indx),
|
||||
% array_element(clpbn,Indx,El),
|
||||
% attributes:put_att(El,3,indx(Indx)),
|
||||
clpbn:put_atts(El,[key(Key),dist(E=>Domain)]),
|
||||
put_atts(El,[key(Key),dist(E=>Domain)]),
|
||||
extract_dist(Dist, E, Domain),
|
||||
add_evidence(Var,El).
|
||||
|
||||
@ -257,25 +250,6 @@ starter_vars([Var|Vs]) :-
|
||||
starter_vars(Vs).
|
||||
|
||||
|
||||
/* attribute_goal(Var, Goal) :-
|
||||
get_atts(Var, [key(_)]),
|
||||
get_bnode(Var, Goal).
|
||||
|
||||
get_value(clpbn_key, Max),
|
||||
Max1 is Max-1,
|
||||
run_through_array(0, Max1, Goal).
|
||||
|
||||
|
||||
run_through_array(Max,Max,Goal) :- !,
|
||||
array_element(clpbn, Max, V),
|
||||
get_bnode(V, Goal).
|
||||
run_through_array(I,Max,(G,Goal)) :- !,
|
||||
array_element(clpbn, I, V),
|
||||
get_bnode(V, G),
|
||||
I1 is I+1,
|
||||
run_through_array(I1,Max,Goal).
|
||||
*/
|
||||
|
||||
get_bnode(Var, Goal) :-
|
||||
get_atts(Var, [key(Key),dist(X)]),
|
||||
dist_goal(X, Key, Goal0),
|
||||
|
||||
3
H/Heap.h
3
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.63 2004-07-15 15:47:08 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.64 2004-07-22 21:32:21 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -76,6 +76,7 @@ typedef struct thandle {
|
||||
REGSTORE *current_yaam_regs;
|
||||
struct pred_entry *local_preds;
|
||||
pthread_t handle;
|
||||
int ref_count;
|
||||
pthread_mutex_t tlock;
|
||||
#if HAVE_GETRUSAGE
|
||||
struct timeval *start_of_timesp;
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.52 2004-06-05 03:37:00 vsc Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.53 2004-07-22 21:32:21 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -162,7 +162,6 @@ int STD_PROTO(Yap_growheap, (int, UInt, void *));
|
||||
int STD_PROTO(Yap_growstack, (long));
|
||||
int STD_PROTO(Yap_growtrail, (long));
|
||||
int STD_PROTO(Yap_growglobal, (CELL **));
|
||||
void STD_PROTO(Yap_growatomtable, (void));
|
||||
CELL **STD_PROTO(Yap_shift_visit, (CELL **, CELL ***));
|
||||
|
||||
/* heapgc.c */
|
||||
|
||||
@ -695,7 +695,7 @@ Macros to check the limits of stacks
|
||||
(GLOB) > H_FZ && (GLOB) < (CELL *)B_FZ) goto Label
|
||||
#else
|
||||
#define check_stack(Label, GLOB) \
|
||||
if ( (Int)(Unsigned(E_YREG) - CFREG) < (Int)(GLOB) ) goto Label
|
||||
if ( (Int)(Unsigned(E_YREG) - Unsigned(GLOB)) < CFREG ) goto Label
|
||||
#endif /* SBA && YAPOR */
|
||||
|
||||
/***************************************************************
|
||||
|
||||
@ -339,9 +339,15 @@ extern X_API void *PROTO(YAP_Predicate,(YAP_Atom,unsigned long int,int));
|
||||
/* int YAP_Predicate() */
|
||||
extern X_API void PROTO(YAP_PredicateInfo,(void *,YAP_Atom *,unsigned long int*,int*));
|
||||
|
||||
/* int YAP_Predicate() */
|
||||
/* int YAP_CurrentModule() */
|
||||
extern X_API int PROTO(YAP_CurrentModule,(void));
|
||||
|
||||
extern X_API int PROTO(YAP_ThreadSelf,(void));
|
||||
extern X_API int PROTO(YAP_ThreadCreateEngine,(YAP_thread_attr *));
|
||||
extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
|
||||
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
|
||||
|
||||
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
|
||||
|
||||
__END_DECLS
|
||||
|
||||
@ -96,3 +96,11 @@ typedef struct {
|
||||
char **Argv;
|
||||
} YAP_init_args;
|
||||
|
||||
|
||||
/* from thread.h */
|
||||
typedef struct {
|
||||
unsigned long int ssize;
|
||||
unsigned long int tsize;
|
||||
int (*cancel)(int);
|
||||
} YAP_thread_attr;
|
||||
|
||||
|
||||
@ -1083,6 +1083,17 @@ X_API void PL_register_extensions(PL_extension *ptr)
|
||||
}
|
||||
}
|
||||
|
||||
X_API int PL_thread_self(void)
|
||||
{
|
||||
return YAP_ThreadSelf();
|
||||
}
|
||||
|
||||
X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
|
||||
{
|
||||
/* YAP_thread_attr yap; */
|
||||
return YAP_ThreadSelf();
|
||||
}
|
||||
|
||||
/* note: fprintf may be called from anywhere, so please don't try
|
||||
to be smart and allocate stack from somewhere else */
|
||||
X_API int Sprintf(char *format,...)
|
||||
|
||||
@ -39,6 +39,17 @@ typedef struct _PL_extension
|
||||
short flags; /* Or of PL_FA_... */
|
||||
} PL_extension;
|
||||
|
||||
typedef struct
|
||||
{ unsigned long local_size; /* Stack sizes */
|
||||
unsigned long global_size;
|
||||
unsigned long trail_size;
|
||||
unsigned long argument_size;
|
||||
char * alias; /* alias name */
|
||||
int (*cancel)(int id); /* cancel function */
|
||||
void * reserved[5]; /* reserved for extensions */
|
||||
} PL_thread_attr_t;
|
||||
|
||||
|
||||
#define PL_FA_NOTRACE (0x01) /* foreign cannot be traced */
|
||||
#define PL_FA_TRANSPARENT (0x02) /* foreign is module transparent */
|
||||
#define PL_FA_NONDETERMINISTIC (0x04) /* foreign is non-deterministic */
|
||||
@ -181,6 +192,8 @@ extern X_API term_t PL_exception(qid_t);
|
||||
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
|
||||
extern X_API int PL_call(term_t, module_t);
|
||||
extern X_API void PL_register_extensions(PL_extension *);
|
||||
extern X_API int PL_thread_self(void);
|
||||
extern X_API int PL_thread_attach_engine(const PL_thread_attr_t *);
|
||||
|
||||
|
||||
extern X_API int Sprintf(char *,...);
|
||||
|
||||
@ -84,3 +84,8 @@ YAP_UserCPredicate
|
||||
YAP_UserBackCPredicate
|
||||
YAP_UserCPredicateWithArgs
|
||||
YAP_CurrentModule
|
||||
YAP_ThreadSelf
|
||||
YAP_ThreadCreateEngine
|
||||
YAP_ThreadAttachEngine
|
||||
YAP_ThreadDetachEngine
|
||||
YAP_ThreadDestroyEngine
|
||||
|
||||
44
pl/boot.yap
44
pl/boot.yap
@ -34,7 +34,7 @@ true :- true.
|
||||
( Module=user ->
|
||||
'$compile_mode'(_,0)
|
||||
;
|
||||
'$format'(user_error,'[~w]~n', [Module])
|
||||
format(user_error,'[~w]~n', [Module])
|
||||
),
|
||||
'$system_catch'('$enter_top_level',Module,Error,user:'$Error'(Error)).
|
||||
|
||||
@ -125,10 +125,10 @@ read_sig.
|
||||
fail.
|
||||
'$enter_top_level' :-
|
||||
( recorded('$trace',on,_) ->
|
||||
'$format'(user_error, '% trace~n', [])
|
||||
format(user_error, '% trace~n', [])
|
||||
;
|
||||
recorded('$debug', on, _) ->
|
||||
'$format'(user_error, '% debug~n', [])
|
||||
format(user_error, '% debug~n', [])
|
||||
),
|
||||
fail.
|
||||
'$enter_top_level' :-
|
||||
@ -292,7 +292,7 @@ repeat :- '$repeat'.
|
||||
% but YAP and SICStus does.
|
||||
%
|
||||
'$process_directive'(G, _, M) :-
|
||||
( '$do_yes_no'(G,M) -> true ; '$format'(user_error,':- ~w:~w failed.~n',[M,G]) ).
|
||||
( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
|
||||
|
||||
'$all_directives'(_:G1) :- !,
|
||||
'$all_directives'(G1).
|
||||
@ -440,7 +440,7 @@ repeat :- '$repeat'.
|
||||
'$extract_goal_vars_for_dump'(VL,LIV).
|
||||
|
||||
'$write_query_answer_true'([]) :- !,
|
||||
'$format'(user_error,'~ntrue',[]).
|
||||
format(user_error,'~ntrue',[]).
|
||||
'$write_query_answer_true'(_).
|
||||
|
||||
'$show_frozen'(_,_,[]) :-
|
||||
@ -461,16 +461,16 @@ repeat :- '$repeat'.
|
||||
fail.
|
||||
'$present_answer'((?-), Answ) :-
|
||||
get_value('$break',BL),
|
||||
( BL \= 0 -> '$format'(user_error, '[~p] ',[BL]) ;
|
||||
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
|
||||
true ),
|
||||
( recorded('$print_options','$toplevel'(Opts),_) ->
|
||||
write_term(user_error,Answ,Opts) ;
|
||||
'$format'(user_error,'~w',[Answ])
|
||||
format(user_error,'~w',[Answ])
|
||||
),
|
||||
'$format'(user_error,'~n', []).
|
||||
format(user_error,'~n', []).
|
||||
|
||||
'$another' :-
|
||||
'$format'(user_error,' ? ',[]),
|
||||
format(user_error,' ? ',[]),
|
||||
'$get0'(user_input,C),
|
||||
( C== 0'; -> '$skip'(user_input,10),
|
||||
'$add_nl_outside_console',
|
||||
@ -478,7 +478,7 @@ repeat :- '$repeat'.
|
||||
;
|
||||
C== 10 -> '$add_nl_outside_console',
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
'$format'(user_error,'yes~n', [])
|
||||
format(user_error,'yes~n', [])
|
||||
;
|
||||
print_message(help,yes)
|
||||
)
|
||||
@ -491,10 +491,10 @@ repeat :- '$repeat'.
|
||||
'$add_nl_outside_console' :-
|
||||
'$is_same_tty'(user_input, user_error), !.
|
||||
'$add_nl_outside_console' :-
|
||||
'$format'(user_error,'~n',[]).
|
||||
format(user_error,'~n',[]).
|
||||
|
||||
'$ask_again_for_another' :-
|
||||
'$format'(user_error,'Action (\";\" for more choices, <return> for exit)', []),
|
||||
format(user_error,'Action (\";\" for more choices, <return> for exit)', []),
|
||||
'$another'.
|
||||
|
||||
'$write_answer'(_,_,_) :-
|
||||
@ -551,25 +551,25 @@ repeat :- '$repeat'.
|
||||
|
||||
'$write_remaining_vars_and_goals'([]).
|
||||
'$write_remaining_vars_and_goals'([G1|LG]) :-
|
||||
'$format'(user_error,',~n',[]),
|
||||
format(user_error,',~n',[]),
|
||||
'$write_goal_output'(G1),
|
||||
'$write_remaining_vars_and_goals'(LG).
|
||||
|
||||
'$write_goal_output'(var([V|VL])) :-
|
||||
'$format'(user_error,'~s',[V]),
|
||||
format(user_error,'~s',[V]),
|
||||
'$write_output_vars'(VL).
|
||||
'$write_goal_output'(nonvar([V|VL],B)) :-
|
||||
'$format'(user_error,'~s',[V]),
|
||||
format(user_error,'~s',[V]),
|
||||
'$write_output_vars'(VL),
|
||||
'$format'(user_error,' = ', []),
|
||||
format(user_error,' = ', []),
|
||||
( recorded('$print_options','$toplevel'(Opts),_) ->
|
||||
write_term(user_error,B,Opts) ;
|
||||
'$format'(user_error,'~w',[B])
|
||||
format(user_error,'~w',[B])
|
||||
).
|
||||
'$write_goal_output'(_-G) :-
|
||||
( recorded('$print_options','$toplevel'(Opts),_) ->
|
||||
write_term(user_error,G,Opts) ;
|
||||
'$format'(user_error,'~w',[G])
|
||||
format(user_error,'~w',[G])
|
||||
).
|
||||
|
||||
'$name_vars_in_goals'(G, VL0, NG) :-
|
||||
@ -597,7 +597,7 @@ repeat :- '$repeat'.
|
||||
|
||||
'$write_output_vars'([]).
|
||||
'$write_output_vars'([V|VL]) :-
|
||||
'$format'(user_error,' = ~s',[V]),
|
||||
format(user_error,' = ~s',[V]),
|
||||
'$write_output_vars'(VL).
|
||||
|
||||
call(G) :- '$execute'(G).
|
||||
@ -806,7 +806,7 @@ break :- get_value('$break',BL), NBL is BL+1,
|
||||
get_value(spy_leap,_Leap),
|
||||
set_value('$break',NBL),
|
||||
current_output(OutStream), current_input(InpStream),
|
||||
'$format'(user_error, '% Break (level ~w)~n', [NBL]),
|
||||
format(user_error, '% Break (level ~w)~n', [NBL]),
|
||||
'$do_live',
|
||||
!,
|
||||
set_value('$live','$true'),
|
||||
@ -865,7 +865,7 @@ break :- get_value('$break',BL), NBL is BL+1,
|
||||
recorda('$initialisation','$',_),
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( get_value('$verbose',on) ->
|
||||
'$format'(user_error, '~*|% consulting ~w...~n', [LC,F])
|
||||
format(user_error, '~*|% consulting ~w...~n', [LC,F])
|
||||
; true )
|
||||
;
|
||||
'$print_message'(informational, loading(consulting, File))
|
||||
@ -881,7 +881,7 @@ break :- get_value('$break',BL), NBL is BL+1,
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( get_value('$verbose',on) ->
|
||||
'$format'(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
|
||||
format(user_error, '~*|% ~w consulted ~w bytes in ~d msecs~n', [LC,F,H,T])
|
||||
;
|
||||
true
|
||||
)
|
||||
|
||||
36
pl/debug.yap
36
pl/debug.yap
@ -417,9 +417,9 @@ debugging :-
|
||||
( recorded('$debug',on, R), erase(R), fail ; true),
|
||||
( Module\=prolog,
|
||||
Module\=user ->
|
||||
'$format'(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
|
||||
format(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
|
||||
;
|
||||
'$format'(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
|
||||
format(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
|
||||
),
|
||||
'$debugger_write'(user_error,G),
|
||||
( nonvar(R0), recordaifnot('$debug',on,_), fail ; true),
|
||||
@ -558,32 +558,28 @@ debugging :-
|
||||
fail.
|
||||
|
||||
% if we are in the interpreter, don't need to care about forcing a trace, do we?
|
||||
'$continue_debugging'(_) :-
|
||||
recorded('$trace',on, _),
|
||||
fail.
|
||||
'$continue_debugging'(no) :- !.
|
||||
'$continue_debugging'(_) :-
|
||||
'$access_yap_flags'(10,1), !,
|
||||
'$creep'.
|
||||
'$continue_debugging'(_) :-
|
||||
recorded('$spy_stop', _, _).
|
||||
'$continue_debugging'(_).
|
||||
|
||||
'$stop_debugging' :-
|
||||
'$stop_creep'.
|
||||
|
||||
'$action_help' :-
|
||||
'$format'(user_error,"newline creep a abort~n", []),
|
||||
'$format'(user_error,"c creep e exit~n", []),
|
||||
'$format'(user_error,"f Goal fail h help~n", []),
|
||||
'$format'(user_error,"l leap r Goal retry~n", []),
|
||||
'$format'(user_error,"s skip t fastskip~n", []),
|
||||
'$format'(user_error,"q quasiskip k quasileap~n", []),
|
||||
'$format'(user_error,"b break n no debug~n", []),
|
||||
'$format'(user_error,"p print d display~n", []),
|
||||
'$format'(user_error,"<D depth D < full term~n", []),
|
||||
'$format'(user_error,"+ spy this - nospy this~n", []),
|
||||
'$format'(user_error,"^ view subg ^^ view using~n", []),
|
||||
'$format'(user_error,"! g execute goal~n", []).
|
||||
format(user_error,"newline creep a abort~n", []),
|
||||
format(user_error,"c creep e exit~n", []),
|
||||
format(user_error,"f Goal fail h help~n", []),
|
||||
format(user_error,"l leap r Goal retry~n", []),
|
||||
format(user_error,"s skip t fastskip~n", []),
|
||||
format(user_error,"q quasiskip k quasileap~n", []),
|
||||
format(user_error,"b break n no debug~n", []),
|
||||
format(user_error,"p print d display~n", []),
|
||||
format(user_error,"<D depth D < full term~n", []),
|
||||
format(user_error,"+ spy this - nospy this~n", []),
|
||||
format(user_error,"^ view subg ^^ view using~n", []),
|
||||
format(user_error,"! g execute goal~n", []).
|
||||
|
||||
'$ilgl'(C) :-
|
||||
'$print_message'(warning, trace_command(C)),
|
||||
@ -619,7 +615,7 @@ debugging :-
|
||||
'$get_sterm_list'(L), !,
|
||||
'$deb_get_sterm_in_g'(L,G,A),
|
||||
recorda('$debug_sub_skel',L,_),
|
||||
'$format'(user_error,"~n~w~n~n",[A]).
|
||||
format(user_error,"~n~w~n~n",[A]).
|
||||
'$print_deb_sterm'(_) :- '$skipeol'(94).
|
||||
|
||||
'$get_sterm_list'(L) :-
|
||||
|
||||
335
pl/errors.yap
335
pl/errors.yap
@ -11,8 +11,15 @@
|
||||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2004-06-23 17:24:20 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2004-07-22 21:32:22 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.53 2004/06/23 17:24:20 vsc
|
||||
* New comment-based message style
|
||||
* Fix thread support (at least don't deadlock with oneself)
|
||||
* small fixes for coroutining predicates
|
||||
* force Yap to recover space in arrays of dbrefs
|
||||
* use private predicates in debugger.
|
||||
*
|
||||
* Revision 1.52 2004/06/18 15:41:19 vsc
|
||||
* fix extraneous line in yes/no messages
|
||||
*
|
||||
@ -65,7 +72,7 @@ print_message(Level, Mss) :-
|
||||
user:portray_message(Severity, Msg), !.
|
||||
'$print_message'(error,error(Msg,Info)) :-
|
||||
( var(Msg) ; var(Info) ), !,
|
||||
'$format'(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
|
||||
format(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
|
||||
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
|
||||
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
|
||||
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
|
||||
@ -76,94 +83,94 @@ print_message(Level, Mss) :-
|
||||
'$print_message'(error,error(Type,Where)) :-
|
||||
'$output_error_message'(Type, Where), !.
|
||||
'$print_message'(error,Throw) :-
|
||||
'$format'(user_error,'% YAP: no handler for error ~w~n', [Throw]).
|
||||
format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
|
||||
'$print_message'(informational,M) :-
|
||||
( get_value('$verbose',on) ->
|
||||
'$do_informational_message'(M) ;
|
||||
true
|
||||
).
|
||||
'$print_message'(warning,M) :-
|
||||
'$format'(user_error, '% ', []),
|
||||
format(user_error, '% ', []),
|
||||
'$do_print_message'(M),
|
||||
'$format'(user_error, '~n', []).
|
||||
format(user_error, '~n', []).
|
||||
'$print_message'(help,M) :-
|
||||
'$do_print_message'(M),
|
||||
'$format'(user_error, '~n', []).
|
||||
format(user_error, '~n', []).
|
||||
|
||||
|
||||
'$do_informational_message'(halt) :- !,
|
||||
'$format'(user_error, '% YAP execution halted~n', []).
|
||||
format(user_error, '% YAP execution halted~n', []).
|
||||
'$do_informational_message'(abort(_)) :- !,
|
||||
'$format'(user_error, '% YAP execution aborted~n', []).
|
||||
format(user_error, '% YAP execution aborted~n', []).
|
||||
'$do_informational_message'(loading(_,user)) :- !.
|
||||
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
|
||||
'$show_consult_level'(LC),
|
||||
'$format'(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
|
||||
format(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
|
||||
'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
|
||||
'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
|
||||
'$show_consult_level'(LC0),
|
||||
LC is LC0+1,
|
||||
'$format'(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
|
||||
format(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
|
||||
'$do_informational_message'(M) :-
|
||||
'$format'(user_error,'% ', []),
|
||||
format(user_error,'% ', []),
|
||||
'$do_print_message'(M),
|
||||
'$format'(user_error,'~n', []).
|
||||
format(user_error,'~n', []).
|
||||
|
||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
|
||||
'$do_print_message'('$format'(Msg, Args)) :- !,
|
||||
'$format'(user_error,Msg,Args).
|
||||
'$do_print_message'(format(Msg, Args)) :- !,
|
||||
format(user_error,Msg,Args).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
|
||||
'$format'(user_error,'There is already a spy point on ~w:~w/~w.',
|
||||
format(user_error,'There is already a spy point on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !,
|
||||
'$format'(user_error,'Spy point set on ~w:~w/~w.',
|
||||
format(user_error,'Spy point set on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !,
|
||||
'$format'(user_error,'Spy point on ~w:~w/~w removed.',
|
||||
format(user_error,'Spy point on ~w:~w/~w removed.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(no,breakpoint_for,M:F/N)) :- !,
|
||||
'$format'(user_error,'There is no spy point on ~w:~w/~w.',
|
||||
format(user_error,'There is no spy point on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakpoints([])) :- !,
|
||||
'$format'(user_error,'There are no spy-points set.',
|
||||
format(user_error,'There are no spy-points set.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakpoints(L)) :- !,
|
||||
'$format'(user_error,'Spy-points set on:', []),
|
||||
format(user_error,'Spy-points set on:', []),
|
||||
'$print_list_of_preds'(L).
|
||||
'$do_print_message'(debug(debug)) :- !,
|
||||
'$format'(user_error,'Debug mode on.',[]).
|
||||
format(user_error,'Debug mode on.',[]).
|
||||
'$do_print_message'(debug(off)) :- !,
|
||||
'$format'(user_error,'Debug mode off.',[]).
|
||||
format(user_error,'Debug mode off.',[]).
|
||||
'$do_print_message'(debug(trace)) :- !,
|
||||
'$format'(user_error,'Trace mode on.',[]).
|
||||
format(user_error,'Trace mode on.',[]).
|
||||
'$do_print_message'(import(Pred,To,From,private)) :- !,
|
||||
'$format'(user_error,'Importing private predicate ~w:~w to ~w.',
|
||||
format(user_error,'Importing private predicate ~w:~w to ~w.',
|
||||
[From,Pred,To]).
|
||||
'$do_print_message'(leash([])) :- !,
|
||||
'$format'(user_error,'No leashing.',
|
||||
format(user_error,'No leashing.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(leash([A|B])) :- !,
|
||||
'$format'(user_error,'Leashing set to ~w.',
|
||||
format(user_error,'Leashing set to ~w.',
|
||||
[[A|B]]).
|
||||
'$do_print_message'(no) :- !,
|
||||
'$format'(user_error, 'no', []).
|
||||
format(user_error, 'no', []).
|
||||
'$do_print_message'(no_match(P)) :- !,
|
||||
'$format'(user_error,'No matching predicate for ~w.',
|
||||
format(user_error,'No matching predicate for ~w.',
|
||||
[P]).
|
||||
'$do_print_message'(trace_command(C)) :- !,
|
||||
'$format'(user_error,'Invalid trace command: ~c', [C]).
|
||||
format(user_error,'Invalid trace command: ~c', [C]).
|
||||
'$do_print_message'(trace_help) :- !,
|
||||
'$format'(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
format(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
'$do_print_message'(version(Version)) :- !,
|
||||
'$format'(user_error,'YAP version ~a', [Version]).
|
||||
format(user_error,'YAP version ~a', [Version]).
|
||||
'$do_print_message'(yes) :- !,
|
||||
'$format'(user_error, 'yes', []).
|
||||
format(user_error, 'yes', []).
|
||||
'$do_print_message'(Messg) :-
|
||||
'$format'(user_error,'~q',Messg).
|
||||
format(user_error,'~q',Messg).
|
||||
|
||||
'$print_list_of_preds'([]).
|
||||
'$print_list_of_preds'([P|L]) :-
|
||||
'$format'(user_error,'~n ~w',[P]),
|
||||
format(user_error,'~n ~w',[P]),
|
||||
'$print_list_of_preds'(L).
|
||||
|
||||
'$do_stack_dump'(Envs, CPs) :-
|
||||
@ -266,20 +273,20 @@ print_message(Level, Mss) :-
|
||||
|
||||
'$say_stack_dump'([], []) :- !.
|
||||
'$say_stack_dump'(_, _) :-
|
||||
'$format'(user_error,'% Stack dump for error:', []).
|
||||
format(user_error,'% Stack dump for error:', []).
|
||||
|
||||
'$close_stack_dump'([], []) :- !.
|
||||
'$close_stack_dump'(_, _) :-
|
||||
'$format'(user_error,'~n', []).
|
||||
format(user_error,'~n', []).
|
||||
|
||||
'$show_cps'([]) :- !.
|
||||
'$show_cps'(List) :-
|
||||
'$format'(user_error,'% ~n choice-points (goals with alternatives left):',[]),
|
||||
format(user_error,'% ~n choice-points (goals with alternatives left):',[]),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$show_envs'([]) :- !.
|
||||
'$show_envs'(List) :-
|
||||
'$format'(user_error,'% ~n environments (partially executed clauses):',[]),
|
||||
format(user_error,'% ~n environments (partially executed clauses):',[]),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
|
||||
@ -289,16 +296,16 @@ print_message(Level, Mss) :-
|
||||
|
||||
'$print_stack'([]).
|
||||
'$print_stack'([overflow]) :- !,
|
||||
'$format'(user_error,'~n% ...',[]).
|
||||
format(user_error,'~n% ...',[]).
|
||||
'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
|
||||
'$show_goal'(Clause,Name,Arity,Mod),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$show_goal'(-1,Name,Arity,Mod) :- !,
|
||||
'$format'('~n% ~a:~a/~d at indexing code',[Mod,Name,Arity]).
|
||||
format('~n% ~a:~a/~d at indexing code',[Mod,Name,Arity]).
|
||||
'$show_goal'(0,Name,Arity,Mod) :- !.
|
||||
'$show_goal'(I,Name,Arity,Mod) :-
|
||||
'$format'(user_error,'~n% ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
|
||||
format(user_error,'~n% ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
|
||||
|
||||
'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
|
||||
number_codes(Arity,ArityCode),
|
||||
@ -313,350 +320,350 @@ print_message(Level, Mss) :-
|
||||
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
|
||||
|
||||
'$output_error_message'(consistency_error(Who),Where) :-
|
||||
'$format'(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
|
||||
format(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
|
||||
[Who,Where]).
|
||||
'$output_error_message'(context_error(Goal,Who),Where) :-
|
||||
'$format'(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
|
||||
format(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
|
||||
[Goal,Who,Where]).
|
||||
'$output_error_message'(domain_error(array_overflow,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(array_type,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(builtin_procedure,P), P) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- non-iso built-in procedure ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- non-iso built-in procedure ~w~n',
|
||||
[P]).
|
||||
'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
|
||||
[Where,Op]).
|
||||
'$output_error_message'(domain_error(out_of_range,Value), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
|
||||
[Where,Value]).
|
||||
'$output_error_message'(domain_error(close_option,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(radix,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(flag_value,F+V), W) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
|
||||
[W,V,F]).
|
||||
'$output_error_message'(domain_error(io_mode,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(mutable,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(module_decl_options,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_empty_list,_), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
|
||||
[Where]).
|
||||
'$output_error_message'(domain_error(not_less_than_zero,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_newline,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_zero,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(operator_priority,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(operator_specifier,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(predicate_spec,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid predicate specifier~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid predicate specifier~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(read_option,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(semantics_indicator,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(domain_error(source_sink,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(stream,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_or_alias,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_option,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_position,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_property,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(syntax_error_handler,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
|
||||
[Where,Option, Opts]).
|
||||
'$output_error_message'(domain_error(time_out_spec,What), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(write_option,N), Where) :-
|
||||
'$format'(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(existence_error(array,F), W) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(mutex,F), W) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(queue,F), W) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(procedure,P), _) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
|
||||
format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
|
||||
[P]).
|
||||
'$output_error_message'(existence_error(source_sink,F), W) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(stream,Stream), Where) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
|
||||
format(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(evaluation_error(int_overflow), Where) :-
|
||||
'$format'(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
|
||||
format(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(float_overflow), Where) :-
|
||||
'$format'(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
|
||||
format(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(undefined), Where) :-
|
||||
'$format'(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
|
||||
format(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(underflow), Where) :-
|
||||
'$format'(user_error,'% UNDERFLOW ERROR- ~w~n',
|
||||
format(user_error,'% UNDERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(float_underflow), Where) :-
|
||||
'$format'(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
|
||||
format(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(zero_divisor), Where) :-
|
||||
'$format'(user_error,'% ZERO DIVISOR ERROR- ~w~n',
|
||||
format(user_error,'% ZERO DIVISOR ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(instantiation_error, Where) :-
|
||||
'$format'(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
|
||||
format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_heap_error, Where) :-
|
||||
'$format'(user_error,'% OUT OF HEAP SPACE ERROR- ~w~n',
|
||||
format(user_error,'% OUT OF HEAP SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_stack_error, Where) :-
|
||||
'$format'(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
|
||||
format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_trail_error, Where) :-
|
||||
'$format'(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
|
||||
format(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(access,static_procedure,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(alias,new,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,array,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,mutex,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,queue,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create queue ~a~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create queue ~a~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,operator,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,text_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,flag,W), _) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
|
||||
[W]).
|
||||
'$output_error_message'(permission_error(modify,operator,W), _) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
|
||||
format(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
|
||||
[W]).
|
||||
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
|
||||
format(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
|
||||
[Who,Mod]).
|
||||
'$output_error_message'(permission_error(open,source_sink,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,text_stream,Stream), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(resize,array,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
|
||||
'$format'(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(representation_error(character), Where) :-
|
||||
'$format'(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
|
||||
[Where]).
|
||||
'$output_error_message'(representation_error(character_code), Where) :-
|
||||
'$format'(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
|
||||
[Where]).
|
||||
'$output_error_message'(representation_error(max_arity), Where) :-
|
||||
'$format'(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
|
||||
[Where]).
|
||||
'$output_error_message'(syntax_error(G,0,Msg,[],0,0), Where) :- !,
|
||||
'$format'(user_error,'% SYNTAX ERROR in ~w: ~a~n',[G,Msg]).
|
||||
format(user_error,'% SYNTAX ERROR in ~w: ~a~n',[G,Msg]).
|
||||
'$output_error_message'(syntax_error(_,Position,_,Term,Pos,Start), Where) :-
|
||||
'$format'(user_error,'% ~w ',[Where]),
|
||||
format(user_error,'% ~w ',[Where]),
|
||||
'$dump_syntax_error_line'(Start,Position),
|
||||
'$dump_syntax_error_term'(10,Pos, Term),
|
||||
'$format'(user_error,'.~n]~n',[]).
|
||||
format(user_error,'.~n]~n',[]).
|
||||
'$output_error_message'(system_error, Where) :-
|
||||
'$format'(user_error,'% SYSTEM ERROR- ~w~n',
|
||||
format(user_error,'% SYSTEM ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(system_error(Message), Where) :-
|
||||
'$format'(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
|
||||
format(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
|
||||
[Message,Where]).
|
||||
'$output_error_message'(type_error(T,_,Err,M), _Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
|
||||
[T,Err,M]).
|
||||
'$output_error_message'(type_error(array,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(atom,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(atomic,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(byte,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(callable,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(char,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(character,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(character_code,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(compound,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(db_reference,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(db_term,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(evaluable,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(float,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_byte,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_character,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_character_code,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(integer,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(key,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(leash_mode,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(list,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(number,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(pointer,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(predicate_indicator,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(unsigned_byte,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(unsigned_char,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(variable,W), Where) :-
|
||||
'$format'(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(unknown, Where) :-
|
||||
'$format'(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
|
||||
format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
|
||||
[Where]).
|
||||
|
||||
|
||||
'$dump_syntax_error_line'(Pos,_) :-
|
||||
'$format'(user_error,'at line ~d:~n',
|
||||
format(user_error,'at line ~d:~n',
|
||||
[Pos]).
|
||||
|
||||
'$dump_syntax_error_term'(0,J,L) :- !,
|
||||
'$format'(user_error,'~n', []),
|
||||
format(user_error,'~n', []),
|
||||
'$dump_syntax_error_term'(10,J,L).
|
||||
'$dump_syntax_error_term'(_,0,L) :- !,
|
||||
'$format'(user_error,'~n<==== HERE ====>~n', []),
|
||||
format(user_error,'~n<==== HERE ====>~n', []),
|
||||
'$dump_syntax_error_term'(10,-1,L).
|
||||
'$dump_syntax_error_term'(_,_,[]) :- !.
|
||||
'$dump_syntax_error_term'(I,J,[T-P|R]) :-
|
||||
@ -666,19 +673,19 @@ print_message(Level, Mss) :-
|
||||
'$dump_syntax_error_term'(I1,J1,R).
|
||||
|
||||
'$dump_error_token'(atom(A)) :- !,
|
||||
'$format'(user_error,' ~a', [A]).
|
||||
format(user_error,' ~a', [A]).
|
||||
'$dump_error_token'(number(N)) :- !,
|
||||
'$format'(user_error,' ~w', [N]).
|
||||
format(user_error,' ~w', [N]).
|
||||
'$dump_error_token'(var(_,S,_)) :- !,
|
||||
'$format'(user_error,' ~s ', [S]).
|
||||
format(user_error,' ~s ', [S]).
|
||||
'$dump_error_token'(string(S)) :- !,
|
||||
'$format'(user_error,' ""~s""', [S]).
|
||||
format(user_error,' ""~s""', [S]).
|
||||
'$dump_error_token'('(') :- !,
|
||||
'$format'(user_error,"(", []).
|
||||
format(user_error,"(", []).
|
||||
'$dump_error_token'(')') :- !,
|
||||
'$format'(user_error," )", []).
|
||||
format(user_error," )", []).
|
||||
'$dump_error_token'(',') :- !,
|
||||
'$format'(user_error," ,", []).
|
||||
format(user_error," ,", []).
|
||||
'$dump_error_token'(A) :-
|
||||
'$format'(user_error," ~a", [A]).
|
||||
format(user_error," ~a", [A]).
|
||||
|
||||
|
||||
@ -77,17 +77,17 @@ portray_clause(_).
|
||||
'$portray_clause'(Stream, (Pred :- true)) :- !,
|
||||
'$beautify_vars'(Pred),
|
||||
writeq(Stream, Pred),
|
||||
'$format'(Stream, ".~n", []).
|
||||
format(Stream, ".~n", []).
|
||||
'$portray_clause'(Stream, (Pred:-Body)) :- !,
|
||||
'$beautify_vars'((Pred:-Body)),
|
||||
writeq(Stream, Pred),
|
||||
'$format'(Stream, " :-", []),
|
||||
format(Stream, " :-", []),
|
||||
'$write_body'(Body, 3, ',', Stream),
|
||||
'$format'(Stream, ".~n", []).
|
||||
format(Stream, ".~n", []).
|
||||
'$portray_clause'(Stream, Pred) :- !,
|
||||
'$beautify_vars'(Pred),
|
||||
writeq(Stream, Pred),
|
||||
'$format'(Stream, ".~n", []).
|
||||
format(Stream, ".~n", []).
|
||||
|
||||
'$write_body'(X,I,T,Stream) :- var(X), !,
|
||||
'$beforelit'(T,I,Stream),
|
||||
@ -99,40 +99,40 @@ portray_clause(_).
|
||||
'$write_body'(Q,I,',',Stream).
|
||||
'$write_body'((P->Q;S),I,_, Stream) :-
|
||||
!,
|
||||
'$format'(Stream, "~n~*c(",[I,0' ]),
|
||||
format(Stream, "~n~*c(",[I,0' ]),
|
||||
I1 is I+2,
|
||||
'$write_body'(P,I1,'(',Stream),
|
||||
'$format'(Stream, " ->",[]),
|
||||
format(Stream, " ->",[]),
|
||||
'$write_disj'((Q;S),I,I1,'->',Stream),
|
||||
'$format'(Stream, "~n~*c)",[I,0' ]).
|
||||
format(Stream, "~n~*c)",[I,0' ]).
|
||||
'$write_body'((P->Q|S),I,_,Stream) :-
|
||||
!,
|
||||
'$format'(Stream, "~n~*c(",[I,0' ]),
|
||||
format(Stream, "~n~*c(",[I,0' ]),
|
||||
I1 is I+2,
|
||||
'$write_body'(P,I,'(',Stream),
|
||||
'$format'(Stream, " ->",[]),
|
||||
format(Stream, " ->",[]),
|
||||
'$write_disj'((Q|S),I,I1,'->',Stream),
|
||||
'$format'(Stream, "~n~*c)",[I,0' ]).
|
||||
format(Stream, "~n~*c)",[I,0' ]).
|
||||
'$write_body'((P->Q),I,_,Stream) :-
|
||||
!,
|
||||
'$format'(Stream, "~n~*c(",[I,0' ]),
|
||||
format(Stream, "~n~*c(",[I,0' ]),
|
||||
I1 is I+2,
|
||||
'$write_body'(P,I1,'(',Stream),
|
||||
'$format'(Stream, " ->",[]),
|
||||
format(Stream, " ->",[]),
|
||||
'$write_body'(Q,I1,'->',Stream),
|
||||
'$format'(Stream, "~n~*c)",[I,0' ]).
|
||||
format(Stream, "~n~*c)",[I,0' ]).
|
||||
'$write_body'((P;Q),I,_,Stream) :-
|
||||
!,
|
||||
'$format'(Stream, "~n~*c(",[I,0' ]),
|
||||
format(Stream, "~n~*c(",[I,0' ]),
|
||||
I1 is I+2,
|
||||
'$write_disj'((P;Q),I,I1,'->',Stream),
|
||||
'$format'(Stream, "~n~*c)",[I,0' ]).
|
||||
format(Stream, "~n~*c)",[I,0' ]).
|
||||
'$write_body'((P|Q),I,_,Stream) :-
|
||||
!,
|
||||
'$format'(Stream, "~n~*c(",[I,0' ]),
|
||||
format(Stream, "~n~*c(",[I,0' ]),
|
||||
I1 is I+2,
|
||||
'$write_disj'((P|Q),I,I1,'->',Stream),
|
||||
'$format'(Stream, "~n~*c)",[I,0' ]).
|
||||
format(Stream, "~n~*c)",[I,0' ]).
|
||||
'$write_body'(X,I,T,Stream) :-
|
||||
'$beforelit'(T,I,Stream),
|
||||
writeq(Stream,X).
|
||||
@ -140,18 +140,18 @@ portray_clause(_).
|
||||
|
||||
'$write_disj'((Q;S),I0,I,C,Stream) :- !,
|
||||
'$write_body'(Q,I,C,Stream),
|
||||
'$format'(Stream, "~n~*c;",[I0,0' ]),
|
||||
format(Stream, "~n~*c;",[I0,0' ]),
|
||||
'$write_disj'(S,I0,I,';',Stream).
|
||||
'$write_disj'((Q|S),I0,I,C,Stream) :- !,
|
||||
'$write_body'(Q,I,C,Stream),
|
||||
'$format'(Stream, "~n~*c|",[I0,0' ]),
|
||||
format(Stream, "~n~*c|",[I0,0' ]),
|
||||
'$write_disj'(S,I0,I,'|',Stream).
|
||||
'$write_disj'(S,I0,I,C,Stream) :-
|
||||
'$write_body'(S,I,C,Stream).
|
||||
|
||||
|
||||
'$beforelit'('(',_,Stream) :- !, '$format'(Stream," ",[]).
|
||||
'$beforelit'(_,I,Stream) :- '$format'(Stream,"~n~*c",[I,0' ]).
|
||||
'$beforelit'('(',_,Stream) :- !, format(Stream," ",[]).
|
||||
'$beforelit'(_,I,Stream) :- format(Stream,"~n~*c",[I,0' ]).
|
||||
|
||||
'$beautify_vars'(T) :-
|
||||
'$list_get_vars'(T,[],L),
|
||||
|
||||
@ -196,7 +196,7 @@ module(N) :-
|
||||
recorda('$module','$module'(F,Mod,Exports),_).
|
||||
'$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :-
|
||||
repeat,
|
||||
'$format'(user_error, "The module ~a is being redefined.~n Old file: ~a~n New file: ~a~nDo you really want to redefine it? (y or n)",[Mod,F0,F]),
|
||||
format(user_error, "The module ~a is being redefined.~n Old file: ~a~n New file: ~a~nDo you really want to redefine it? (y or n)",[Mod,F0,F]),
|
||||
'$mod_scan'(C), !,
|
||||
( C is "y" ->
|
||||
'$add_preexisting_module_on_file'(F, F, Mod, Exports, R)
|
||||
@ -227,8 +227,8 @@ module(N) :-
|
||||
|
||||
'$check_import'(M,T,N,K) :-
|
||||
recorded('$import','$import'(M1,T,N,K),R), M1 \= M, /* ZP */ !,
|
||||
'$format'(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[M1:N/K,T]),
|
||||
'$format'(user_error," Do you want to import it from ~w ? [y or n] ",M),
|
||||
format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[M1:N/K,T]),
|
||||
format(user_error," Do you want to import it from ~w ? [y or n] ",M),
|
||||
repeat,
|
||||
get0(C), '$skipeol'(C),
|
||||
( C is "y" -> erase(R), !;
|
||||
@ -249,7 +249,7 @@ module(N) :-
|
||||
print_message(warning,import(N/K,Mod,M,private))
|
||||
),
|
||||
( '$check_import'(M,Mod,N,K) ->
|
||||
% '$format'(user_error,'[ Importing ~w to ~w]~n',[M:N/K,Mod]),
|
||||
% format(user_error,'[ Importing ~w to ~w]~n',[M:N/K,Mod]),
|
||||
% '$trace_module'(importing(M:N/K,Mod)),
|
||||
(Mod = user ->
|
||||
( recordzifnot('$import','$import'(M,user,N,K),_) -> true ; true )
|
||||
@ -486,7 +486,7 @@ module(N) :-
|
||||
'$meta_predicate'(F,Mod,N,D), !,
|
||||
functor(G1,F,N),
|
||||
'$meta_expansion_loop'(N,D,G,G1,HVars,MP).
|
||||
% '$format'(user_error," gives ~w~n]",[G1]).
|
||||
% format(user_error," gives ~w~n]",[G1]).
|
||||
|
||||
% expand argument
|
||||
'$meta_expansion_loop'(0,_,_,_,_,_) :- !.
|
||||
|
||||
@ -37,42 +37,42 @@ statistics :-
|
||||
|
||||
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
|
||||
TotalMemory is HpSpa+StkSpa+TrlSpa,
|
||||
'$format'(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
|
||||
'$format'(user_error," program space~t~d bytes~35+", [HpSpa]),
|
||||
'$format'(user_error,":~t ~d in use~19+", [HpInUse]),
|
||||
format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
|
||||
format(user_error," program space~t~d bytes~35+", [HpSpa]),
|
||||
format(user_error,":~t ~d in use~19+", [HpInUse]),
|
||||
HpFree is HpSpa-HpInUse,
|
||||
'$format'(user_error,",~t ~d free~19+~n", [HpFree]),
|
||||
'$format'(user_error,"~t ~d max~73+~n", [HpMax]),
|
||||
'$format'(user_error," stack space~t~d bytes~35+", [StkSpa]),
|
||||
format(user_error,",~t ~d free~19+~n", [HpFree]),
|
||||
format(user_error,"~t ~d max~73+~n", [HpMax]),
|
||||
format(user_error," stack space~t~d bytes~35+", [StkSpa]),
|
||||
StackInUse is GlobInU+LocInU,
|
||||
'$format'(user_error,":~t ~d in use~19+", [StackInUse]),
|
||||
format(user_error,":~t ~d in use~19+", [StackInUse]),
|
||||
StackFree is StkSpa-StackInUse,
|
||||
'$format'(user_error,",~t ~d free~19+~n", [StackFree]),
|
||||
'$format'(user_error," global stack:~t~35+", []),
|
||||
'$format'(user_error," ~t ~d in use~19+", [GlobInU]),
|
||||
'$format'(user_error,",~t ~d max~19+~n", [GlobMax]),
|
||||
'$format'(user_error," local stack:~t~35+", []),
|
||||
'$format'(user_error," ~t ~d in use~19+", [LocInU]),
|
||||
'$format'(user_error,",~t ~d max~19+~n", [LocMax]),
|
||||
'$format'(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
|
||||
'$format'(user_error,":~t ~d in use~19+", [TrlInUse]),
|
||||
format(user_error,",~t ~d free~19+~n", [StackFree]),
|
||||
format(user_error," global stack:~t~35+", []),
|
||||
format(user_error," ~t ~d in use~19+", [GlobInU]),
|
||||
format(user_error,",~t ~d max~19+~n", [GlobMax]),
|
||||
format(user_error," local stack:~t~35+", []),
|
||||
format(user_error," ~t ~d in use~19+", [LocInU]),
|
||||
format(user_error,",~t ~d max~19+~n", [LocMax]),
|
||||
format(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
|
||||
format(user_error,":~t ~d in use~19+", [TrlInUse]),
|
||||
TrlFree is TrlSpa-TrlInUse,
|
||||
'$format'(user_error,",~t ~d free~19+~n", [TrlFree]),
|
||||
format(user_error,",~t ~d free~19+~n", [TrlFree]),
|
||||
OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000,
|
||||
'$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
|
||||
format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
|
||||
[OvfTime,NOfHO,NOfSO,NOfTO]),
|
||||
TotGCTimeF is float(TotGCTime)/1000,
|
||||
'$format'(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
|
||||
format(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
|
||||
[TotGCTimeF,NOfGC,TotGCSize]),
|
||||
TotAGCTimeF is float(TotAGCTime)/1000,
|
||||
'$format'(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
|
||||
format(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
|
||||
[TotAGCTimeF,NOfAGC,TotAGCSize]),
|
||||
RTime is float(Runtime)/1000,
|
||||
'$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
|
||||
format(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
|
||||
CPUTime is float(CPUtime)/1000,
|
||||
'$format'(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
|
||||
format(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
|
||||
WallTime is float(Walltime)/1000,
|
||||
'$format'(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
|
||||
format(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
|
||||
fail.
|
||||
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
|
||||
|
||||
|
||||
@ -505,12 +505,6 @@ print(Stream,T) :-
|
||||
print(_,_).
|
||||
|
||||
|
||||
format(N,A) :- atom(N), !, atom_codes(N, S), '$format'(S,A).
|
||||
format(F,A) :- '$format'(F,A).
|
||||
|
||||
format(Stream, N, A) :- atom(N), !, atom_codes(N, S), '$format'(Stream, S ,A).
|
||||
format(Stream, S, A) :- '$format'(Stream, S, A).
|
||||
|
||||
/* interface to user portray */
|
||||
'$portray'(T) :-
|
||||
\+ '$undefined'(portray(_),user),
|
||||
|
||||
Reference in New Issue
Block a user