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

Merge /home/vsc/yap

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-10-31 13:57:37 +00:00
commit 52bb6a92f1
18 changed files with 2248 additions and 1859 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
C/errors.c
View File

@ -81,6 +81,7 @@ static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
set_key_b(parserReadingCode, "parserReadingcode", q, i, t); set_key_b(parserReadingCode, "parserReadingcode", q, i, t);
set_key_b(prologConsulting, "prologConsulting", q, i, t); set_key_b(prologConsulting, "prologConsulting", q, i, t);
set_key_s(culprit, "culprit", q, i, t); set_key_s(culprit, "culprit", q, i, t);
set_key_s(prologStack, "prologStack", q, i, t);
set_key_s(errorMsg, "errorMsg", q, i, t); set_key_s(errorMsg, "errorMsg", q, i, t);
set_key_i(errorMsgLen, "errorMsgLen", q, i, t); set_key_i(errorMsgLen, "errorMsgLen", q, i, t);
return false; return false;
@ -129,7 +130,8 @@ static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_s(parserFile, "parserFile", q, i); query_key_s(parserFile, "parserFile", q, i);
query_key_b(parserReadingCode, "parserReadingCode", q, i); query_key_b(parserReadingCode, "parserReadingCode", q, i);
query_key_b(prologConsulting, "prologConsulting", q, i); query_key_b(prologConsulting, "prologConsulting", q, i);
query_key_t(culprit, "culprit", q, i); query_key_s(prologStack, "prologStack", q, i);
query_key_s(culprit, "culprit", q, i);
query_key_s(errorMsg, "errorMsg", q, i); query_key_s(errorMsg, "errorMsg", q, i);
query_key_i(errorMsgLen, "errorMsgLen", q, i); query_key_i(errorMsgLen, "errorMsgLen", q, i);
return TermNil; return TermNil;
@ -176,6 +178,7 @@ static void printErr(yap_error_descriptor_t *i) {
print_key_b("parserReadingCode", i->parserReadingCode); print_key_b("parserReadingCode", i->parserReadingCode);
print_key_b("prologConsulting", i->prologConsulting); print_key_b("prologConsulting", i->prologConsulting);
print_key_s("culprit", i->culprit); print_key_s("culprit", i->culprit);
print_key_s("prologStack", i->prologStack);
if (i->errorMsgLen) { if (i->errorMsgLen) {
print_key_s("errorMsg", i->errorMsg); print_key_s("errorMsg", i->errorMsg);
print_key_i("errorMsgLen", i->errorMsgLen); print_key_i("errorMsgLen", i->errorMsgLen);
@ -234,6 +237,7 @@ static Term err2list(yap_error_descriptor_t *i) {
o = add_key_b("parserReadingCode", i->parserReadingCode, o); o = add_key_b("parserReadingCode", i->parserReadingCode, o);
o = add_key_b("prologConsulting", i->prologConsulting, o); o = add_key_b("prologConsulting", i->prologConsulting, o);
o = add_key_s("culprit", i->culprit, o); o = add_key_s("culprit", i->culprit, o);
o = add_key_s("prologStack", i->prologStack, o);
if (i->errorMsgLen) { if (i->errorMsgLen) {
o = add_key_s("errorMsg", i->errorMsg, o); o = add_key_s("errorMsg", i->errorMsg, o);
o = add_key_i("errorMsgLen", i->errorMsgLen, o); o = add_key_i("errorMsgLen", i->errorMsgLen, o);
@ -858,7 +862,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
#ifdef DEBUG #ifdef DEBUG
// DumpActiveGoals( USES_REGS1 ); // DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */ #endif /* DEBUG */
if (LOCAL_ActiveError->errorNo!= SYNTAX_ERROR)
LOCAL_ActiveError->prologStack=Yap_dump_stack();
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
#if DEBUG #if DEBUG
// DumpActiveGoals( PASS_REGS1 ); // DumpActiveGoals( PASS_REGS1 );
@ -1045,7 +1050,6 @@ static Int query_exception(USES_REGS1) {
if (!IsAddressTerm(Deref(ARG2))) if (!IsAddressTerm(Deref(ARG2)))
return false; return false;
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2)); yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
Term t3 = Deref(ARG3);
//if (IsVarTerm(t3)) { //if (IsVarTerm(t3)) {
Term rc = queryErr(query, y); Term rc = queryErr(query, y);
// Yap_DebugPlWriteln(rc); // Yap_DebugPlWriteln(rc);
@ -1262,7 +1266,7 @@ static Int is_predicate_indicator(USES_REGS1) {
void Yap_InitErrorPreds(void) { void Yap_InitErrorPreds(void) {
CACHE_REGS CACHE_REGS
Yap_InitCPred("$print_exception<", 1, print_exception, 0); Yap_InitCPred("$print_exception", 1, print_exception, 0);
Yap_InitCPred("$reset_exception", 1, reset_exception, 0); Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0); Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0); Yap_InitCPred("$get_exception", 1, get_exception, 0);

8
C/gprof.c
View File

@ -728,20 +728,18 @@ return GLOBAL_DIRNAME;
char *profile_names(int); char *profile_names(int);
char *profile_names(int k) { char *profile_names(int k) {
static char *FNAME=NULL; char *FNAME=NULL;
int size=200; int size=200;
if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL); if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL);
size=strlen(GLOBAL_DIRNAME)+40; size=strlen(GLOBAL_DIRNAME)+40;
if (FNAME!=NULL) free(FNAME);
FNAME=malloc(size); FNAME=malloc(size);
if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); } if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
strcpy(FNAME,GLOBAL_DIRNAME);
if (k==PROFILING_FILE) { if (k==PROFILING_FILE) {
sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid()); sprintf(FNAME,"%s/PROFILING_%d",GLOBAL_DIRNAME,getpid());
} else { } else {
sprintf(FNAME,"%s/PROFPREDS_%d",FNAME,getpid()); sprintf(FNAME,"%s/PROFPREDS_%d",GLOBAL_DIRNAME,getpid());
} }
// printf("%s\n",FNAME); // printf("%s\n",FNAME);

15
C/scanner.c
View File

@ -1340,7 +1340,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
enum TokenKinds kind; enum TokenKinds kind;
int solo_flag = TRUE; int solo_flag = TRUE;
int32_t ch, och; int32_t ch, och = ' ';
struct qq_struct_t *cur_qq = NULL; struct qq_struct_t *cur_qq = NULL;
int sign = 1; int sign = 1;
@ -1423,12 +1423,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case UC: case UC:
case UL: case UL:
case LC: { case LC:
int32_t och = ch; och = ch;
ch = getchr(st); ch = getchr(st);
size_t sz = 512;
TokImage = Malloc(sz PASS_REGS);
scan_name: scan_name:
{
size_t sz = 1024;
TokImage = Malloc(sz PASS_REGS);
charp = (unsigned char *)TokImage; charp = (unsigned char *)TokImage;
isvar = (chtype(och) != LC); isvar = (chtype(och) != LC);
add_ch_to_buff(och); add_ch_to_buff(och);
@ -1514,8 +1515,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
case 'e': case 'e':
case 'E': case 'E':
och = cherr; och = cherr;
TokImage = Malloc(1024 PASS_REGS); goto scan_name;
goto scan_name;
break; break;
case '=': case '=':
case '_': case '_':
@ -1981,6 +1981,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
return l; return l;
default: { default: {
kind = Error_tok;
char err[1024]; char err[1024];
snprintf(err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n", snprintf(err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n",
ch, ch, chtype(ch)); ch, ch, chtype(ch));

201
C/stack.c
View File

@ -105,6 +105,8 @@ restart:
return NULL; return NULL;
} }
extern char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) { static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
while (TRUE) { while (TRUE) {
op_numbers opnum; op_numbers opnum;
@ -656,7 +658,7 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
PELOCK(40, pp); PELOCK(40, pp);
/* check if the codeptr comes from the indexing code */ /* check if the codeptr comes from the indexing code */
if (pp->PredFlags & IndexedPredFlag && pp->OpcodeOfPred != INDEX_OPCODE) { if (pp->PredFlags & IndexedPredFlag && pp->OpcodeOfPred != INDEX_OPCODE) {
if (pp->PredFlags & LogUpdatePredFlag) { if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index( if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
@ -885,7 +887,7 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
if (codeptr >= COMMA_CODE && codeptr < FAILCODE) { if (codeptr >= COMMA_CODE && codeptr < FAILCODE) {
pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma, CurrentModule)); pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma, CurrentModule));
*startp = (CODEADDR)COMMA_CODE; *startp = (CODEADDR)COMMA_CODE;
*endp = (CODEADDR)(FAILCODE - 1); *endp = (CODEADDR)(FAILCODE);
return pp; return pp;
} }
pc = codeptr; pc = codeptr;
@ -1702,8 +1704,6 @@ parent_pred(USES_REGS1) {
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity)); Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
} }
void Yap_dump_stack(void);
void DumpActiveGoals(CACHE_TYPE1); void DumpActiveGoals(CACHE_TYPE1);
static int hidden(Atom); static int hidden(Atom);
@ -1767,173 +1767,191 @@ static bool handled_exception(USES_REGS1) {
return !found_handler; return !found_handler;
} }
void Yap_dump_stack(void) { #define ADDBUF( CMD ) { \
while (true) { \
size_t sz = CMD; \
if (sz < lbufsz-256) { \
lbuf += sz; \
lbufsz -= sz; \
break; \
} \
char *nbuf = Realloc(buf, bufsize += 1024); \
lbuf = nbuf + (lbuf-buf); \
buf = nbuf; \
lbufsz += 1024; \
} \
}
const char *Yap_dump_stack(void) {
CACHE_REGS CACHE_REGS
choiceptr b_ptr = B; choiceptr b_ptr = B;
CELL *env_ptr = ENV; CELL *env_ptr = ENV;
char tp[256]; char *tp;
yamop *ipc = CP; yamop *ipc = CP;
int max_count = 200; int max_count = 200;
int lvl = push_text_stack();
char *buf = Malloc(4096), *lbuf = buf;
size_t bufsize = 4096, lbufsz = bufsize-256;
/* check if handled */ /* check if handled */
//if (handled_exception(PASS_REGS1)) // if (handled_exception(PASS_REGS1))
// return; // return;
#if DEBUG #if DEBUG
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n", ADDBUF(snprintf(lbuf, lbufsz ,
P, CP, ASP, HR, TR, HeapTop); "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p~n", P,
#endif CP, ASP, HR, TR, HeapTop));
fprintf(stderr, "%% \n%% =====================================\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% =====================================~n%%~n"));
fprintf(stderr, "%% \n%% YAP Status:\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Status:~n"));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
yap_error_number errnbr = LOCAL_Error_TYPE; yap_error_number errnbr = LOCAL_Error_TYPE;
yap_error_class_number classno = Yap_errorClass(errnbr); yap_error_class_number classno = Yap_errorClass(errnbr);
fprintf(stderr, "%% Error STATUS: %s/%s\n\n", Yap_errorName(errnbr), ADDBUF(snprintf(lbuf, lbufsz , "%% Error STATUS: %s/%s~n~n", Yap_errorName(errnbr),
Yap_errorClassName(classno)); Yap_errorClassName(classno)));
fprintf(stderr, "%% Execution mode\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Execution mode~n"));
if (LOCAL_PrologMode & BootMode) if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "%% Bootstrap\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Bootstrap~n"));
if (LOCAL_PrologMode & UserMode) if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "%% User Prolo\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolo~n"));
if (LOCAL_PrologMode & CritMode) if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "%% Exclusive Access Mode\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Exclusive Access Mode~n"));
if (LOCAL_PrologMode & AbortMode) if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "%% Abort\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Abort~n"));
if (LOCAL_PrologMode & InterruptMode) if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "%% Interrupt\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Interrupt~n"));
if (LOCAL_PrologMode & InErrorMode) if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "%% Error\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Error~n"));
if (LOCAL_PrologMode & ConsoleGetcMode) if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "%% Prompt Console\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Prompt Console~n"));
if (LOCAL_PrologMode & ExtendStackMode) if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "%% Stack expansion \n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Stack expansion ~n"));
if (LOCAL_PrologMode & GrowHeapMode) if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "%% Data Base Expansion\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Data Base Expansion~n"));
if (LOCAL_PrologMode & GrowStackMode) if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "%% User Prolog\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolog~n"));
if (LOCAL_PrologMode & GCMode) if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "%% Garbage Collection\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Garbage Collection~n"));
if (LOCAL_PrologMode & ErrorHandlingMode) if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "%% Error handler\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Error handler~n"));
if (LOCAL_PrologMode & CCallMode) if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "%% System Foreign Code\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% System Foreign Code~n"));
if (LOCAL_PrologMode & UnifyMode) if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "%% Off-line Foreign Code\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Off-line Foreign Code~n"));
if (LOCAL_PrologMode & UserCCallMode) if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "%% User Foreig C\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% User Foreig C~n"));
if (LOCAL_PrologMode & MallocMode) if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "%% Heap Allocaror\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Heap Allocaror~n"));
if (LOCAL_PrologMode & SystemMode) if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "%% Prolog Internals\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Prolog Internals~n"));
if (LOCAL_PrologMode & AsyncIntMode) if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "%% Async Interruot mode\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Async Interruot mode~n"));
if (LOCAL_PrologMode & InReadlineMode) if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "%% Readline Console\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Readline Console~n"));
if (LOCAL_PrologMode & TopGoalMode) if (LOCAL_PrologMode & TopGoalMode)
fprintf(stderr, "%% Creating new query\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% Creating new query~n"));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); #endif
fprintf(stderr, "%% \n%% YAP Program:\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Program:~n"));
fprintf(stderr, "%% Program Position: %s\n\n", Yap_errorName(errno) ); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
fprintf(stderr, "%% PC: %s\n", (char *)HR); ADDBUF(snprintf(lbuf, lbufsz , "%% Program Position: %s~n~n", Yap_errorName(errno)));
ADDBUF(snprintf(lbuf, lbufsz , "%% PC: %s~n", (char *)HR));
Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256); Yap_output_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR); ADDBUF(snprintf(lbuf, lbufsz , "%% Continuation: %s~n", (char *)HR));
Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256); Yap_output_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Alternative: %s\n", (char *)HR); ADDBUF(snprintf(lbuf, lbufsz , "%% Alternative: %s~n", (char *)HR));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
fprintf(stderr, "%% \n%% YAP Stack Usage:\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack Usage:~n"));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
if (HR > ASP || HR > LCL0) { if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n", ADDBUF(snprintf(lbuf, lbufsz , "%% YAP ERROR: Global Collided against Local (%p--%p)~n",
HR, ASP); HR, ASP));
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) { } else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr, ADDBUF(snprintf(lbuf, lbufsz ,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", "%% YAP ERROR: Code Space Collided against Global (%p--%p)~n",
HeapTop, LOCAL_GlobalBase); HeapTop, LOCAL_GlobalBase));
} else { } else {
#if !USE_SYSTEM_MALLOC #if !USE_SYSTEM_MALLOC
fprintf(stderr, "%%ldKB of Code Space (%p--%p)\n", ADDBUF(snprintf(lbuf, lbufsz , "%%ldKB of Code Space (%p--%p)~n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase, (long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop); HeapTop));
#if USE_DL_MALLOC #if USE_DL_MALLOC
if (Yap_NOfMemoryHoles) { if (Yap_NOfMemoryHoles) {
UInt i; UInt i;
for (i = 0; i < Yap_NOfMemoryHoles; i++) for (i = 0; i < Yap_NOfMemoryHoles; i++)
fprintf(stderr, " Current hole: %p--%p\n", Yap_MemoryHoles[i].start, ADDBUF(snprintf(lbuf, lbufsz , " Current hole: %p--%p~n", Yap_MemoryHoles[i].start,
Yap_MemoryHoles[i].end); Yap_MemoryHoles[i].end));
} }
#endif #endif
#endif #endif
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n", ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Global Stack (%p--%p)~n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR); (unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR));
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n", ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Local Stack (%p--%p)~n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0); (unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0));
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n", ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Trail (%p--%p)~n",
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024, (unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR); LOCAL_TrailBase, TR));
fprintf(stderr, "%% Performed %ld garbage collections\n", ADDBUF(snprintf(lbuf, lbufsz , "%% Performed %ld garbage collections~n",
(unsigned long int)LOCAL_GcCalls); (unsigned long int)LOCAL_GcCalls));
#if LOW_LEVEL_TRACER #if LOW_LEVEL_TRACER
{ {
extern long long vsc_count; extern long long vsc_count;
if (vsc_count) { if (vsc_count) {
#if _WIN32 #if _WIN32
fprintf(stderr, "Trace Counter at %I64d\n", vsc_count); ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %I64d~n", vsc_count));
#else #else
fprintf(stderr, "Trace Counter at %lld\n", vsc_count); ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %lld~n", vsc_count));
#endif #endif
} }
} }
#endif #endif
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
fprintf(stderr, "%% \n%% YAP Stack:\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack:~n"));
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
fprintf(stderr, "%% All Active Calls and\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% All Active Calls and~n"));
fprintf(stderr, "%% Goals With Alternatives Open (Global In " ADDBUF(snprintf(lbuf, lbufsz , "%% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n"); "Use--Local In Use)~n%%~n"));
while (b_ptr != NULL) { while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) { while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256); tp = Yap_output_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) { if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp); ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
} else { } else {
fprintf(stderr, "%% %s\n", tp); ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
} }
if (!max_count--) { if (!max_count--) {
fprintf(stderr, "%% .....\n"); ADDBUF(snprintf(lbuf, lbufsz , "%% .....~n"));
return; return pop_output_text_stack(lvl, buf);
} }
ipc = (yamop *)(env_ptr[E_CP]); ipc = (yamop *)(env_ptr[E_CP]);
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
} }
if (b_ptr) { if (b_ptr) {
if (!max_count--) { if (!max_count--) {
fprintf(stderr, "// .....\n"); ADDBUF(snprintf(lbuf, lbufsz , "// .....~n"));
return; return pop_output_text_stack(lvl, buf);
} }
if (b_ptr->cp_ap && /* tabling */ if (b_ptr->cp_ap && /* tabling */
b_ptr->cp_ap->opc != Yap_opcode(_or_else) && b_ptr->cp_ap->opc != Yap_opcode(_or_else) &&
b_ptr->cp_ap->opc != Yap_opcode(_or_last) && b_ptr->cp_ap->opc != Yap_opcode(_or_last) &&
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) { b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */ /* we can safely ignore ; because there is always an upper env */
Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256); tp = Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp, ADDBUF(snprintf(lbuf, lbufsz , "%% %s (%luKB--%luKB)~n", tp,
(unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024), (unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024); (unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024));
} }
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} }
} }
} }
return pop_output_text_stack(lvl, buf);
} }
void DumpActiveGoals(USES_REGS1) { void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */ /* try to dump active goals */
CELL *ep = YENV; /* and current environment */ CELL *ep = YENV; /* and current environment */
@ -2047,7 +2065,7 @@ void DumpActiveGoals(USES_REGS1) {
if (i > 0) if (i > 0)
fputc(',', stderr); fputc(',', stderr);
fputc('_', stderr); fputc('_', stderr);
} }
fputs(") :- ... ( _ ; _ ", stderr); fputs(") :- ... ( _ ; _ ", stderr);
} else { } else {
Term *args = &(b_ptr->cp_a1); Term *args = &(b_ptr->cp_a1);
@ -2068,33 +2086,34 @@ void DumpActiveGoals(USES_REGS1) {
} }
} }
/** /**
* Used for debugging. * Used for debugging.
* *
*/ */
void Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) { char * Yap_output_bug_location(yamop *yap_pc, int where_from, int psize) {
Atom pred_name; Atom pred_name;
UInt pred_arity; UInt pred_arity;
Term pred_module; Term pred_module;
Int cl; Int cl;
char *o = Malloc(256);
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) { &pred_module)) == 0) {
/* system predicate */ /* system predicate */
fprintf(stderr, "%% %s", "meta-call"); snprintf(o, 255, "%% %s", "meta-call");
} else if (pred_module == 0) { } else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE, snprintf(o, 255, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity); (unsigned long int)pred_arity);
} else if (cl < 0) { } else if (cl < 0) {
fprintf(stderr, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE, snprintf(o, 255, "%% %s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity); RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else { } else {
fprintf(stderr, "%% %s:%s/%lu at clause %lu", snprintf(o, 255, "%% %s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE, RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity, RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl); (unsigned long int)cl);
} }
return o;
} }
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,

1
H/YapEval.h
View File

@ -205,7 +205,6 @@ typedef enum {
op_heapused, op_heapused,
op_localsp, op_localsp,
op_globalsp, op_globalsp,
op_b,
op_env, op_env,
op_tr, op_tr,
op_stackfree op_stackfree

3
H/Yapproto.h
View File

@ -391,8 +391,7 @@ extern void Yap_InitSortPreds(void);
/* stack.c */ /* stack.c */
extern void Yap_InitStInfo(void); extern void Yap_InitStInfo(void);
extern void Yap_dump_stack(void); extern char *Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
extern void Yap_output_bug_location(yamop *yap_pc, int where_from, int psize);
#if !defined(YAPOR) && !defined(THREADS) #if !defined(YAPOR) && !defined(THREADS)
extern bool Yap_search_for_static_predicate_in_use(struct pred_entry *, bool); extern bool Yap_search_for_static_predicate_in_use(struct pred_entry *, bool);

4
include/YapError.h
View File

@ -243,6 +243,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
/// whether we are consulting /// whether we are consulting
bool prologConsulting; bool prologConsulting;
const char *culprit; const char *culprit;
/// Prolog stack at the time
const char *prologStack;
YAP_Term errorRawTerm, rawExtraErrorTerm; YAP_Term errorRawTerm, rawExtraErrorTerm;
char *errorMsg; char *errorMsg;
size_t errorMsgLen; size_t errorMsgLen;
@ -271,6 +273,8 @@ INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
yap_error_descriptor_t * t, void *cp0, void *b_ptr0, void *env0, yap_error_descriptor_t * t, void *cp0, void *b_ptr0, void *env0,
YAP_Int ignore_first); YAP_Int ignore_first);
extern const char *Yap_dump_stack(void);
extern yap_error_descriptor_t *Yap_prolog_add_culprit(yap_error_descriptor_t * extern yap_error_descriptor_t *Yap_prolog_add_culprit(yap_error_descriptor_t *
t); t);
extern yap_error_class_number Yap_errorClass(yap_error_number e); extern yap_error_class_number Yap_errorClass(yap_error_number e);

