Merge /home/vsc/yap
This commit is contained in:
12
C/errors.c
12
C/errors.c
@@ -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(prologConsulting, "prologConsulting", 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_i(errorMsgLen, "errorMsgLen", q, i, t);
|
||||
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_b(parserReadingCode, "parserReadingCode", 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_i(errorMsgLen, "errorMsgLen", q, i);
|
||||
return TermNil;
|
||||
@@ -176,6 +178,7 @@ static void printErr(yap_error_descriptor_t *i) {
|
||||
print_key_b("parserReadingCode", i->parserReadingCode);
|
||||
print_key_b("prologConsulting", i->prologConsulting);
|
||||
print_key_s("culprit", i->culprit);
|
||||
print_key_s("prologStack", i->prologStack);
|
||||
if (i->errorMsgLen) {
|
||||
print_key_s("errorMsg", i->errorMsg);
|
||||
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("prologConsulting", i->prologConsulting, o);
|
||||
o = add_key_s("culprit", i->culprit, o);
|
||||
o = add_key_s("prologStack", i->prologStack, o);
|
||||
if (i->errorMsgLen) {
|
||||
o = add_key_s("errorMsg", i->errorMsg, 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
|
||||
// DumpActiveGoals( USES_REGS1 );
|
||||
#endif /* DEBUG */
|
||||
|
||||
if (LOCAL_ActiveError->errorNo!= SYNTAX_ERROR)
|
||||
LOCAL_ActiveError->prologStack=Yap_dump_stack();
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
#if DEBUG
|
||||
// DumpActiveGoals( PASS_REGS1 );
|
||||
@@ -1045,7 +1050,6 @@ static Int query_exception(USES_REGS1) {
|
||||
if (!IsAddressTerm(Deref(ARG2)))
|
||||
return false;
|
||||
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
|
||||
Term t3 = Deref(ARG3);
|
||||
//if (IsVarTerm(t3)) {
|
||||
Term rc = queryErr(query, y);
|
||||
// Yap_DebugPlWriteln(rc);
|
||||
@@ -1262,7 +1266,7 @@ static Int is_predicate_indicator(USES_REGS1) {
|
||||
|
||||
void Yap_InitErrorPreds(void) {
|
||||
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("$new_exception", 1, new_exception, 0);
|
||||
Yap_InitCPred("$get_exception", 1, get_exception, 0);
|
||||
|
||||
@@ -728,20 +728,18 @@ return GLOBAL_DIRNAME;
|
||||
|
||||
char *profile_names(int);
|
||||
char *profile_names(int k) {
|
||||
static char *FNAME=NULL;
|
||||
char *FNAME=NULL;
|
||||
int size=200;
|
||||
|
||||
if (GLOBAL_DIRNAME==NULL) set_profile_dir(NULL);
|
||||
size=strlen(GLOBAL_DIRNAME)+40;
|
||||
if (FNAME!=NULL) free(FNAME);
|
||||
FNAME=malloc(size);
|
||||
if (FNAME==NULL) { printf("Profiler Out of Mem\n"); exit(1); }
|
||||
strcpy(FNAME,GLOBAL_DIRNAME);
|
||||
|
||||
if (k==PROFILING_FILE) {
|
||||
sprintf(FNAME,"%s/PROFILING_%d",FNAME,getpid());
|
||||
sprintf(FNAME,"%s/PROFILING_%d",GLOBAL_DIRNAME,getpid());
|
||||
} else {
|
||||
sprintf(FNAME,"%s/PROFPREDS_%d",FNAME,getpid());
|
||||
sprintf(FNAME,"%s/PROFPREDS_%d",GLOBAL_DIRNAME,getpid());
|
||||
}
|
||||
|
||||
// printf("%s\n",FNAME);
|
||||
|
||||
15
C/scanner.c
15
C/scanner.c
@@ -1340,7 +1340,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
|
||||
TokEntry *t, *l, *p;
|
||||
enum TokenKinds kind;
|
||||
int solo_flag = TRUE;
|
||||
int32_t ch, och;
|
||||
int32_t ch, och = ' ';
|
||||
struct qq_struct_t *cur_qq = NULL;
|
||||
int sign = 1;
|
||||
|
||||
@@ -1423,12 +1423,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
|
||||
|
||||
case UC:
|
||||
case UL:
|
||||
case LC: {
|
||||
int32_t och = ch;
|
||||
case LC:
|
||||
och = ch;
|
||||
ch = getchr(st);
|
||||
size_t sz = 512;
|
||||
TokImage = Malloc(sz PASS_REGS);
|
||||
scan_name:
|
||||
{
|
||||
size_t sz = 1024;
|
||||
TokImage = Malloc(sz PASS_REGS);
|
||||
charp = (unsigned char *)TokImage;
|
||||
isvar = (chtype(och) != LC);
|
||||
add_ch_to_buff(och);
|
||||
@@ -1514,8 +1515,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
|
||||
case 'e':
|
||||
case 'E':
|
||||
och = cherr;
|
||||
TokImage = Malloc(1024 PASS_REGS);
|
||||
goto scan_name;
|
||||
goto scan_name;
|
||||
break;
|
||||
case '=':
|
||||
case '_':
|
||||
@@ -1981,6 +1981,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
|
||||
return l;
|
||||
|
||||
default: {
|
||||
kind = Error_tok;
|
||||
char err[1024];
|
||||
snprintf(err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n",
|
||||
ch, ch, chtype(ch));
|
||||
|
||||
201
C/stack.c
201
C/stack.c
@@ -105,6 +105,8 @@ restart:
|
||||
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) {
|
||||
while (TRUE) {
|
||||
op_numbers opnum;
|
||||
@@ -656,7 +658,7 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
|
||||
|
||||
PELOCK(40, pp);
|
||||
/* 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 (code_in_pred_lu_index(
|
||||
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
|
||||
@@ -885,7 +887,7 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
|
||||
if (codeptr >= COMMA_CODE && codeptr < FAILCODE) {
|
||||
pp = RepPredProp(Yap_GetPredPropByFunc(FunctorComma, CurrentModule));
|
||||
*startp = (CODEADDR)COMMA_CODE;
|
||||
*endp = (CODEADDR)(FAILCODE - 1);
|
||||
*endp = (CODEADDR)(FAILCODE);
|
||||
return pp;
|
||||
}
|
||||
pc = codeptr;
|
||||
@@ -1702,8 +1704,6 @@ parent_pred(USES_REGS1) {
|
||||
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
|
||||
}
|
||||
|
||||
void Yap_dump_stack(void);
|
||||
|
||||
void DumpActiveGoals(CACHE_TYPE1);
|
||||
|
||||
static int hidden(Atom);
|
||||
@@ -1767,173 +1767,191 @@ static bool handled_exception(USES_REGS1) {
|
||||
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
|
||||
choiceptr b_ptr = B;
|
||||
CELL *env_ptr = ENV;
|
||||
char tp[256];
|
||||
char *tp;
|
||||
yamop *ipc = CP;
|
||||
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 */
|
||||
//if (handled_exception(PASS_REGS1))
|
||||
// if (handled_exception(PASS_REGS1))
|
||||
// return;
|
||||
#if DEBUG
|
||||
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
|
||||
P, CP, ASP, HR, TR, HeapTop);
|
||||
#endif
|
||||
ADDBUF(snprintf(lbuf, lbufsz ,
|
||||
"%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p~n", P,
|
||||
CP, ASP, HR, TR, HeapTop));
|
||||
|
||||
fprintf(stderr, "%% \n%% =====================================\n%%\n");
|
||||
fprintf(stderr, "%% \n%% YAP Status:\n");
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% =====================================~n%%~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Status:~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
yap_error_number errnbr = LOCAL_Error_TYPE;
|
||||
yap_error_class_number classno = Yap_errorClass(errnbr);
|
||||
|
||||
fprintf(stderr, "%% Error STATUS: %s/%s\n\n", Yap_errorName(errnbr),
|
||||
Yap_errorClassName(classno));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Error STATUS: %s/%s~n~n", Yap_errorName(errnbr),
|
||||
Yap_errorClassName(classno)));
|
||||
|
||||
fprintf(stderr, "%% Execution mode\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Execution mode~n"));
|
||||
if (LOCAL_PrologMode & BootMode)
|
||||
fprintf(stderr, "%% Bootstrap\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Bootstrap~n"));
|
||||
if (LOCAL_PrologMode & UserMode)
|
||||
fprintf(stderr, "%% User Prolo\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolo~n"));
|
||||
if (LOCAL_PrologMode & CritMode)
|
||||
fprintf(stderr, "%% Exclusive Access Mode\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Exclusive Access Mode~n"));
|
||||
if (LOCAL_PrologMode & AbortMode)
|
||||
fprintf(stderr, "%% Abort\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Abort~n"));
|
||||
if (LOCAL_PrologMode & InterruptMode)
|
||||
fprintf(stderr, "%% Interrupt\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Interrupt~n"));
|
||||
if (LOCAL_PrologMode & InErrorMode)
|
||||
fprintf(stderr, "%% Error\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Error~n"));
|
||||
if (LOCAL_PrologMode & ConsoleGetcMode)
|
||||
fprintf(stderr, "%% Prompt Console\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Prompt Console~n"));
|
||||
if (LOCAL_PrologMode & ExtendStackMode)
|
||||
fprintf(stderr, "%% Stack expansion \n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Stack expansion ~n"));
|
||||
if (LOCAL_PrologMode & GrowHeapMode)
|
||||
fprintf(stderr, "%% Data Base Expansion\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Data Base Expansion~n"));
|
||||
if (LOCAL_PrologMode & GrowStackMode)
|
||||
fprintf(stderr, "%% User Prolog\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% User Prolog~n"));
|
||||
if (LOCAL_PrologMode & GCMode)
|
||||
fprintf(stderr, "%% Garbage Collection\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Garbage Collection~n"));
|
||||
if (LOCAL_PrologMode & ErrorHandlingMode)
|
||||
fprintf(stderr, "%% Error handler\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Error handler~n"));
|
||||
if (LOCAL_PrologMode & CCallMode)
|
||||
fprintf(stderr, "%% System Foreign Code\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% System Foreign Code~n"));
|
||||
if (LOCAL_PrologMode & UnifyMode)
|
||||
fprintf(stderr, "%% Off-line Foreign Code\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Off-line Foreign Code~n"));
|
||||
if (LOCAL_PrologMode & UserCCallMode)
|
||||
fprintf(stderr, "%% User Foreig C\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% User Foreig C~n"));
|
||||
if (LOCAL_PrologMode & MallocMode)
|
||||
fprintf(stderr, "%% Heap Allocaror\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Heap Allocaror~n"));
|
||||
if (LOCAL_PrologMode & SystemMode)
|
||||
fprintf(stderr, "%% Prolog Internals\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Prolog Internals~n"));
|
||||
if (LOCAL_PrologMode & AsyncIntMode)
|
||||
fprintf(stderr, "%% Async Interruot mode\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Async Interruot mode~n"));
|
||||
if (LOCAL_PrologMode & InReadlineMode)
|
||||
fprintf(stderr, "%% Readline Console\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Readline Console~n"));
|
||||
if (LOCAL_PrologMode & TopGoalMode)
|
||||
fprintf(stderr, "%% Creating new query\n");
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
fprintf(stderr, "%% \n%% YAP Program:\n");
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
fprintf(stderr, "%% Program Position: %s\n\n", Yap_errorName(errno) );
|
||||
fprintf(stderr, "%% PC: %s\n", (char *)HR);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Creating new query~n"));
|
||||
#endif
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Program:~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
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);
|
||||
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);
|
||||
fprintf(stderr, "%% Alternative: %s\n", (char *)HR);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Alternative: %s~n", (char *)HR));
|
||||
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
fprintf(stderr, "%% \n%% YAP Stack Usage:\n");
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack Usage:~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
if (HR > ASP || HR > LCL0) {
|
||||
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
|
||||
HR, ASP);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% YAP ERROR: Global Collided against Local (%p--%p)~n",
|
||||
HR, ASP));
|
||||
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
|
||||
fprintf(stderr,
|
||||
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
|
||||
HeapTop, LOCAL_GlobalBase);
|
||||
ADDBUF(snprintf(lbuf, lbufsz ,
|
||||
"%% YAP ERROR: Code Space Collided against Global (%p--%p)~n",
|
||||
HeapTop, LOCAL_GlobalBase));
|
||||
} else {
|
||||
#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,
|
||||
HeapTop);
|
||||
HeapTop));
|
||||
#if USE_DL_MALLOC
|
||||
if (Yap_NOfMemoryHoles) {
|
||||
UInt i;
|
||||
|
||||
for (i = 0; i < Yap_NOfMemoryHoles; i++)
|
||||
fprintf(stderr, " Current hole: %p--%p\n", Yap_MemoryHoles[i].start,
|
||||
Yap_MemoryHoles[i].end);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , " Current hole: %p--%p~n", Yap_MemoryHoles[i].start,
|
||||
Yap_MemoryHoles[i].end));
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n",
|
||||
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR);
|
||||
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n",
|
||||
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0);
|
||||
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n",
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Global Stack (%p--%p)~n",
|
||||
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Local Stack (%p--%p)~n",
|
||||
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %luKB of Trail (%p--%p)~n",
|
||||
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
|
||||
LOCAL_TrailBase, TR);
|
||||
fprintf(stderr, "%% Performed %ld garbage collections\n",
|
||||
(unsigned long int)LOCAL_GcCalls);
|
||||
LOCAL_TrailBase, TR));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Performed %ld garbage collections~n",
|
||||
(unsigned long int)LOCAL_GcCalls));
|
||||
#if LOW_LEVEL_TRACER
|
||||
{
|
||||
extern long long vsc_count;
|
||||
|
||||
if (vsc_count) {
|
||||
#if _WIN32
|
||||
fprintf(stderr, "Trace Counter at %I64d\n", vsc_count);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %I64d~n", vsc_count));
|
||||
#else
|
||||
fprintf(stderr, "Trace Counter at %lld\n", vsc_count);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "Trace Counter at %lld~n", vsc_count));
|
||||
#endif
|
||||
}
|
||||
}
|
||||
#endif
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
fprintf(stderr, "%% \n%% YAP Stack:\n");
|
||||
fprintf(stderr, "%% \n%% -------------------------------------\n%%\n");
|
||||
fprintf(stderr, "%% All Active Calls and\n");
|
||||
fprintf(stderr, "%% Goals With Alternatives Open (Global In "
|
||||
"Use--Local In Use)\n%%\n");
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% YAP Stack:~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% ~n%% -------------------------------------~n%%~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% All Active Calls and~n"));
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% Goals With Alternatives Open (Global In "
|
||||
"Use--Local In Use)~n%%~n"));
|
||||
while (b_ptr != NULL) {
|
||||
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) {
|
||||
b_ptr = b_ptr->cp_b;
|
||||
fprintf(stderr, "%% %s\n", tp);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
|
||||
} else {
|
||||
fprintf(stderr, "%% %s\n", tp);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %s~n", tp));
|
||||
}
|
||||
if (!max_count--) {
|
||||
fprintf(stderr, "%% .....\n");
|
||||
return;
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% .....~n"));
|
||||
return pop_output_text_stack(lvl, buf);
|
||||
}
|
||||
ipc = (yamop *)(env_ptr[E_CP]);
|
||||
env_ptr = (CELL *)(env_ptr[E_E]);
|
||||
}
|
||||
if (b_ptr) {
|
||||
if (!max_count--) {
|
||||
fprintf(stderr, "// .....\n");
|
||||
return;
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "// .....~n"));
|
||||
return pop_output_text_stack(lvl, buf);
|
||||
}
|
||||
if (b_ptr->cp_ap && /* tabling */
|
||||
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(_Nstop)) {
|
||||
/* we can safely ignore ; because there is always an upper env */
|
||||
Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
|
||||
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp,
|
||||
tp = Yap_output_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
|
||||
ADDBUF(snprintf(lbuf, lbufsz , "%% %s (%luKB--%luKB)~n", tp,
|
||||
(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;
|
||||
}
|
||||
}
|
||||
}
|
||||
return pop_output_text_stack(lvl, buf);
|
||||
}
|
||||
|
||||
|
||||
void DumpActiveGoals(USES_REGS1) {
|
||||
/* try to dump active goals */
|
||||
CELL *ep = YENV; /* and current environment */
|
||||
@@ -2047,7 +2065,7 @@ void DumpActiveGoals(USES_REGS1) {
|
||||
if (i > 0)
|
||||
fputc(',', stderr);
|
||||
fputc('_', stderr);
|
||||
}
|
||||
}
|
||||
fputs(") :- ... ( _ ; _ ", stderr);
|
||||
} else {
|
||||
Term *args = &(b_ptr->cp_a1);
|
||||
@@ -2068,33 +2086,34 @@ void DumpActiveGoals(USES_REGS1) {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* 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;
|
||||
UInt pred_arity;
|
||||
Term pred_module;
|
||||
Int cl;
|
||||
|
||||
char *o = Malloc(256);
|
||||
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
|
||||
&pred_module)) == 0) {
|
||||
/* system predicate */
|
||||
fprintf(stderr, "%% %s", "meta-call");
|
||||
snprintf(o, 255, "%% %s", "meta-call");
|
||||
} 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);
|
||||
} 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);
|
||||
} else {
|
||||
fprintf(stderr, "%% %s:%s/%lu at clause %lu",
|
||||
snprintf(o, 255, "%% %s:%s/%lu at clause %lu",
|
||||
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
|
||||
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
|
||||
(unsigned long int)cl);
|
||||
}
|
||||
return o;
|
||||
}
|
||||
|
||||
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,
|
||||
|
||||
Reference in New Issue
Block a user