From 2d19db5fce61682cca1b2891b559db6775e52487 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Mon, 9 Apr 2018 02:00:51 +0100 Subject: [PATCH] debug exc --- C/absmi.c | 1 - C/cdmgr.c | 3 + C/errors.c | 545 +++++++++++++++++++++++-------------------- C/exec.c | 9 +- C/init.c | 6 +- C/stack.c | 398 ++++++++++++++++--------------- C/threads.c | 8 +- C/write.c | 2 + C/yap-args.c | 9 +- CXX/yapi.cpp | 1 - H/ATOMS | 3 + H/Yatom.h | 2 +- H/generated/iatoms.h | 3 + H/generated/ratoms.h | 3 + H/generated/tatoms.h | 4 + misc/ATOMS | 4 +- pl/errors.yap | 11 +- pl/messages.yap | 62 ++--- pl/preddecls.yap | 2 - pl/signals.yap | 8 +- 20 files changed, 581 insertions(+), 503 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 4a4158363..66d109a0f 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -916,7 +916,6 @@ static int interrupt_dexecute(USES_REGS1) { static void undef_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); - BEGD(d0); /* avoid trouble with undefined dynamic procedures */ /* I assume they were not locked beforehand */ diff --git a/C/cdmgr.c b/C/cdmgr.c index 535b78d2d..8a26fa42e 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1699,6 +1699,9 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref) Term tf; int mode; + if (tmode == 0) { + tmode = TermConsult; + } if (tmode == TermConsult) { mode = consult; } else if (tmode == TermReconsult) { diff --git a/C/errors.c b/C/errors.c index 85c97c003..66c0bf9a2 100755 --- a/C/errors.c +++ b/C/errors.c @@ -32,113 +32,114 @@ #endif #include "Foreign.h" - #define set_key_b(k, ks, q, i, t) \ - if (strcmp(ks,q) == 0) \ - { i->k = t == TermTrue ? true : \ - false; \ - return i->k || t == TermFalse; } \ + if (strcmp(ks, q) == 0) { \ + i->k = t == TermTrue ? true : false; \ + return i->k || t == TermFalse; \ + } #define set_key_i(k, ks, q, i, t) \ - if (strcmp(ks,q) == 0) \ - { i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : \ - 0; \ - return IsIntegerTerm(t); } + if (strcmp(ks, q) == 0) { \ + i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \ + return IsIntegerTerm(t); \ + } #define set_key_s(k, ks, q, i, t) \ - if (strcmp(ks,q) == 0) \ - { const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE : \ - IsStringTerm(t) ? StringOfTerm(t) : \ - NULL; \ - if (s) { char *tmp = malloc(strlen(s)+1); strcpy(tmp,s); i->k = tmp; } \ - return i->k != NULL; } \ + if (strcmp(ks, q) == 0) { \ + const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \ + : IsStringTerm(t) ? StringOfTerm(t) : NULL; \ + if (s) { \ + char *tmp = malloc(strlen(s) + 1); \ + strcpy(tmp, s); \ + i->k = tmp; \ + } \ + return i->k != NULL; \ + } static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) { - set_key_i( errorNo, "errorNo", q, i , t); + set_key_i(errorNo, "errorNo", q, i, t); set_key_i(errorClass, "errorClass", q, i, t); set_key_s(errorAsText, "errorAsText", q, i, t); - set_key_s( errorGoal, "errorGoal", q, i, t); - set_key_s( classAsText, "classAsText", q, i, t); - set_key_i( errorLine, "errorLine", q, i , t); - set_key_s( errorFunction, "errorFunction", q, i, t); - set_key_s( errorFile, "errorFile", q, i, t); - set_key_i( prologPredLine, "prologPredLine", q, i, t); - set_key_i( prologPredFirstLine, "prologPredFirstLine", q, i, t); - set_key_i( prologPredLastLine, "prologPredLastLine", q, i, t); - set_key_s( prologPredName, "prologPredName", q, i, t); - set_key_i( prologPredArity, "prologPredArity", q, i, t); - set_key_s( prologPredModule, "prologPredModule", q, i, t); - set_key_s( prologPredFile, "prologPredFile", q, i, t); - set_key_i( prologParserPos, "prologParserPos", q, i, t); - set_key_i( prologParserLine, "prologParserLine", q, i, t); - set_key_i( prologParserFirstLine, "prologParserFirstLine", q, i, t); - set_key_i( prologParserLastLine, "prologParserLastLine", q, i, t); - set_key_s( prologParserText, "prologParserText", q, i, t); - set_key_s( prologParserFile, "prologParserFile", q, i, t); - set_key_b( prologConsulting, "prologConsulting", q, i, t); - set_key_s( culprit, "culprit", q, i, t); - set_key_s( errorMsg, "errorMsg", q, i, t); - set_key_i( errorMsgLen, "errorMsgLen", q, i, t); + set_key_s(errorGoal, "errorGoal", q, i, t); + set_key_s(classAsText, "classAsText", q, i, t); + set_key_i(errorLine, "errorLine", q, i, t); + set_key_s(errorFunction, "errorFunction", q, i, t); + set_key_s(errorFile, "errorFile", q, i, t); + set_key_i(prologPredLine, "prologPredLine", q, i, t); + set_key_i(prologPredFirstLine, "prologPredFirstLine", q, i, t); + set_key_i(prologPredLastLine, "prologPredLastLine", q, i, t); + set_key_s(prologPredName, "prologPredName", q, i, t); + set_key_i(prologPredArity, "prologPredArity", q, i, t); + set_key_s(prologPredModule, "prologPredModule", q, i, t); + set_key_s(prologPredFile, "prologPredFile", q, i, t); + set_key_i(prologParserPos, "prologParserPos", q, i, t); + set_key_i(prologParserLine, "prologParserLine", q, i, t); + set_key_i(prologParserFirstLine, "prologParserFirstLine", q, i, t); + set_key_i(prologParserLastLine, "prologParserLastLine", q, i, t); + set_key_s(prologParserText, "prologParserText", q, i, t); + set_key_s(prologParserFile, "prologParserFile", q, i, t); + set_key_b(prologConsulting, "prologConsulting", q, i, t); + set_key_s(culprit, "culprit", q, i, t); + set_key_s(errorMsg, "errorMsg", q, i, t); + set_key_i(errorMsgLen, "errorMsgLen", q, i, t); return false; } #define query_key_b(k, ks, q, i) \ - if (strcmp(ks,q) == 0) \ - { return i->k ? TermTrue : TermFalse; } \ + if (strcmp(ks, q) == 0) { \ + return i->k ? TermTrue : TermFalse; \ + } #define query_key_i(k, ks, q, i) \ - if (strcmp(ks,q) == 0) \ - { return MkIntegerTerm(i->k); } + if (strcmp(ks, q) == 0) { \ + return MkIntegerTerm(i->k); \ + } -#define query_key_s(k, ks, q, i) \ - if (strcmp(ks,q) == 0) \ - { return ( i->k && i->k[0] ? MkStringTerm(i->k) : TermEmptyAtom ); } +#define query_key_s(k, ks, q, i) \ + if (strcmp(ks, q) == 0) { \ + return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \ + } static Term queryErr(const char *q, yap_error_descriptor_t *i) { - query_key_i( errorNo, "errorNo", q, i ); + query_key_i(errorNo, "errorNo", q, i); query_key_i(errorClass, "errorClass", q, i); query_key_s(errorAsText, "errorAsText", q, i); - query_key_s( errorGoal, "errorGoal", q, i); - query_key_s( classAsText, "classAsText", q, i); - query_key_i( errorLine, "errorLine", q, i ); - query_key_s( errorFunction, "errorFunction", q, i); - query_key_s( errorFile, "errorFile", q, i); - query_key_i( prologPredLine, "prologPredLine", q, i); - query_key_i( prologPredFirstLine, "prologPredFirstLine", q, i); - query_key_i( prologPredLastLine, "prologPredLastLine", q, i); - query_key_s( prologPredName, "prologPredName", q, i); - query_key_i( prologPredArity, "prologPredArity", q, i); - query_key_s( prologPredModule, "prologPredModule", q, i); - query_key_s( prologPredFile, "prologPredFile", q, i); - query_key_i( prologParserPos, "prologParserPos", q, i); - query_key_i( prologParserLine, "prologParserLine", q, i); - query_key_i( prologParserFirstLine, "prologParserFirstLine", q, i); - query_key_i( prologParserLastLine, "prologParserLastLine", q, i); - query_key_s( prologParserText, "prologParserText", q, i); - query_key_s( prologParserFile, "prologParserFile", q, i); - query_key_b( prologConsulting, "prologConsulting", q, i); - query_key_s( culprit, "culprit", q, i); - query_key_s( errorMsg, "errorMsg", q, i); - query_key_i( errorMsgLen, "errorMsgLen", q, i); + query_key_s(errorGoal, "errorGoal", q, i); + query_key_s(classAsText, "classAsText", q, i); + query_key_i(errorLine, "errorLine", q, i); + query_key_s(errorFunction, "errorFunction", q, i); + query_key_s(errorFile, "errorFile", q, i); + query_key_i(prologPredLine, "prologPredLine", q, i); + query_key_i(prologPredFirstLine, "prologPredFirstLine", q, i); + query_key_i(prologPredLastLine, "prologPredLastLine", q, i); + query_key_s(prologPredName, "prologPredName", q, i); + query_key_i(prologPredArity, "prologPredArity", q, i); + query_key_s(prologPredModule, "prologPredModule", q, i); + query_key_s(prologPredFile, "prologPredFile", q, i); + query_key_i(prologParserPos, "prologParserPos", q, i); + query_key_i(prologParserLine, "prologParserLine", q, i); + query_key_i(prologParserFirstLine, "prologParserFirstLine", q, i); + query_key_i(prologParserLastLine, "prologParserLastLine", q, i); + query_key_s(prologParserText, "prologParserText", q, i); + query_key_s(prologParserFile, "prologParserFile", q, i); + query_key_b(prologConsulting, "prologConsulting", 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; } -static void print_key_b(const char *key, bool v) -{ +static void print_key_b(const char *key, bool v) { const char *b = v ? "true" : "false"; - fprintf(stderr,"%s: %s\n", key, b); + fprintf(stderr, "%s: %s\n", key, b); } -static void print_key_i(const char *key, YAP_Int v) -{ - fprintf(stderr,"%s: " Int_FORMAT "\n", key, v); +static void print_key_i(const char *key, YAP_Int v) { + fprintf(stderr, "%s: " Int_FORMAT "\n", key, v); } - - -static void print_key_s(const char *key, const char *v) -{ - fprintf(stderr,"%s: %s\n", key, v); +static void print_key_s(const char *key, const char *v) { + fprintf(stderr, "%s: %s\n", key, v); } static void printErr(yap_error_descriptor_t *i) { @@ -146,62 +147,56 @@ static void printErr(yap_error_descriptor_t *i) { if (i->errorNo == YAP_NO_ERROR) { return; } - print_key_i( "errorNo", i->errorNo ); + print_key_i("errorNo", i->errorNo); print_key_i("errorClass", i->errorClass); print_key_s("errorAsText", i->errorAsText); - print_key_s( "errorGoal", i->errorGoal); - print_key_s( "classAsText", i->classAsText); - print_key_i( "errorLineq", i->errorLine ); - print_key_s( "errorFunction", i->errorFunction); - print_key_s( "errorFile", i->errorFile); - print_key_i( "prologPredLine", i->prologPredLine); - print_key_i( "prologPredFirstLine", i->prologPredFirstLine); - print_key_i( "prologPredLastLine", i->prologPredLastLine); - print_key_s( "prologPredName", i->prologPredName); - print_key_i( "prologPredArity", i->prologPredArity); - print_key_s( "prologPredModule", i->prologPredModule); - print_key_s( "prologPredFile", i->prologPredFile); - print_key_i( "prologParserPos", i->prologParserPos); - print_key_i( "prologParserLine", i->prologParserLine); - print_key_i( "prologParserFirstLine", i->prologParserFirstLine); - print_key_i( "prologParserLastLine", i->prologParserLastLine); - print_key_s( "prologParserText", i->prologParserText); - print_key_s( "prologParserFile", i->prologParserFile); - print_key_b( "prologConsulting", i->prologConsulting); - print_key_s( "culprit", i->culprit); + print_key_s("errorGoal", i->errorGoal); + print_key_s("classAsText", i->classAsText); + print_key_i("errorLineq", i->errorLine); + print_key_s("errorFunction", i->errorFunction); + print_key_s("errorFile", i->errorFile); + print_key_i("prologPredLine", i->prologPredLine); + print_key_i("prologPredFirstLine", i->prologPredFirstLine); + print_key_i("prologPredLastLine", i->prologPredLastLine); + print_key_s("prologPredName", i->prologPredName); + print_key_i("prologPredArity", i->prologPredArity); + print_key_s("prologPredModule", i->prologPredModule); + print_key_s("prologPredFile", i->prologPredFile); + print_key_i("prologParserPos", i->prologParserPos); + print_key_i("prologParserLine", i->prologParserLine); + print_key_i("prologParserFirstLine", i->prologParserFirstLine); + print_key_i("prologParserLastLine", i->prologParserLastLine); + print_key_s("prologParserText", i->prologParserText); + print_key_s("prologParserFile", i->prologParserFile); + print_key_b("prologConsulting", i->prologConsulting); + print_key_s("culprit", i->culprit); if (i->errorMsgLen) { - print_key_s( "errorMsg", i->errorMsg); - print_key_i( "errorMsgLen", i->errorMsgLen); + print_key_s("errorMsg", i->errorMsg); + print_key_i("errorMsgLen", i->errorMsgLen); } } - -static YAP_Term add_key_b(const char *key, bool v, YAP_Term o0) -{ +static YAP_Term add_key_b(const char *key, bool v, YAP_Term o0) { YAP_Term tkv[2]; tkv[1] = v ? TermTrue : TermFalse; tkv[0] = MkStringTerm(key); - Term node = Yap_MkApplTerm( FunctorEq, 2, tkv); + Term node = Yap_MkApplTerm(FunctorEq, 2, tkv); return MkPairTerm(node, o0); } -static YAP_Term add_key_i(const char *key, YAP_Int v, YAP_Term o0) -{ +static YAP_Term add_key_i(const char *key, YAP_Int v, YAP_Term o0) { YAP_Term tkv[2]; tkv[1] = MkIntegerTerm(v), tkv[0] = MkStringTerm(key); - Term node = Yap_MkApplTerm( FunctorEq, 2, tkv); + Term node = Yap_MkApplTerm(FunctorEq, 2, tkv); return MkPairTerm(node, o0); } - - -static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) -{ +static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) { Term tkv[2]; - if (!v || v[0] == '\0') + if (!v || v[0] == '\0') return o0; tkv[1] = MkStringTerm(v), tkv[0] = MkStringTerm(key); - Term node = Yap_MkApplTerm( FunctorEq, 2, tkv); + Term node = Yap_MkApplTerm(FunctorEq, 2, tkv); return MkPairTerm(node, o0); } @@ -210,38 +205,36 @@ static Term err2list(yap_error_descriptor_t *i) { if (i->errorNo == YAP_NO_ERROR) { return o; } - o = add_key_i( "errorNo", i->errorNo, o ); + o = add_key_i("errorNo", i->errorNo, o); o = add_key_i("errorClass", i->errorClass, o); o = add_key_s("errorAsText", i->errorAsText, o); - o = add_key_s( "errorGoal", i->errorGoal, o); - o = add_key_s( "classAsText", i->classAsText, o); - o = add_key_i( "errorLineq", i->errorLine, o ); - o = add_key_s( "errorFunction", i->errorFunction, o); - o = add_key_s( "errorFile", i->errorFile, o); - o = add_key_i( "prologPredLine", i->prologPredLine, o); - o = add_key_i( "prologPredFirstLine", i->prologPredFirstLine, o); - o = add_key_i( "prologPredLastLine", i->prologPredLastLine, o); - o = add_key_s( "prologPredName", i->prologPredName, o); - o = add_key_i( "prologPredArity", i->prologPredArity, o); - o = add_key_s( "prologPredModule", i->prologPredModule, o); - o = add_key_s( "prologPredFile", i->prologPredFile, o); - o = add_key_i( "prologParserPos", i->prologParserPos, o); - o = add_key_i( "prologParserLine", i->prologParserLine, o); - o = add_key_i( "prologParserFirstLine", i->prologParserFirstLine, o); - o = add_key_i( "prologParserLastLine", i->prologParserLastLine, o); - o = add_key_s( "prologParserText", i->prologParserText, o); - o = add_key_s( "prologParserFile", i->prologParserFile, o); - o = add_key_b( "prologConsulting", i->prologConsulting, o); - o = add_key_s( "culprit", i->culprit, o); + o = add_key_s("errorGoal", i->errorGoal, o); + o = add_key_s("classAsText", i->classAsText, o); + o = add_key_i("errorLineq", i->errorLine, o); + o = add_key_s("errorFunction", i->errorFunction, o); + o = add_key_s("errorFile", i->errorFile, o); + o = add_key_i("prologPredLine", i->prologPredLine, o); + o = add_key_i("prologPredFirstLine", i->prologPredFirstLine, o); + o = add_key_i("prologPredLastLine", i->prologPredLastLine, o); + o = add_key_s("prologPredName", i->prologPredName, o); + o = add_key_i("prologPredArity", i->prologPredArity, o); + o = add_key_s("prologPredModule", i->prologPredModule, o); + o = add_key_s("prologPredFile", i->prologPredFile, o); + o = add_key_i("prologParserPos", i->prologParserPos, o); + o = add_key_i("prologParserLine", i->prologParserLine, o); + o = add_key_i("prologParserFirstLine", i->prologParserFirstLine, o); + o = add_key_i("prologParserLastLine", i->prologParserLastLine, o); + o = add_key_s("prologParserText", i->prologParserText, o); + o = add_key_s("prologParserFile", i->prologParserFile, o); + o = add_key_b("prologConsulting", i->prologConsulting, o); + o = add_key_s("culprit", i->culprit, o); if (i->errorMsgLen) { - o = add_key_s( "errorMsg", i->errorMsg, o); - o = add_key_i( "errorMsgLen", i->errorMsgLen, o); + o = add_key_s("errorMsg", i->errorMsg, o); + o = add_key_i("errorMsgLen", i->errorMsgLen, o); } return o; - } - bool Yap_Warning(const char *s, ...) { CACHE_REGS va_list ap; @@ -254,7 +247,8 @@ bool Yap_Warning(const char *s, ...) { LOCAL_DoingUndefp = true; if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) { - fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s, Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err)); + fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s, + Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); Yap_RestartYap(1); } LOCAL_PrologMode |= InErrorMode; @@ -289,7 +283,8 @@ bool Yap_Warning(const char *s, ...) { return rc; } -void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, Term t, ...) { +void Yap_InitError__(const char *file, const char *function, int lineno, + yap_error_number e, Term t, ...) { CACHE_REGS va_list ap; va_start(ap, t); @@ -331,7 +326,8 @@ bool Yap_PrintWarning(Term twarning) { Term ts[2]; if (LOCAL_PrologMode & InErrorMode) { - fprintf(stderr, "%% ERROR WITHIN ERROR while processing warning: %s\n", Yap_TermToBuffer(twarning, LOCAL_encoding, 0)); + fprintf(stderr, "%% ERROR WITHIN ERROR while processing warning: %s\n", + Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f)); Yap_RestartYap(1); } LOCAL_PrologMode |= InErrorMode; @@ -379,7 +375,8 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, switch (err) { case RESOURCE_ERROR_STACK: if (!Yap_gc(arity, ENV, gc_P(P, CP))) { - Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_STACK, ARG1, serr); + Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_STACK, ARG1, + serr); return false; } return true; @@ -389,14 +386,15 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, } if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { /* crash in flames */ - Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK, ARG1, - serr); + Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK, + ARG1, serr); return false; } return true; case RESOURCE_ERROR_HEAP: if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_HEAP, ARG2, serr); + Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_HEAP, ARG2, + serr); return false; } default: @@ -501,7 +499,7 @@ static char tmpbuf[YAP_BUF_SIZE]; #define ECLASS(CL, A, B) \ case CL: \ - return Yap_LookupAtom(A); \ + return Yap_LookupAtom(A); #define END_ERROR_CLASSES() \ } \ @@ -517,29 +515,30 @@ static char tmpbuf[YAP_BUF_SIZE]; Term ft[2]; \ ft[0] = MkAtomTerm(mkerrorct(B)); \ ft[1] = info; \ - return Yap_MkApplTerm(FunctorError,2,ft); } + return Yap_MkApplTerm(FunctorError, 2, ft); \ + } #define E(A, B, C) \ - case A: \ - { Term ft[2], nt[2]; \ + case A: { \ + Term ft[2], nt[2]; \ nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \ nt[1] = MkVarTerm(); \ Yap_unify(nt[1], culprit); \ - ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B),2), 2, nt); \ + ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \ ft[1] = info; \ - return Yap_MkApplTerm(FunctorError,2,ft); } + return Yap_MkApplTerm(FunctorError, 2, ft); \ + } #define E2(A, B, C, D) \ - case A: \ - { \ + case A: { \ Term ft[2], nt[3]; \ nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \ nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \ nt[2] = MkVarTerm(); \ Yap_unify(nt[2], culprit); \ - ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B),3), 3, nt); \ + ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \ ft[1] = info; \ - return Yap_MkApplTerm(FunctorError,2,ft); \ + return Yap_MkApplTerm(FunctorError, 2, ft); \ } #define END_ERRORS() \ @@ -565,8 +564,6 @@ void Yap_pushErrorContext(yap_error_descriptor_t *new_error) { /* } */ - - yap_error_descriptor_t *Yap_popErrorContext(bool pass) { if (pass && LOCAL_ActiveError->top_error->errorNo == YAP_NO_ERROR && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) @@ -601,7 +598,7 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, } if (LOCAL_RestartEnv) { Yap_RestartYap(5); - } + } Yap_exit(5); } @@ -638,8 +635,8 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, * * + i=i(Comment): an user-written comment on this bug. */ -yamop *Yap_Error__(bool throw, const char *file, const char *function, int lineno, - yap_error_number type, Term where, ...) { +yamop *Yap_Error__(bool throw, const char *file, const char *function, + int lineno, yap_error_number type, Term where, ...) { CACHE_REGS va_list ap; char *fmt; @@ -648,7 +645,9 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen /* disallow recursive error handling */ if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) { - fprintf(stderr, "%% ERROR %s %s WITHIN ERROR %s %s\n", Yap_errorClassName( Yap_errorClass(type)), Yap_errorName(type), Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err)); + fprintf(stderr, "%% ERROR %s %s WITHIN ERROR %s %s\n", + Yap_errorClassName(Yap_errorClass(type)), Yap_errorName(type), + Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); Yap_RestartYap(1); } if (LOCAL_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) { @@ -656,7 +655,13 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen CalculateStackGap(PASS_REGS1); return P; } - LOCAL_ActiveError->errorNo = type; + if (where == 0L || where == TermNil) { + LOCAL_ActiveError->culprit = NULL; + } else { + LOCAL_ActiveError->culprit = Yap_TermToBuffer( + where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + } + LOCAL_ActiveError->errorNo = type; LOCAL_ActiveError->errorAsText = Yap_errorName(type); LOCAL_ActiveError->errorClass = Yap_errorClass(type); LOCAL_ActiveError->classAsText = @@ -674,28 +679,21 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen #if DEBUG_STRICT if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode)) fprintf(stderr, "***** Processing Error %d (%lx,%x) %s***\n", type, - (unsigned long int)LOCAL_Signals, LOCAL_PrologMode, fmt); + (unsigned long int)LOCAL_Signals, LOCAL_PrologMode, fmt); else fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type, - LOCAL_PrologMode, fmt); + LOCAL_PrologMode, fmt); #endif if (type == INTERRUPT_EVENT) { fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n", - (int) IntOfTerm(where)); - LOCAL_PrologMode &= ~InErrorMode; + (int)IntOfTerm(where)); Yap_exit(1); } - if (where == 0L || where == TermNil) { - LOCAL_ActiveError->culprit = NULL; - } else { - LOCAL_ActiveError->culprit = Yap_TermToBuffer(where, LOCAL_encoding, Quote_illegal_f | Handle_vars_f); - - } va_start(ap, where); fmt = va_arg(ap, char *); if (fmt != NULL) { #if HAVE_VSNPRINTF - (void) vsnprintf(s, MAXPATHLEN - 1, fmt, ap); + (void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap); #else (void)vsprintf(s, fmt, ap); #endif @@ -717,7 +715,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen if (where == 0 || where == TermNil) { LOCAL_ActiveError->culprit = 0; } - if (P == (yamop *) (FAILCODE)) { + if (P == (yamop *)(FAILCODE)) { LOCAL_PrologMode &= ~InErrorMode; return P; } @@ -740,8 +738,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen if (LOCAL_PrologMode & BootMode) { /* crash in flames! */ fprintf(stderr, - "%s:%d:0 YAP Fatal Error %d in function %s:\n %s exiting....\n", - file, lineno, type, function, s); + "%s:%d:0 YAP Fatal Error %d in function %s:\n %s exiting....\n", + file, lineno, type, function, s); error_exit_yap(1); } #ifdef DEBUG @@ -757,7 +755,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen } else { Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE); if (tmpbuf[0]) { - fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf); + fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf); } #if HAVE_BACKTRACE void *callstack[256]; @@ -766,7 +764,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen char **strs = backtrace_symbols(callstack, frames); fprintf(stderr, "Execution stack:\n"); for (i = 0; i < frames; ++i) { - fprintf(stderr, " %s\n", strs[i]); + fprintf(stderr, " %s\n", strs[i]); } free(strs); #endif @@ -832,12 +830,12 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen it's up to her to decide */ if (LOCAL_DoingUndefp) { - LOCAL_Signals = 0; + LOCAL_Signals = 0; Yap_PrintWarning(MkErrorTerm(Yap_GetException())); return P; } LOCAL_CommittedError = Yap_GetException(); - //reset_error_description(); + // reset_error_description(); if (!throw) { Yap_JumpToEnv(); } @@ -918,19 +916,18 @@ const char *Yap_errorClassName(yap_error_class_number e) { return c_error_class_name[e]; } -yap_error_descriptor_t * Yap_GetException(void) { +yap_error_descriptor_t *Yap_GetException(void) { CACHE_REGS if (LOCAL_ActiveError->errorNo != YAP_NO_ERROR) { - yap_error_descriptor_t *t = LOCAL_ActiveError, *nt = malloc(sizeof(yap_error_descriptor_t)); - memcpy(nt,t,sizeof(yap_error_descriptor_t)); - return t; + yap_error_descriptor_t *t = LOCAL_ActiveError, + *nt = malloc(sizeof(yap_error_descriptor_t)); + memcpy(nt, t, sizeof(yap_error_descriptor_t)); + return nt; } return 0; } -void Yap_PrintException(void) { - printErr(LOCAL_ActiveError); -} +void Yap_PrintException(void) { printErr(LOCAL_ActiveError); } bool Yap_RaiseException(void) { if (LOCAL_ActiveError->errorNo == YAP_NO_ERROR) @@ -940,7 +937,7 @@ bool Yap_RaiseException(void) { bool Yap_ResetException(yap_error_descriptor_t *i) { // reset error descriptor - if(!i) + if (!i) return true; yap_error_descriptor_t *bf = i->top_error; memset(i, 0, sizeof(*i)); @@ -950,11 +947,12 @@ bool Yap_ResetException(yap_error_descriptor_t *i) { static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } -Term MkErrorTerm(yap_error_descriptor_t *t) -{ +Term MkErrorTerm(yap_error_descriptor_t *t) { if (t->errorNo == THROW_EVENT) return t->errorRawTerm; - return mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), err2list(t)); + return mkerrort(t->errorNo, + Yap_BufferToTerm(t->culprit, TermNil), + err2list(t)); } static Int read_exception(USES_REGS1) { @@ -967,12 +965,12 @@ static Int read_exception(USES_REGS1) { static Int query_exception(USES_REGS1) { const char *query; Term t; - + if (IsAtomTerm((t = Deref(ARG1)))) query = RepAtom(AtomOfTerm(t))->StrOfAE; if (IsStringTerm(t)) query = StringOfTerm(t); - if (!IsAddressTerm(Deref(ARG1))) + if (!IsAddressTerm(Deref(ARG2))) return false; yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2)); Term t3 = Deref(ARG3); @@ -985,74 +983,125 @@ static Int query_exception(USES_REGS1) { } } - static Int drop_exception(USES_REGS1) { yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); free(t); return true; -} - +} static Int new_exception(USES_REGS1) { Term t = MkSysError(malloc(sizeof(yap_error_descriptor_t))); - return Yap_unify(ARG1,t); -} - + return Yap_unify(ARG1, t); +} static Int get_exception(USES_REGS1) { yap_error_descriptor_t *i; Term t; - + i = LOCAL_CommittedError; if (i && i->errorNo != YAP_NO_ERROR) { if (i->errorNo == THROW_EVENT) t = i->errorRawTerm; - else - t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit, TermNil), MkSysError(i)); - Yap_ResetException(i); + else if (i->culprit != NULL) { + t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit,TermNil), + MkSysError(i)); + } else { + t = mkerrort(i->errorNo, TermNil, MkSysError(i)); + } + Yap_ResetException(LOCAL_ActiveError); LOCAL_CommittedError = NULL; - Int rc= Yap_unify(t, ARG1); + Int rc = Yap_unify(t, ARG1); return rc; } return false; } +yap_error_descriptor_t *Yap_UserError(Term t, yap_error_descriptor_t *i) { + Term t1, t2; + t1 = ArgOfTerm(1, t); + t2 = ArgOfTerm(2, t); + char ename[65]; -yap_error_descriptor_t *Yap_UserError( Term t, Term t1, yap_error_descriptor_t *i) { - Term t2; - Functor f = FunctorOfTerm(t); - LOCAL_ActiveError->culprit = Yap_TermToBuffer(ArgOfTerm(1, t), LOCAL_encoding, 0); - if (ArityOfFunctor(f) == 2) { - LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(ArgOfTerm(2, t), LOCAL_encoding, 0); - } - Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS); // LOCAL_Error_TYPE = ERROR_EVENT; - if (IsApplTerm(t1) && IsAtomTerm((t2 = ArgOfTerm(1, t1)))) { - LOCAL_ActiveError->errorAsText = RepAtom(AtomOfTerm(t2))->StrOfAE; - LOCAL_ActiveError->classAsText = RepAtom(NameOfFunctor(FunctorOfTerm(t1)))->StrOfAE; - } else if (IsAtomTerm(t1)) { - LOCAL_ActiveError->errorAsText = RepAtom(AtomOfTerm(t1))->StrOfAE; - LOCAL_ActiveError->classAsText = NULL; - } LOCAL_ActiveError->errorNo = USER_EVENT; LOCAL_ActiveError->errorClass = EVENT; - int j; - for (j=0; j < sizeof(c_error_list)/sizeof(struct c_error_info); j++) { - if (!strcmp(c_error_list[j].name,LOCAL_ActiveError->errorAsText) && - (c_error_list[j].class == 0 || - !strcmp(LOCAL_ActiveError->classAsText,c_error_class_name[c_error_list[j].class]))) - { - LOCAL_ActiveError->errorNo = j; - LOCAL_ActiveError->errorClass = c_error_list[j].class; - - break; + if (IsApplTerm(t1)) { + Functor f1 = FunctorOfTerm(t1); + arity_t a1 = ArityOfFunctor(f1); + LOCAL_ActiveError->culprit = + Yap_TermToBuffer(ArgOfTerm(a1, t1), ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + if (a1 == 1) { + return NULL; + } else { + Term ti; + if (!IsAtomTerm((ti = ArgOfTerm(1, t1)))) + return NULL; + strncpy(ename, RepAtom(AtomOfTerm(ti))->StrOfAE, 64); + } + if (a1 == 3) { + Term ti; + if (!IsAtomTerm((ti = ArgOfTerm(2, t1)))) + return NULL; + strncat(ename, " ", 64); + strncat(ename, RepAtom(AtomOfTerm(ti))->StrOfAE, 64); + } else if (a1 > 3) { + return NULL; + } + LOCAL_ActiveError->errorAsText = ename; + LOCAL_ActiveError->classAsText = RepAtom(NameOfFunctor(f1))->StrOfAE; + int j; + for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) { + if (!strcmp(c_error_list[j].name, LOCAL_ActiveError->errorAsText) && + (c_error_list[j].class == 0 || + !strcmp(LOCAL_ActiveError->classAsText, + c_error_class_name[c_error_list[j].class]))) { + if (c_error_list[j].class != PERMISSION_ERROR || + (t1 = ArgOfTerm(2, t1) && IsAtomTerm(t1) && + !strcmp(c_error_list[j].name, + RepAtom(AtomOfTerm(t1))->StrOfAE))) { + LOCAL_ActiveError->errorNo = j; + LOCAL_ActiveError->errorClass = c_error_list[j].class; + break; + } + } + } + } else if (IsAtomTerm(t1)) { + const char *err = RepAtom(AtomOfTerm(t1))->StrOfAE; + if (!strcmp(err, "instantiation_error")) { + LOCAL_ActiveError->errorClass = INSTANTIATION_ERROR_CLASS; + LOCAL_ActiveError->classAsText = "instantiation_error"; + LOCAL_ActiveError->errorAsText = "instantiation_error"; + LOCAL_ActiveError->errorNo = INSTANTIATION_ERROR; + } else if (!strcmp(err, "uninstantiation_error")) { + LOCAL_ActiveError->errorClass = UNINSTANTIATION_ERROR_CLASS; + LOCAL_ActiveError->classAsText = "uninstantiation_error"; + LOCAL_ActiveError->errorAsText = "uninstantiation_error"; + LOCAL_ActiveError->errorNo = UNINSTANTIATION_ERROR; } } - Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS1); - return - LOCAL_ActiveError; + while (IsPairTerm(t2)) { + Term hd = HeadOfTerm(t2); + if (IsPairTerm(hd)) { + Term hdhd = HeadOfTerm(hd); + Term hdtl = TailOfTerm(hd); + if (hdhd == Termg) { + Term n = ArgOfTerm(1,hdtl); + + LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + } + + } + t2 = TailOfTerm(t2); + } + Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS); + { + char *errs = malloc(strlen(LOCAL_ActiveError->errorAsText)+1); + strcpy(errs, LOCAL_ActiveError->errorAsText); + LOCAL_ActiveError->errorAsText = errs; + } + return LOCAL_ActiveError; } - + static Int is_boolean(USES_REGS1) { Term t = Deref(ARG1); // Term Context = Deref(ARG2)Yap_Error(INSTANTIATION_ERROR, t, NULL);; @@ -1084,21 +1133,21 @@ static Int is_callable(USES_REGS1) { if (IsApplTerm(G)) { Functor f = FunctorOfTerm(G); if (IsExtensionFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); + Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); } if (f == FunctorModule) { - Term tm = ArgOfTerm(1, G); - if (IsVarTerm(tm)) { - Yap_Error(INSTANTIATION_ERROR, G, NULL); - return false; - } - if (!IsAtomTerm(tm)) { - Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); - return false; - } - G = ArgOfTerm(2, G); + Term tm = ArgOfTerm(1, G); + if (IsVarTerm(tm)) { + Yap_Error(INSTANTIATION_ERROR, G, NULL); + return false; + } + if (!IsAtomTerm(tm)) { + Yap_Error(TYPE_ERROR_CALLABLE, G, NULL); + return false; + } + G = ArgOfTerm(2, G); } else { - return true; + return true; } } else if (IsPairTerm(G) || IsAtomTerm(G)) { return true; @@ -1150,5 +1199,5 @@ void Yap_InitErrorPreds(void) { Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag); Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag); Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator, - TestPredFlag); + TestPredFlag); } diff --git a/C/exec.c b/C/exec.c index f51de5e92..85b3b757f 100755 --- a/C/exec.c +++ b/C/exec.c @@ -2055,15 +2055,12 @@ bool Yap_JumpToEnv(void) { /* This does very nasty stuff!!!!! */ static Int jump_env(USES_REGS1) { - Term t = Deref(ARG1), t0 = t, t1; + Term t = Deref(ARG1), t0 = t; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound"); return false; - } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError - && (t1 = ArgOfTerm(1, t)) - && IsPairTerm((t = ArgOfTerm(2, t))) - && IsApplTerm((t = HeadOfTerm(t)))) { - LOCAL_ActiveError = Yap_UserError(t, t1, LOCAL_ActiveError); + } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) { + LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); } else { LOCAL_Error_TYPE = THROW_EVENT; LOCAL_ActiveError->errorAsText = NULL; diff --git a/C/init.c b/C/init.c index a5291fb94..e2edae3eb 100755 --- a/C/init.c +++ b/C/init.c @@ -165,8 +165,10 @@ The following is the list of the declarations of the predefined operators: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ :-op(1200,fx,['?-', ':-']). :-op(1200,xfx,[':-','-->']). -:-op(1150,fx,[block,dynamic,mode,public,multifile,meta_predicate, - sequential,table,initialization]). +:-op(1150,fx,[block, + discontiguous,dynamic, + initialization,mode,multifile,meta_predicate, + public,sequential,table]). :-op(1100,xfy,[';','|']). :-op(1050,xfy,->). :-op(1000,xfy,','). diff --git a/C/stack.c b/C/stack.c index b736cd92e..1d2988a85 100644 --- a/C/stack.c +++ b/C/stack.c @@ -67,13 +67,13 @@ static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *); static StaticIndex *find_owner_static_index(StaticIndex *, yamop *); -#define IN_BLOCK(P, B, SZ) \ +#define IN_BLOCK(P, B, SZ) \ ((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ)) static PredEntry *get_pred(Term t, Term tmod, char *pname) { Term t0 = t; -restart: + restart: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t0, pname); return NULL; @@ -209,7 +209,7 @@ static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) { * * usually pretty straightforward, it can fall in trouble with 8 OR-P or tabling. - */ +*/ PredEntry *Yap_PredForChoicePt(choiceptr cp, op_numbers *op) { if (cp == NULL) return NULL; @@ -268,8 +268,8 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p, /* check first environments that are younger than our latest choicepoint */ if (check_everything && env_ptr) { /* - I do not need to check environments for asserts, - only for retracts + I do not need to check environments for asserts, + only for retracts */ while (env_ptr && b_ptr > (choiceptr)env_ptr) { yamop *cp = (yamop *)env_ptr[E_CP]; @@ -538,69 +538,69 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, } /* -static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry *pp) { + static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry *pp) { CACHE_REGS if (pp->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = clcode; + LogUpdClause *cl = clcode; - if (cl->ClFlags & FactMask) { - t->prologPredLine = cl->lusl.ClLine; - } else { - t->prologPredLine = cl->lusl.ClSource->ag.line_number; - } - } else if (pp->PredFlags & DynamicPredFlag) { - // DynamicClause *cl; - // cl = ClauseCodeToDynamicClause(clcode); - - return false; - } else if (pp->PredFlags & MegaClausePredFlag) { - MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); - t->prologPredLine = mcl->ClLine; + if (cl->ClFlags & FactMask) { + t->prologPredLine = cl->lusl.ClLine; } else { - StaticClause *cl; - cl = clcode; - if (cl->ClFlags & FactMask) { - t->prologPredLine = cl->usc.ClLine; - } else if (cl->ClFlags & SrcMask) { - t->prologPredLine = cl->usc.ClSource->ag.line_number; - } else - return MkIntTerm(0); + t->prologPredLine = cl->lusl.ClSource->ag.line_number; + } + } else if (pp->PredFlags & DynamicPredFlag) { + // DynamicClause *cl; + // cl = ClauseCodeToDynamicClause(clcode); + + return false; + } else if (pp->PredFlags & MegaClausePredFlag) { + MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); + t->prologPredLine = mcl->ClLine; + } else { + StaticClause *cl; + cl = clcode; + if (cl->ClFlags & FactMask) { + t->prologPredLine = cl->usc.ClLine; + } else if (cl->ClFlags & SrcMask) { + t->prologPredLine = cl->usc.ClSource->ag.line_number; + } else + return MkIntTerm(0); } return MkIntTerm(0); -} + } */ static Term clause_loc(void *clcode, PredEntry *pp) { CACHE_REGS - if (pp->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = clcode; + if (pp->PredFlags & LogUpdatePredFlag) { + LogUpdClause *cl = clcode; - if (cl->ClFlags & FactMask) { - return MkIntegerTerm(cl->lusl.ClLine); - } else { - return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); - } - } else if (pp->PredFlags & DynamicPredFlag) { - // DynamicClause *cl; - // cl = ClauseCodeToDynamicClause(clcode); + if (cl->ClFlags & FactMask) { + return MkIntegerTerm(cl->lusl.ClLine); + } else { + return MkIntegerTerm(cl->lusl.ClSource->ag.line_number); + } + } else if (pp->PredFlags & DynamicPredFlag) { + // DynamicClause *cl; + // cl = ClauseCodeToDynamicClause(clcode); - return MkIntTerm(0); - } else if (pp->PredFlags & MegaClausePredFlag) { - MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); - return MkIntTerm(mcl->ClLine); - } else { - StaticClause *cl; - cl = clcode; - - if (cl->ClFlags & FactMask) { - return MkIntTerm(cl->usc.ClLine); - } else if (cl->ClFlags & SrcMask) { - return MkIntTerm(cl->usc.ClSource->ag.line_number); - } else return MkIntTerm(0); - } + } else if (pp->PredFlags & MegaClausePredFlag) { + MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause); + return MkIntTerm(mcl->ClLine); + } else { + StaticClause *cl; + cl = clcode; + + if (cl->ClFlags & FactMask) { + return MkIntTerm(cl->usc.ClLine); + } else if (cl->ClFlags & SrcMask) { + return MkIntTerm(cl->usc.ClSource->ag.line_number); + } else + return MkIntTerm(0); + } return MkIntTerm(0); } @@ -613,15 +613,15 @@ static int cl_code_in_pred(PredEntry *pp, yamop *codeptr, void **startp, if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { if (code_in_pred_lu_index( - ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - startp, endp)) { + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { UNLOCK(pp->PELock); return TRUE; } } else { if (code_in_pred_s_index( - ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - startp, endp)) { + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + startp, endp)) { UNLOCK(pp->PELock); return TRUE; } @@ -658,16 +658,16 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, if (pp->PredFlags & IndexedPredFlag) { if (pp->PredFlags & LogUpdatePredFlag) { if (code_in_pred_lu_index( - ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - NULL, NULL)) { + ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { code_in_pred_info(pp, pat, parity); UNLOCK(pp->PELock); return -1; } } else { if (code_in_pred_s_index( - ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, - NULL, NULL)) { + ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr, + NULL, NULL)) { code_in_pred_info(pp, pat, parity); UNLOCK(pp->PELock); return -1; @@ -820,8 +820,8 @@ static PredEntry *found_owner_op(yamop *pc, void **startp, static PredEntry *found_expand(yamop *pc, void **startp, void **endp USES_REGS) { PredEntry *pp = - ((PredEntry *)(Unsigned(pc) - - (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); + ((PredEntry *)(Unsigned(pc) - + (CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode)))); *startp = (CODEADDR) & (pp->cs.p_code.ExpandCode); *endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e); return pp; @@ -897,19 +897,19 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp, PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from, void **startp, void **endp) { CACHE_REGS - if (where_from == FIND_PRED_FROM_CP) { - PredEntry *pp = PredForChoicePt(codeptr, NULL); - if (cl_code_in_pred(pp, codeptr, startp, endp)) { - return pp; + if (where_from == FIND_PRED_FROM_CP) { + PredEntry *pp = PredForChoicePt(codeptr, NULL); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else if (where_from == FIND_PRED_FROM_ENV) { + PredEntry *pp = EnvPreg(codeptr); + if (cl_code_in_pred(pp, codeptr, startp, endp)) { + return pp; + } + } else { + return ClauseInfoForCode(codeptr, startp, endp PASS_REGS); } - } else if (where_from == FIND_PRED_FROM_ENV) { - PredEntry *pp = EnvPreg(codeptr); - if (cl_code_in_pred(pp, codeptr, startp, endp)) { - return pp; - } - } else { - return ClauseInfoForCode(codeptr, startp, endp PASS_REGS); - } return NULL; } @@ -1096,7 +1096,7 @@ static Int p_all_envs(USES_REGS1) { static Term clause_info(yamop *codeptr, PredEntry *pp) { CACHE_REGS - Term ts[2]; + Term ts[2]; void *begin; if (pp->ArityOfPE == 0) { @@ -1122,20 +1122,20 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) { yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) { CACHE_REGS - Term ts[2]; + Term ts[2]; void *begin; if (pp->ArityOfPE == 0) { t->prologPredName = - AtomName((Atom)pp->FunctorOfPred); + AtomName((Atom)pp->FunctorOfPred); t->prologPredArity = 0; } else { t->prologPredName = - AtomName(NameOfFunctor(pp->FunctorOfPred)); + AtomName(NameOfFunctor(pp->FunctorOfPred)); t->prologPredArity = pp->ArityOfPE; } t->prologPredModule = - (pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE - : "prolog"); + (pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE + : "prolog"); t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE; if (codeptr->opc == UNDEF_OPCODE) { t->prologPredFirstLine = 0; @@ -1144,28 +1144,32 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod return t; } else if (pp->cs.p_code.NOfClauses) { if ((t->prologPredCl = - find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { - t->prologPredLine = 0; + find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { + t->prologPredLine = 0; } else { t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp)); } if (pp->PredFlags & LogUpdatePredFlag) { t->prologPredFirstLine = clause_loc( - ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp); + ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp); t->prologPredLastLine = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), - pp); + pp); } else { t->prologPredFirstLine = IntegerOfTerm( - ts[0] = clause_loc( - ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp)); + ts[0] = clause_loc( + ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp)); t->prologPredLastLine = IntegerOfTerm( - ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause), - pp)); + ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause), + pp)); } return t; } else { - return NULL; + t->prologPredFirstLine = 0; + t->prologPredLine = t->errorLine; + t->prologPredLastLine = 0; + t->prologPredFile = t->errorFile; + return t; } } @@ -1203,23 +1207,33 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R } else { CELL *curENV = ENV; yamop *curCP = CP; + choiceptr curB; PredEntry *pe = EnvPreg(curCP); - while (curCP != YESCODE) { - curENV = (CELL *)(curENV[E_E]); - if (curENV < ASP || curENV >= LCL0) { - break; + while (curCP != YESCODE && curB) { + if (curENV < (CELL *)curB) { + pe = EnvPreg(curCP); + curENV = (CELL *)(curENV[E_E]); + if (curENV < ASP || curENV >= LCL0) { + break; + } + curCP = (yamop *)curENV[E_CP]; + if (pe == NULL) { + pe = PredMetaCall; + } + if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)) + return set_clause_info(t, curCP, pe); + } else { + pe = curB->cp_ap->y_u.Otapl.p; + if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))) + return set_clause_info(t, curB->cp_ap, pe); + curB = curB->cp_b; } - pe = EnvPreg(curCP); - if (pe == NULL) { - pe = PredMetaCall; - } - if (pe->ModuleOfPred) - return set_clause_info(t, curCP, pe); - curCP = (yamop *)(curENV[E_CP]); } + curCP = (yamop *)(curENV[E_CP]); } - return NULL; + +return NULL; } static Term all_calls(bool internal USES_REGS) { @@ -1253,7 +1267,7 @@ static Term all_calls(bool internal USES_REGS) { Term Yap_all_calls(void) { CACHE_REGS - return all_calls(true PASS_REGS); + return all_calls(true PASS_REGS); } static Int current_stack(USES_REGS1) { @@ -1372,23 +1386,23 @@ void Yap_dump_code_area_for_profiler(void) { while (pp != NULL) { /* if (pp->ArityOfPE) { - fprintf(stderr,"%s/%d %p\n", - RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE, - pp->ArityOfPE, - pp); - } else { - fprintf(stderr,"%s %p\n", - RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE, - pp); - }*/ + fprintf(stderr,"%s/%d %p\n", + RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE, + pp->ArityOfPE, + pp); + } else { + fprintf(stderr,"%s %p\n", + RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE, + pp); + }*/ add_code_in_pred(pp); pp = pp->NextPredOfModule; } me = me->NextME; } Yap_inform_profiler_of_clause( - COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), - GPROF_INIT_COMMA); + COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)), + GPROF_INIT_COMMA); Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1, RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)), GPROF_INIT_FAIL); @@ -1421,7 +1435,7 @@ static Int program_continuation(USES_REGS1) { static Term BuildActivePred(PredEntry *ap, CELL *vect) { CACHE_REGS - arity_t i; + arity_t i; if (!ap->ArityOfPE) { return MkAtomTerm((Atom)ap->FunctorOfPred); @@ -1469,8 +1483,8 @@ static int UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) { } return Yap_unify(XREGS[start_arg], tmod) && - Yap_unify(XREGS[start_arg + 1], tname) && - Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); + Yap_unify(XREGS[start_arg + 1], tname) && + Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity)); } static Int ClauseId(yamop *ipc, PredEntry *pe) { @@ -1492,7 +1506,7 @@ static Int env_info(USES_REGS1) { /* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */ taddr = MkIntegerTerm((Int)env); return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) && - Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b); + Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b); } static Int p_cpc_info(USES_REGS1) { @@ -1501,7 +1515,7 @@ static Int p_cpc_info(USES_REGS1) { pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0; return UnifyPredInfo(pe, 2 PASS_REGS) && - Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe))); + Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe))); } static Int p_choicepoint_info(USES_REGS1) { @@ -1542,10 +1556,10 @@ static Int p_choicepoint_info(USES_REGS1) { t = MkVarTerm(); } else #endif /* DETERMINISTIC_TABLING */ - { - pe = GEN_CP(cptr)->cp_pred_entry; - t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); - } + { + pe = GEN_CP(cptr)->cp_pred_entry; + t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1)); + } #else pe = UndefCode; t = MkVarTerm(); @@ -1681,8 +1695,8 @@ static Int p_choicepoint_info(USES_REGS1) { } } return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) && - Yap_unify(ARG6, t) && - Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); + Yap_unify(ARG6, t) && + Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe))); } static Int /* $parent_pred(Module, Name, Arity) */ @@ -1694,11 +1708,11 @@ parent_pred(USES_REGS1) { Term module; if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) { return Yap_unify(ARG1, MkIntTerm(0)) && - Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && - Yap_unify(ARG3, MkIntTerm(0)); + Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) && + Yap_unify(ARG3, MkIntTerm(0)); } return Yap_unify(ARG1, MkIntTerm(module)) && - 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); @@ -1709,7 +1723,7 @@ static int hidden(Atom); static int legal_env(CELL *CACHE_TYPE); -#define ONLOCAL(ptr) \ +#define ONLOCAL(ptr) \ (CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase)) static int hidden(Atom at) { @@ -1768,7 +1782,7 @@ static bool handled_exception(USES_REGS1) { void Yap_dump_stack(void) { CACHE_REGS - choiceptr b_ptr = B; + choiceptr b_ptr = B; CELL *env_ptr = ENV; char tp[256]; yamop *ipc = CP; @@ -1834,7 +1848,7 @@ void Yap_dump_stack(void) { #endif fprintf(stderr, "%% All Active Calls and\n"); fprintf(stderr, "%% Goals With Alternatives Open (Global In " - "Use--Local In Use)\n%%\n"); + "Use--Local In Use)\n%%\n"); while (b_ptr != NULL) { while (env_ptr && env_ptr <= (CELL *)b_ptr) { Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256); @@ -2032,10 +2046,10 @@ void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) { static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop *codeptr, PredEntry *pe) { CACHE_REGS - if (pe->ModuleOfPred == PROLOG_MODULE) - p->prologPredModule = AtomName(AtomProlog); - else - p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred)); + if (pe->ModuleOfPred == PROLOG_MODULE) + p->prologPredModule = AtomName(AtomProlog); + else + p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred)); if (pe->ArityOfPE) p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred)); else @@ -2078,7 +2092,7 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { p->prologPredFile = "undefined"; - } + } else { // by default, user_input p->prologPredFile = AtomName( AtomUserIn ); @@ -2093,7 +2107,7 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc // choiceptr b_ptr = b_ptr0; //CELL *env = env0; - PredEntry *pe; + PredEntry *pe; if (PP == NULL) { if (PredForCode(xc, NULL, NULL, NULL, &pe) <= 0) return NULL; @@ -2102,67 +2116,67 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc if (pe != NULL // pe->ModuleOfPred != PROLOG_MODULE && // &&!(pe->PredFlags & HiddenPredFlag) - ) { + ) { return add_bug_location(t, xc, pe); } return NULL; } yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0, void *b_ptr0, void *env0, YAP_Int ignore_first) { - yamop *cp = cp0; - choiceptr b_ptr = b_ptr0; - CELL *env = env0; - while (true) { - if (b_ptr == NULL || env == NULL) - return NULL; - PredEntry *pe = EnvPreg(cp); - if (pe == PredTrue) - return NULL; - if (ignore_first <= 0 && - pe - // pe->ModuleOfPred != PROLOG_MODULE &&s - && !(pe->PredFlags & HiddenPredFlag)) { - return add_bug_location(t, cp, pe); - } else { - if (NULL && b_ptr && b_ptr->cp_env < env) { - cp = b_ptr->cp_cp; - env = b_ptr->cp_env; - b_ptr = b_ptr->cp_b; - } else { - cp = (yamop *)env[E_CP]; - env = ENV_Parent(env); - } - ignore_first--; - } - } + yamop *cp = cp0; + choiceptr b_ptr = b_ptr0; + CELL *env = env0; + while (true) { + if (b_ptr == NULL || env == NULL) + return NULL; + PredEntry *pe = EnvPreg(cp); + if (pe == PredTrue) + return NULL; + if (ignore_first <= 0 && + pe + // pe->ModuleOfPred != PROLOG_MODULE &&s + && !(pe->PredFlags & HiddenPredFlag)) { + return add_bug_location(t, cp, pe); + } else { + if (NULL && b_ptr && b_ptr->cp_env < env) { + cp = b_ptr->cp_cp; + env = b_ptr->cp_env; + b_ptr = b_ptr->cp_b; + } else { + cp = (yamop *)env[E_CP]; + env = ENV_Parent(env); + } + ignore_first--; } + } +} /* - Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) { - while (true) { - if (b_ptr == NULL || env == NULL) - return TermNil; - PredEntry *pe = EnvPreg(cp); - if (pe == PredTrue) - return TermNil; - if (ignore_first <= 0 && - pe - // pe->ModuleOfPred != PROLOG_MODULE &&s - && !(pe->PredFlags & HiddenPredFlag)) { - return add_bug_location(cp, pe); - } else { - if (NULL && b_ptr && b_ptr->cp_env < env) { - cp = b_ptr->cp_cp; - env = b_ptr->cp_env; - b_ptr = b_ptr->cp_b; - } else { - cp = (yamop *)env[E_CP]; - env = ENV_Parent(env); - } - ignore_first--; - } - } - } + Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) { + while (true) { + if (b_ptr == NULL || env == NULL) + return TermNil; + PredEntry *pe = EnvPreg(cp); + if (pe == PredTrue) + return TermNil; + if (ignore_first <= 0 && + pe + // pe->ModuleOfPred != PROLOG_MODULE &&s + && !(pe->PredFlags & HiddenPredFlag)) { + return add_bug_location(cp, pe); + } else { + if (NULL && b_ptr && b_ptr->cp_env < env) { + cp = b_ptr->cp_cp; + env = b_ptr->cp_env; + b_ptr = b_ptr->cp_b; + } else { + cp = (yamop *)env[E_CP]; + env = ENV_Parent(env); + } + ignore_first--; + } + } + } */ static Term mkloc(yap_error_descriptor_t *t) @@ -2180,15 +2194,15 @@ static Int clause_location(USES_REGS1) { static Int ancestor_location(USES_REGS1) { yap_error_descriptor_t t; memset( &t, 0, sizeof(yap_error_descriptor_t)); -return -Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 2)), ARG2) && + return + Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 2)), ARG2) && Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 3)), ARG2); } void Yap_InitStInfo(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("in_use", 2, in_use, HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag); diff --git a/C/threads.c b/C/threads.c index ab6409dab..7360251e7 100644 --- a/C/threads.c +++ b/C/threads.c @@ -1756,7 +1756,7 @@ p_new_mutex(void) p_with_mutex( USES_REGS1 ) { Int mut; - Term t1 = Deref(ARG1), excep; + Term t1 = Deref(ARG1); Int rc = FALSE; Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); PredEntry *pe; @@ -1813,11 +1813,11 @@ p_new_mutex(void) } end: ARG1 = MkIntegerTerm(mut); - excep = Yap_GetException(); + yap_error_descriptor_t *err = Yap_GetException(); if (creeping) { Yap_signal( YAP_CREEP_SIGNAL ); - } else if ( excep != 0) { - LOCAL_ActiveError->errorNo = IntegerOfTerm(excep); + } else if ( err ) { + LOCAL_ActiveError->errorNo = err->errorNo; return Yap_JumpToEnv(); } return rc; diff --git a/C/write.c b/C/write.c index 2a1a6b5fe..0691dea5d 100644 --- a/C/write.c +++ b/C/write.c @@ -1258,6 +1258,8 @@ char *Yap_TermToBuffer(Term t, encoding_t enc, int flags) { if (sno < 0) return NULL; + if (t == 0) + return NULL; if (enc) GLOBAL_Stream[sno].encoding = enc; else diff --git a/C/yap-args.c b/C/yap-args.c index d9ab1906c..a5beb4889 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -203,10 +203,11 @@ static void consult(const char *b_file USES_REGS) { } else { YAP_CompileClause(t); } - Term terr; - Yap_PrintException(); - if ((terr = Yap_GetException())) - fprintf(stderr,"Exception Found\n"); + yap_error_descriptor_t *errd; + if ((errd = Yap_GetException())) { + fprintf(stderr, "%s:%ld:0: Error %s %s Found\n", errd->errorFile, (long int) errd->errorLine, errd->classAsText, + errd->errorAsText); + } } while (t != TermEof); BACKUP_MACHINE_REGS(); YAP_EndConsult(c_stream, &osno, full); diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 047e25861..86a1dfe6d 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -646,7 +646,6 @@ bool YAPQuery::next() { CACHE_REGS bool result = false; sigjmp_buf buf, *oldp = LOCAL_RestartEnv; - Term terr; e = nullptr; BACKUP_MACHINE_REGS(); if (!q_open) diff --git a/H/ATOMS b/H/ATOMS index 9ab1378a0..83517881a 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -171,6 +171,7 @@ A Full N "full" A Functor N "functor" A GT N ">" A GVar N "var" +A g N "g" A Gc F "$gc" A GcMargin F "$gc_margin" A GcTrace F "$gc_trace" @@ -429,6 +430,7 @@ A User N "user" A UserErr N "user_error" A UserIn N "user_input" A UserOut N "user_output" +A UTF8 N "utf8" A DollarVar N "$VAR" A VBar N "|" A VarBranches N "var_branches" @@ -504,6 +506,7 @@ F Dot9 Dot 9 F DoubleArrow DoubleArrow 2 F DoubleSlash DoubleSlash 2 F EmptySquareBrackets EmptySquareBrackets 2 +F Encoding Encoding 1 F Eq Eq 2 F Error Error 2 F EvaluationError EvaluationError 1 diff --git a/H/Yatom.h b/H/Yatom.h index bdb62e0e2..0c8857c84 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1615,7 +1615,7 @@ INLINE_ONLY inline EXTERN Term MkSysError(yap_error_descriptor_t *i) { Term et = MkAddressTerm(i); return Yap_MkApplTerm( FunctorException, 1, &et); } -yap_error_descriptor_t *Yap_UserError( Term t, Term t1, yap_error_descriptor_t *i); +yap_error_descriptor_t *Yap_UserError( Term t, yap_error_descriptor_t *i); extern bool Yap_RaiseException(void); diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index e99b66ef5..aae2976b9 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -166,6 +166,7 @@ AtomFunctor = Yap_LookupAtom("functor"); TermFunctor = MkAtomTerm(AtomFunctor); AtomGT = Yap_LookupAtom(">"); TermGT = MkAtomTerm(AtomGT); AtomGVar = Yap_LookupAtom("var"); TermGVar = MkAtomTerm(AtomGVar); + Atomg = Yap_LookupAtom("g"); Termg = MkAtomTerm(Atomg); AtomGc = Yap_FullLookupAtom("$gc"); TermGc = MkAtomTerm(AtomGc); AtomGcMargin = Yap_FullLookupAtom("$gc_margin"); TermGcMargin = MkAtomTerm(AtomGcMargin); AtomGcTrace = Yap_FullLookupAtom("$gc_trace"); TermGcTrace = MkAtomTerm(AtomGcTrace); @@ -424,6 +425,7 @@ AtomUserErr = Yap_LookupAtom("user_error"); TermUserErr = MkAtomTerm(AtomUserErr); AtomUserIn = Yap_LookupAtom("user_input"); TermUserIn = MkAtomTerm(AtomUserIn); AtomUserOut = Yap_LookupAtom("user_output"); TermUserOut = MkAtomTerm(AtomUserOut); + AtomUTF8 = Yap_LookupAtom("utf8"); TermUTF8 = MkAtomTerm(AtomUTF8); AtomDollarVar = Yap_LookupAtom("$VAR"); TermDollarVar = MkAtomTerm(AtomDollarVar); AtomVBar = Yap_LookupAtom("|"); TermVBar = MkAtomTerm(AtomVBar); AtomVarBranches = Yap_LookupAtom("var_branches"); TermVarBranches = MkAtomTerm(AtomVarBranches); @@ -499,6 +501,7 @@ FunctorDoubleArrow = Yap_MkFunctor(AtomDoubleArrow,2); FunctorDoubleSlash = Yap_MkFunctor(AtomDoubleSlash,2); FunctorEmptySquareBrackets = Yap_MkFunctor(AtomEmptySquareBrackets,2); + FunctorEncoding = Yap_MkFunctor(AtomEncoding,1); FunctorEq = Yap_MkFunctor(AtomEq,2); FunctorError = Yap_MkFunctor(AtomError,2); FunctorEvaluationError = Yap_MkFunctor(AtomEvaluationError,1); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index 297233770..ed4df6aee 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -166,6 +166,7 @@ AtomFunctor = AtomAdjust(AtomFunctor); TermFunctor = MkAtomTerm(AtomFunctor); AtomGT = AtomAdjust(AtomGT); TermGT = MkAtomTerm(AtomGT); AtomGVar = AtomAdjust(AtomGVar); TermGVar = MkAtomTerm(AtomGVar); + Atomg = AtomAdjust(Atomg); Termg = MkAtomTerm(Atomg); AtomGc = AtomAdjust(AtomGc); TermGc = MkAtomTerm(AtomGc); AtomGcMargin = AtomAdjust(AtomGcMargin); TermGcMargin = MkAtomTerm(AtomGcMargin); AtomGcTrace = AtomAdjust(AtomGcTrace); TermGcTrace = MkAtomTerm(AtomGcTrace); @@ -424,6 +425,7 @@ AtomUserErr = AtomAdjust(AtomUserErr); TermUserErr = MkAtomTerm(AtomUserErr); AtomUserIn = AtomAdjust(AtomUserIn); TermUserIn = MkAtomTerm(AtomUserIn); AtomUserOut = AtomAdjust(AtomUserOut); TermUserOut = MkAtomTerm(AtomUserOut); + AtomUTF8 = AtomAdjust(AtomUTF8); TermUTF8 = MkAtomTerm(AtomUTF8); AtomDollarVar = AtomAdjust(AtomDollarVar); TermDollarVar = MkAtomTerm(AtomDollarVar); AtomVBar = AtomAdjust(AtomVBar); TermVBar = MkAtomTerm(AtomVBar); AtomVarBranches = AtomAdjust(AtomVarBranches); TermVarBranches = MkAtomTerm(AtomVarBranches); @@ -499,6 +501,7 @@ FunctorDoubleArrow = FuncAdjust(FunctorDoubleArrow); FunctorDoubleSlash = FuncAdjust(FunctorDoubleSlash); FunctorEmptySquareBrackets = FuncAdjust(FunctorEmptySquareBrackets); + FunctorEncoding = FuncAdjust(FunctorEncoding); FunctorEq = FuncAdjust(FunctorEq); FunctorError = FuncAdjust(FunctorError); FunctorEvaluationError = FuncAdjust(FunctorEvaluationError); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index fd59f947b..ec475d58e 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -166,6 +166,7 @@ X_API EXTERNAL Atom AtomFull; X_API EXTERNAL Term TermFull; X_API EXTERNAL Atom AtomFunctor; X_API EXTERNAL Term TermFunctor; X_API EXTERNAL Atom AtomGT; X_API EXTERNAL Term TermGT; X_API EXTERNAL Atom AtomGVar; X_API EXTERNAL Term TermGVar; +X_API EXTERNAL Atom Atomg; X_API EXTERNAL Term Termg; X_API EXTERNAL Atom AtomGc; X_API EXTERNAL Term TermGc; X_API EXTERNAL Atom AtomGcMargin; X_API EXTERNAL Term TermGcMargin; X_API EXTERNAL Atom AtomGcTrace; X_API EXTERNAL Term TermGcTrace; @@ -424,6 +425,7 @@ X_API EXTERNAL Atom AtomUser; X_API EXTERNAL Term TermUser; X_API EXTERNAL Atom AtomUserErr; X_API EXTERNAL Term TermUserErr; X_API EXTERNAL Atom AtomUserIn; X_API EXTERNAL Term TermUserIn; X_API EXTERNAL Atom AtomUserOut; X_API EXTERNAL Term TermUserOut; +X_API EXTERNAL Atom AtomUTF8; X_API EXTERNAL Term TermUTF8; X_API EXTERNAL Atom AtomDollarVar; X_API EXTERNAL Term TermDollarVar; X_API EXTERNAL Atom AtomVBar; X_API EXTERNAL Term TermVBar; X_API EXTERNAL Atom AtomVarBranches; X_API EXTERNAL Term TermVarBranches; @@ -556,6 +558,8 @@ X_API EXTERNAL Functor FunctorDoubleSlash; X_API EXTERNAL Functor FunctorEmptySquareBrackets; +X_API EXTERNAL Functor FunctorEncoding; + X_API EXTERNAL Functor FunctorEq; X_API EXTERNAL Functor FunctorError; diff --git a/misc/ATOMS b/misc/ATOMS index c93c00783..82a041f44 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -415,7 +415,8 @@ A User N "user" A UserErr N "user_error" A UserIn N "user_input" A UserOut N "user_output" -A DollarVar N "$VAR" +A UTF8 N "utf8" +A DollarVar N "$VAR" A VBar N "|" A VarBranches N "var_branches" A VariableNames N "variable_names" @@ -490,6 +491,7 @@ F Dot9 Dot 9 F DoubleSlash DoubleSlash 2 F EmptySquareBrackets EmptySquareBrackets 2 F EmptyCurlyBrackets EmptyCurlyBrackets 2 +F Encoding Encoding 1 F Eq Eq 2 F Error Error 2 F EvaluationError EvaluationError 1 diff --git a/pl/errors.yap b/pl/errors.yap index c272c5656..88c55202d 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -63,12 +63,12 @@ system_error(Type,Goal) :- '$do_error'(Type,Goal) :- - throw(error(Type, [error(Goal)])). + throw(error(Type, [[g|g(Goal)]])). /** * @pred system_error( +Error, +Cause, +Culprit) * - * Generate a system error _Error_, informing the source goal _Cause_ and a possible _Culprit_. + * Generate a system error _Error_, informing the source goal _Cause_ * * * ~~~~~~~~~~ @@ -76,9 +76,8 @@ system_error(Type,Goal) :- * * */ -system_error(Type,Goal,Culprit) :- - ancestor_location(Goal, Culprit), - throw(error(Type, [error(Goal, Culprit)])). +system_error(Type,Goal) :- + hrow(error(Type, [[g|g(Goal)]])). '$do_pi_error'(type_error(callable,Name/0),Message) :- !, '$do_error'(type_error(callable,Name),Message). @@ -132,7 +131,7 @@ system_error(Type,Goal,Culprit) :- functor(Error, Severity, _), print_message(Severity, Error), !. %'$process_error'(error(Msg, Where), _) :- -% Print_message(error,error(Msg, [g|Where])), !. +% Print_message(error,error(Msg, [g|fWhere])), !. '$process_error'(Throw, _) :- print_message(error,error(unhandled_exception,Throw)). diff --git a/pl/messages.yap b/pl/messages.yap index b2498ac3d..014f0fa15 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -213,7 +213,7 @@ compose_message( loaded(included,AbsFileName,Mod,Time,Space), _Level) --> !, compose_message( loaded(What,AbsoluteFileName,Mod,Time,Space), _Level) --> !, [ '~a ~a in module ~a, ~d msec ~d bytes' - [What, AbsoluteFileName,Mod,Time,Space] ]. -compose_message(error(signal(SIG,_), _), _) --> +compose_message(signal(SIG,_), _) --> !, [ 'UNEXPECTED SIGNAL: ~a' - [SIG] ]. compose_message(trace_command(C), _Leve) --> @@ -232,21 +232,18 @@ compose_message(yes, _Level) --> !, [ 'yes'- [] ]. compose_message(error(E, exception(Exc)), Level) --> { '$show_consult_level'(LC) }, - location( Exc, Level, LC), - main_message( Exc, Level, LC ), + location(error(E, exception(Exc)), Level, LC), + main_message(error(E, exception(Exc)) , Level, LC ), c_goal( Exc, Level ), caller( Exc, Level ), extra_info( Exc, Level ), !, [nl,nl]. -compose_message(error(E,[I|Is]), Level) --> - { Level == error -> true ; Level == warning }, - { '$show_consult_level'(LC), - translate_info([I|Is], In)) - }, - compose_message( e(Err, In), Level), - [nl,nl]. -compose_message(Throw), _Leve) --> + compose_message(error(E,[I|Is]), Level) --> + { translate_info([I|Is], In) }, + compose_message( e(E, In), Level), + [nl,nl]. +compose_message(Throw, _Leve) --> !, [ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ]. @@ -254,7 +251,7 @@ translate_info([I1|I2],exception(R) ) :- !, '$new_exception'(R), tinfo(R, [I1|I2], []). -translate_info(E, none ). +translate_info(_E, none ). tinfo(_Reg) --> !. @@ -263,7 +260,12 @@ tinfo(Reg) --> tinfo(Reg). addinfo( Desc) --> - ( [[p|p(M,Na,Ar,File,FilePos)]] + ( ; + [[p]] + -> + [] + ; + [[p|p(M,Na,Ar,File,FilePos)]] -> { '$query_exception'(prologPredFile, Desc, File), @@ -273,7 +275,11 @@ addinfo( Desc) --> '$query_exception'(prologPredArity, Desc, Ar) } ; - [e|p(M,Na,Ar,File,FilePos)], Desc) + [[e]] + -> + [] + ; + [[e|p(M,Na,Ar,File,FilePos)]] -> { '$query_exception'(prologPredFile, Desc, File), @@ -291,11 +297,15 @@ addinfo( Desc) --> '$query_exception'(errorLine, Desc, Line) } ; -[[g|g(Call)] + [[g|g(Call)]] -> { '$query_exception'(errorGoal, Desc, Call) } + ; + [[h|p(M,Na,Ar,File,FilePos)g)](_)]] +-> + [] ). @@ -306,16 +316,6 @@ location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) --> !, [ '~a:~d:0 ' - [FileName,LN] ] . -location( error(_,exception(Desc)), Level, LC ) --> - { source_location(F0, L), - stream_property(_Stream, alias(loop_stream)), - !, - '$query_exception'(prologPredModule, Desc, M), - '$query_exception'(prologPredName, Desc, Na), - '$query_exception'(prologPredArity, Desc, Ar) - }, - display_consulting( F0, Level, LC ), - [ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ]. location( error(_,exception(Desc)), Level, LC ) --> { '$query_exception'(prologPredFile, Desc, File), '$query_exception'(prologPredLine, Desc, FilePos), @@ -324,15 +324,15 @@ location( error(_,exception(Desc)), Level, LC ) --> '$query_exception'(prologPredArity, Desc, Ar) }, display_consulting( File, Level, LC ), - [ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ]. + [ '~s:~d:0 ~a in ~s:~s/~d:'-[File, FilePos,Level,M,Na,Ar] ]. %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, main_message(error(Msg,In), _, _) --> {var(In)}, !, [ ' error: uninstantiated message ~w~n.' - [Msg], nl ]. main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) --> !, - [' ~a: syntax error ~s' - [Level,Msg]], - [nl], + [' ~a: syntax error ~s' - [Level,Msg]], + [nl], ( syntax_error_term( between(L0,LM,LF), Term, LC ) -> [] @@ -747,7 +747,7 @@ syntax_error_token(number(N), _, _LC) --> !, syntax_error_token(var(_,S), _, _LC) --> !, [ '~a' - [S] ]. syntax_error_token(string(S), _, _LC) --> !, - [ '`~s`' - [S] ]. + [ '`~s`' - [S] ]. syntax_error_token(error, L, _LC) --> !, [ ' <<<< at line %d' - [L] ]. syntax_error_token('EOT',_, _LC) --> !, @@ -806,8 +806,8 @@ print_lines( S, Prefixes, Key) --> !, { nl(S), Prefixes = [PrefixS - Cmds|More], - format(S, PrefixS, Cmds) - }, + format(S, PrefixS, []Cmds) + } { More == [] -> diff --git a/pl/preddecls.yap b/pl/preddecls.yap index e957db1c6..6e0e755e4 100644 --- a/pl/preddecls.yap +++ b/pl/preddecls.yap @@ -32,8 +32,6 @@ ] ). -:- op(1150, fx, [multifile,discontiguous]). - '$log_upd'(1). /** diff --git a/pl/signals.yap b/pl/signals.yap index ed63a9aed..0f51b6231 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -212,10 +212,10 @@ ( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ), ( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))). % die on signal default. % -'$signal_def'(sig_usr1, throw(error(signal(usr1,[]),true))). -'$signal_def'(sig_usr2, throw(error(signal(usr2,[]),true))). -'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))). -'$signal_def'(sig_fpe, throw(error(signal(fpe,[]),true))). +'$signal_def'(sig_usr1, throw(signal(usr1,[]))). +'$signal_def'(sig_usr2, throw(signal(usr2,[]))). +'$signal_def'(sig_pipe, throw(signal(pipe,[]))). +'$signal_def'(sig_fpe, throw(signal(fpe,[]))). % ignore sig_alarm by default % '$signal_def'(sig_alarm, true).