1
include/YapErrors.h
View File

@ -90,6 +90,7 @@ E(DOMAIN_ERROR_WRITE_OPTION, DOMAIN_ERROR, "write_option")
E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow") E(EVALUATION_ERROR_FLOAT_OVERFLOW, EVALUATION_ERROR, "float_overflow")
E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow") E(EVALUATION_ERROR_FLOAT_UNDERFLOW, EVALUATION_ERROR, "float_underflow")
E(EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR, "int_overflow") E(EVALUATION_ERROR_INT_OVERFLOW, EVALUATION_ERROR, "int_overflow")
E(EVALUATION_ERROR_READ_STREAM, EVALUATION_ERROR, "read_from_stream")
E(EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR, "undefined") E(EVALUATION_ERROR_UNDEFINED, EVALUATION_ERROR, "undefined")
E(EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR, "underflow") E(EVALUATION_ERROR_UNDERFLOW, EVALUATION_ERROR, "underflow")
E(EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR, "zero_divisor") E(EVALUATION_ERROR_ZERO_DIVISOR, EVALUATION_ERROR, "zero_divisor")

2
include/YapTerm.h
View File

@ -100,10 +100,10 @@ typedef YAP_UInt YAP_Term;
#define TRUE true #define TRUE true
#endif #endif
#ifndef FALSE #ifndef FALSE
#define FALSE false
#endif #endif
typedef bool YAP_Bool; typedef bool YAP_Bool;
#define FALSE false
typedef YAP_Int YAP_handle_t; typedef YAP_Int YAP_handle_t;

2738
os/readterm.c
View File

File diff suppressed because it is too large Load Diff

2
packages/cplint/slipcase/bddem.c
View File

@ -333,7 +333,7 @@ so that it is not recomputed
BChild1 = pt * p; BChild1 = pt * p;
mVarIndex = bVar2mVar_ex[ex][index]; mVarIndex = bVar2mVar_ex[ex][index];
v = vars_ex[ex][mVarIndex]; v = vars_ex[ex][mVarIndex];
index - v.firstBoolVar; index = v.firstBoolVar;
res = BChild0 + BChild1; res = BChild0 + BChild1;
add_node(table, nodekey, res); add_node(table, nodekey, res);
return res; return res;

7
pl/boot.yap
View File

@ -394,13 +394,12 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- style_check([+discontiguous,+multiple,+single_var]). :- style_check([+discontiguous,+multiple,+single_var]).
% %
% moved this to init_gc in gc.c to separate the alpha % moved this to init_gc in sgc.c to separate the alpha
% %
% :- yap_flag(gc,on). % :- yap_flag(gc,on).
%
% :- yap_flag(gc_trace,verbose). % :- yap_flag(gc_trace,verbose`
:- multifile :- multifile
prolog:comment_hook/3. prolog:comment_hook/3.

218
pl/debug.yap
View File

@ -392,33 +392,33 @@ be lost.
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, G, EG ), '$trace_query'(G, M, CP, G, EG ),
call(EG). call(EG).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded) %% @pred '$trace_query'( +G, +M, +CP, +Expanded)
% %
% debug a complex query % debug a complex query
% %
'$trace_query'(V, M, CP, _, call(M:V) :- '$trace_query'(V, M, _CP, _, call(M:V)) :-
var(V), !. var(V), !.
'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- '$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :-
!. !.
'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!. !.
'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- '$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!. !.
'$trace_query'(true, _, _, _, true) :- !. '$trace_query'(true, _, _, _, true) :- !.
'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. '$trace_query'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :- '$trace_query'(M:G, _, CP,S, Expanded) :-
!, !,
'$yap_strip_module'(M:G, M0, G0), '$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S, Expanded ). '$trace_query'(G0, M0, CP,S, Expanded ).
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, '$trace_query'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S, EB).
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, '$trace_query'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S, EB).
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, '$trace_query'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_query'(A, M, CP, S, EA), '$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB). '$trace_query'(B, M, CP, S, EB).
@ -431,10 +431,10 @@ be lost.
% spy a literal % spy a literal
'$id_goal'(L), '$id_goal'(L),
catch( catch(
'$trace_goal'(G, M, L, H), '$trace_goal'(G, M, L, H),
E, E,
'$re_trace_query'(E, G, M, L, H) '$TraceError'(E, G, M, L, H)
))). ))).
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
%% %%
@ -446,7 +446,7 @@ be lost.
; ;
'__NB_getval__'('$debug_status',state(zip,Border,Spy), fail), '__NB_getval__'('$debug_status',state(zip,Border,Spy), fail),
Border < GoalNumber, Border < GoalNumber,
( Spy == ignore ; '$pred_being_spied'(G, M) ) ( Spy == ignore ; \+ '$pred_being_spied'(G, M) )
), ),
%writeln(go:G:M), %writeln(go:G:M),
!, !,
@ -476,25 +476,25 @@ be lost.
). ).
% system_ % system_
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
( (
'$is_opaque_predicate'(G, M) '$is_opaque_predicate'(G, M)
; ;
'strip_module'(M:G, prolog, _NG) 'strip_module'(M:G, prolog, _NG)
), ),
!, !,
gated_call( gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
'$execute_nonstop'(G,M), '$execute_nonstop'(G,M),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
gated_call( gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
'$debug'( GoalNumber, G, M, H), '$debug'( GoalNumber, G, M, H),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
/** /**
@ -547,8 +547,10 @@ be lost.
* @parameter _Info_ describes the goal * @parameter _Info_ describes the goal
* *
*/ */
'$debug'(_, G, M, _H) :- '$debug'(_, G, M, _H) :-
'__NB_getval__'('$debug_status',state(zip,_Border,_), fail), '__NB_getval__'('$debug_status',state(zip,_Border,Spy), fail),
( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ),
!, !,
'$execute_nonstop'( G, M ). '$execute_nonstop'( G, M ).
'$debug'(GoalNumber, G, M, Info) :- '$debug'(GoalNumber, G, M, Info) :-
@ -574,74 +576,50 @@ be lost.
*/ */
'$trace_go'(GoalNumber, G, M, Info) :- '$trace_go'(GoalNumber, G, M, Info) :-
X=marker(_,M,G), X=marker(_,M,G),
'$$save_by'(CP), '$$save_by'(CP),
clause(M:G, Cl, _), clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X), '$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_query'(Cl, M, CP, Cl, ECl), '$trace_query'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M). '$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :- '$creep_step'(GoalNumber, G, M, Info) :-
X=marker(_,M,G), X=marker(_,M,G),
'$$save_by'(CP), '$$save_by'(CP),
'$static_clause'(G,M,_,Ref), '$static_clause'(G,M,_,Ref),
'$retry_clause'(GoalNumber, G, M, Info, X), '$retry_clause'(GoalNumber, G, M, Info, X),
'$creep', '$creep',
'$execute_clause'(G,M,Ref,CP). '$execute_clause'(G,M,Ref,CP).
'$retry_clause'(_GoalNumber, _G, _M, _Info, MarkerV) :- '$retry_clause'(_GoalNumber, _G, _M, _Info, MarkerV) :-
arg(1, MarkerV, V), arg(1, MarkerV, V),
var(V), var(V),
!, !,
nb_setarg(1,MarkerV, visited). nb_setarg(1,MarkerV, visited).
'$retry_clause'(GoalNumber, G, Module, Info, _X) :- '$retry_clause'(GoalNumber, G, Module, Info, _X) :-
'$trace_port_'(redo, GoalNumber, G, Module, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info).
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
% - redo resets the goal
% - fail gives up on the goal.
'$re_trace_query'(abort, _G, _Module, _GoalNumber, _H) :-
!,
abort.
'$re_trace_query'(error(event(fail),G0), _G, __Module, GoalNumber, _H) :-
GoalNumber =< G0,
!,
fail.
'$re_trace_query'(error(event(redo),G0), G, M, GoalNumber, H) :-
GoalNumber > G0,
!,
catch(
'$trace_goal'(G, M, GoalNumber, H),
E,
'$re_trace_query'(E, G,M, GoalNumber, H)
).
'$re_trace_query'(Throw, _G, _Module, _GoalNumber, _H) :-
throw(Throw).
'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :-
'$stop_creeping'(_) , '$stop_creeping'(_) ,
current_prolog_flag(debug, true), current_prolog_flag(debug, true),
'__NB_getval__'('$debug_status',state(Skip,Border,_), fail), '__NB_getval__'('$debug_status',state(Skip,Border,_), fail),
( Skip == creep -> true; '$id_goal'(GoalNumber) ; GoalNumber =< Border), ( Skip == creep -> true; '$id_goal'(GoalNumber) ; GoalNumber =< Border),
!, !,
'__NB_setval__'('$debug_status', state(creep, 0, stop)), '__NB_setval__'('$debug_status', state(creep, 0, stop)),
'$trace_port_'(Port, GoalNumber, G, Module, Info). '$trace_port_'(Port, GoalNumber, G, Module, Info).
'$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). '$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info).
'$trace_port_'(call, GoalNumber, G, Module, Info) :- '$trace_port_'(call, GoalNumber, G, Module, Info) :-
'$port'(call,G,Module,GoalNumber,deterministic, Info). '$port'(call,G,Module,GoalNumber,deterministic, Info).
'$trace_port_'(exit, GoalNumber, G, Module, Info) :- '$trace_port_'(exit, GoalNumber, G, Module, Info) :-
nb_setarg(6, Info, true), nb_setarg(6, Info, true),
'$port'(exit,G,Module,GoalNumber,deterministic, Info). '$port'(exit,G,Module,GoalNumber,deterministic, Info).
'$trace_port_'(answer, GoalNumber, G, Module, Info) :- '$trace_port_'(answer, GoalNumber, G, Module, Info) :-
'$port'(exit,G,Module,GoalNumber,nondeterministic, Info). '$port'(exit,G,Module,GoalNumber,nondeterministic, Info).
'$trace_port_'(redo, GoalNumber, G, Module, Info) :- '$trace_port_'(redo, GoalNumber, G, Module, Info) :-
'$port'(redo,G,Module,GoalNumber,nondeterministic, Info), /* inform user_error */ '$port'(redo,G,Module,GoalNumber,nondeterministic, Info), /* inform user_error */
'$stop_creeping'(_ ). '$stop_creeping'(_ ).
'$trace_port_'(fail, GoalNumber, G, Module, Info) :- '$trace_port_'(fail, GoalNumber, G, Module, Info) :-
'$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */ '$port'(fail,G,Module,GoalNumber,deterministic, Info). /* inform user_error */
'$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */ '$trace_port_'(! ,_GoalNumber,_G,_Module,_Imfo) :- /* inform user_error */
!. !.
'$trace_port_'(exception(E), GoalNumber, G, Module, Info) :- '$trace_port_'(exception(E), GoalNumber, G, Module, Info) :-
@ -651,25 +629,47 @@ be lost.
%%% - abort: forward throw while the call is newer than goal %%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
% - redo resets the goal
% - fail gives up on the goal.
'$TraceError'(abort, _G, _Module, _GoalNumber, _H) :-
!,
abort.
'$TraceError'(error(event(fail),G0), _G, __Module, GoalNumber, _H) :-
GoalNumber =< G0,
!,
fail.
'$TraceError'(error(event(redo),G0), G, M, GoalNumber, H) :-
GoalNumber =< G0,
!,
catch(
'$trace_goal'(G, M, GoalNumber, H),
E,
'$TraceError'(E, G, M, GoalNumber, H)
).
'$TraceError'( error(Id,Info), _, _, _, _) :- '$TraceError'( error(Id,Info), _, _, _, _) :-
!,
throw( error(Id, Info) ). throw( error(Id, Info) ).
%%% - forward through the debugger %%% - forward through the debugger
'$TraceError'(forward('$wrapper',Event), _, _, _, _) :- '$TraceError'(forward('$wrapper',Event), _, _, _, _) :-
!, !,
throw(Event). throw(Event).
%%% - anything else, leave to the user and restore the catch %%% - anything else, leave to the user and restore the catch
'$TraceError'(Event, GoalNumber, G, Module, CalledFromDebugger) :- '$TraceError'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
'$debug_error'(Event), '$debug_error'(Event),
'$system_catch'( '$system_catch'(
('$port'(exception(Event),G,Module,GoalNumber,_,creep),fail), ('$port'(exception(Event),G,Module,GoalNumber,_,creep),fail),
Module, Module,
Error, Error,
'$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger) '$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger)
). ).
'$debug_error'(Event) :- '$debug_error'(Event) :-
'$Error'(Event), fail. '$Error'(Event), fail.
'$debug_error'(_). '$debug_error'(_).
@ -789,9 +789,10 @@ be lost.
'__NB_setval__'('$debug_status',status(creep,0,stop)). '__NB_setval__'('$debug_status',status(creep,0,stop)).
'$action'(e,_,_,_,_,_) :- !, % 'e exit '$action'(e,_,_,_,_,_) :- !, % 'e exit
halt. halt.
'$action'(f,_,_,_,_,_) :- !, % 'f fail '$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail
'$scan_number'( GoalId), %'f '$scan_number'( ScanNumber),
throw(error(event(fail),GoalId)). ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
throw(error(event(fail),Goal)).
'$action'(h,_,_,_,_,_) :- !, % 'h help '$action'(h,_,_,_,_,_) :- !, % 'h help
'$action_help', '$action_help',
skip( debugger_input, 10), skip( debugger_input, 10),
@ -834,10 +835,11 @@ be lost.
% tell debugger never to stop. % tell debugger never to stop.
'__NB_setval__'('$debug_status', state(zip, 0, ignore)), '__NB_setval__'('$debug_status', state(zip, 0, ignore)),
nodebug. nodebug.
'$action'(r,_,_,_,_,_) :- !, % 'r retry '$action'(r,_,CallNumber,_,_,_) :- !, % 'r retry
'$scan_number'(ScanNumber), % ' '$scan_number'(ScanNumber), % '
% set_prolog_flag(debug, true), % set_prolog_flag(debug, true),
throw(error(event(redo,ScanNumber)). ( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
throw(error(event(redo),Goal)).
'$action'(s,P,CallNumber,_,_,_) :- !, % 's skip '$action'(s,P,CallNumber,_,_,_) :- !, % 's skip
skip( debugger_input, 10), % ' skip( debugger_input, 10), % '
( (P=call; P=redo) -> ( (P=call; P=redo) ->

2
pl/errors.yap
View File

@ -94,7 +94,7 @@ error_handler(Error, Level) :-
'$LoopError'(Error, Level). '$LoopError'(Error, Level).
'$LoopError'(_, _) :- '$LoopError'(_, _) :-
stop_low_level_trace, %stop_low_level_trace,
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
fail. fail.

871
pl/messages.yap
View File

File diff suppressed because it is too large Load Diff

10
pl/top.yap
View File

@ -23,6 +23,7 @@
% start a Prolog engine. % start a Prolog engine.
live :- live :-
repeat, repeat,
yap_flag(verbose,normal),
'$current_module'(Module), '$current_module'(Module),
( Module==user -> ( Module==user ->
true % '$compile_mode'(_,0) true % '$compile_mode'(_,0)
@ -582,6 +583,15 @@ write_query_answer( Bindings ) :-
'$current_choice_point'(CP), '$current_choice_point'(CP),
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, CP, G0, M) :-
gated_call(
'$enable_debugging',
'$call'(G, CP, G0, M),
Port,
'$disable_debugging_on_port'(Port)
).
'$user_call'(G, M) :- '$user_call'(G, M) :-
gated_call( gated_call(
'$enable_debugging', '$enable_debugging',

8
swi/library/option.pl
View File

@ -107,6 +107,10 @@ option(Opt, _, Default) :-
% %
% @param Option Term of the form Name(?Value). % @param Option Term of the form Name(?Value).
option(Opt, Options) :- % make option processing stead-fast
atom(Opt),
!,
get_option(Opt, Options).
option(Opt, Options) :- % make option processing stead-fast option(Opt, Options) :- % make option processing stead-fast
arg(1, Opt, OptVal), arg(1, Opt, OptVal),
nonvar(OptVal), !, nonvar(OptVal), !,
@ -132,6 +136,10 @@ get_option(Opt, Options) :-
% the matching option from Options and unifying the remaining % the matching option from Options and unifying the remaining
% options with RestOptions. % options with RestOptions.
select_option(Opt, Options0, Options) :- % stead-fast
atom(Opt),
!,
select_option(Opt, Options0, Options).
select_option(Opt, Options0, Options) :- % stead-fast select_option(Opt, Options0, Options) :- % stead-fast
arg(1, Opt, OptVal), arg(1, Opt, OptVal),
nonvar(OptVal), !, nonvar(OptVal), !,

4
swi/library/plunit.pl
View File

@ -1095,8 +1095,8 @@ setup(_,_,_).
% Call Goal in Module after applying goal expansion. % Call Goal in Module after applying goal expansion.
call_ex(Module, Goal) :- call_ex(Module, Goal) :-
(expand_goal(Goal,Module: GoalEx), expand_goal(Module:Goal, GoalEx),
Module:GoalEx). call(GoalEx).
%% cleanup(+Module, +Options) is det. %% cleanup(+Module, +Options) is det.
% %