diff --git a/C/c_interface.c b/C/c_interface.c index f91da68b5..9c0027310 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2099,7 +2099,7 @@ X_API void YAP_ClearExceptions(void) { Yap_ResetException(worker_id); } -X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) { +X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) { CACHE_REGS int sno; BACKUP_MACHINE_REGS(); @@ -2114,19 +2114,25 @@ X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) { fl = Yap_AbsoluteFile(fname, true); if (!fl || !fl[0]) { pop_text_stack(lvl); + *full = NULL; return -1; } } bool consulted = (mode == YAP_CONSULT_MODE); sno = Yap_OpenStream(fl, "r", MkAtomTerm(Yap_LookupAtom(fl)), LOCAL_encoding); - if (sno < 0) - return sno; - if (!Yap_ChDir(dirname((char *)fl))) return -1; + if (sno < 0 || + !Yap_ChDir(dirname((char *)fl))) { + pop_text_stack(lvl); + *full = NULL; + return -1; + } + LOCAL_PrologMode = UserMode; + Yap_init_consult(consulted, fl); GLOBAL_Stream[sno].name = Yap_LookupAtom(fl); GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(fname)); GLOBAL_Stream[sno].encoding = LOCAL_encoding; - pop_text_stack(lvl); + *full = pop_output_text_stack(lvl, fl); RECOVER_MACHINE_REGS(); UNLOCK(GLOBAL_Stream[sno].streamlock); return sno; @@ -2285,8 +2291,6 @@ X_API bool YAP_CompileClause(Term t) { } RECOVER_MACHINE_REGS(); if (!ok) { - t = Yap_GetException(); - Yap_DebugPlWrite(t); return NULL; } return ok; diff --git a/C/cdmgr.c b/C/cdmgr.c index fd6067b66..535b78d2d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -2724,7 +2724,7 @@ static Int new_meta_pred(USES_REGS1) { pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate"); if (EndOfPAEntr(pe)) - return FALSE; + return false; PELOCK(30, pe); arity = pe->ArityOfPE; if (arity == 0) diff --git a/C/errors.c b/C/errors.c index 951f1f414..85c97c003 100755 --- a/C/errors.c +++ b/C/errors.c @@ -33,17 +33,66 @@ #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; } \ + +#define set_key_i(k, ks, q, i, 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; } \ + +static bool setErr(const char *q, yap_error_descriptor_t *i, Term 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); + return false; +} + #define query_key_b(k, ks, q, i) \ - if (strcmp(ks,q) == 0) \ + if (strcmp(ks,q) == 0) \ { return i->k ? TermTrue : TermFalse; } \ #define query_key_i(k, ks, q, i) \ - if (strcmp(ks,q) == 0) \ + 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 ? MkStringTerm(i->k) : TermNil; } +#define query_key_s(k, ks, q, i) \ + if (strcmp(ks,q) == 0) \ + { return ( i->k && i->k[0] ? MkStringTerm(i->k) : TermEmptyAtom ); } static Term queryErr(const char *q, yap_error_descriptor_t *i) { query_key_i( errorNo, "errorNo", q, i ); @@ -71,7 +120,7 @@ static Term queryErr(const char *q, yap_error_descriptor_t *i) { query_key_s( culprit, "culprit", q, i); query_key_s( errorMsg, "errorMsg", q, i); query_key_i( errorMsgLen, "errorMsgLen", q, i); - return TermNil; + return TermNil; } static void print_key_b(const char *key, bool v) @@ -82,48 +131,48 @@ static void print_key_b(const char *key, bool v) static void print_key_i(const char *key, YAP_Int v) { - fprintf(stderr,"%s: " Int_FORMAT "\n", key, 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); + fprintf(stderr,"%s: %s\n", key, v); } - static void printErr(yap_error_descriptor_t *i) { +static void printErr(yap_error_descriptor_t *i) { if (i->errorNo == YAP_NO_ERROR) { return; } - 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); - if (i->errorMsgLen) { - print_key_s( "errorMsg", i->errorMsg); - print_key_i( "errorMsgLen", i->errorMsgLen); - } + 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); + if (i->errorMsgLen) { + print_key_s( "errorMsg", i->errorMsg); + print_key_i( "errorMsgLen", i->errorMsgLen); + } } @@ -156,7 +205,7 @@ static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) return MkPairTerm(node, o0); } - static Term err2list(yap_error_descriptor_t *i) { +static Term err2list(yap_error_descriptor_t *i) { Term o = TermNil; if (i->errorNo == YAP_NO_ERROR) { return o; @@ -171,31 +220,31 @@ static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) 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); - } - return 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); + } + return o; } bool Yap_Warning(const char *s, ...) { CACHE_REGS - va_list ap; + va_list ap; PredEntry *pred; bool rc; Term ts[2]; @@ -227,7 +276,7 @@ bool Yap_Warning(const char *s, ...) { if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) { fprintf(stderr, "warning message: %s\n", tmpbuf); LOCAL_DoingUndefp = false; -LOCAL_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; Yap_popErrorContext(false); return false; } @@ -242,7 +291,7 @@ LOCAL_PrologMode &= ~InErrorMode; void Yap_InitError__(const char *file, const char *function, int lineno, yap_error_number e, Term t, ...) { CACHE_REGS - va_list ap; + va_list ap; va_start(ap, t); const char *fmt; char tmpbuf[MAXPATHLEN]; @@ -275,8 +324,8 @@ void Yap_InitError__(const char *file, const char *function, int lineno, yap_err bool Yap_PrintWarning(Term twarning) { CACHE_REGS - PredEntry *pred = RepPredProp(PredPropByFunc( - FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; + PredEntry *pred = RepPredProp(PredPropByFunc( + FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule); bool rc; Term ts[2]; @@ -292,7 +341,7 @@ bool Yap_PrintWarning(Term twarning) { Yap_DebugPlWrite(twarning); fprintf(stderr, "\n"); LOCAL_DoingUndefp = false; - LOCAL_PrologMode &= ~InErrorMode; + LOCAL_PrologMode &= ~InErrorMode; CurrentModule = cmod; return false; } @@ -309,7 +358,7 @@ bool Yap_PrintWarning(Term twarning) { bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *s, ...) { CACHE_REGS - yap_error_number err = LOCAL_Error_TYPE; + yap_error_number err = LOCAL_Error_TYPE; const char *serr; arity_t arity = 2; @@ -358,7 +407,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, int Yap_SWIHandleError(const char *s, ...) { CACHE_REGS - yap_error_number err = LOCAL_Error_TYPE; + yap_error_number err = LOCAL_Error_TYPE; char *serr; if (LOCAL_ErrorMessage) { @@ -396,20 +445,19 @@ int Yap_SWIHandleError(const char *s, ...) { void Yap_RestartYap(int flag) { CACHE_REGS - fprintf(stderr,"call siglongjmp HR=%p B=%p\n", HR, B); #if PUSH_REGS - restore_absmi_regs(&Yap_standard_regs); + restore_absmi_regs(&Yap_standard_regs); #endif siglongjmp(*LOCAL_RestartEnv, flag); } static void error_exit_yap(int value) { CACHE_REGS - if (!(LOCAL_PrologMode & BootMode)) { + if (!(LOCAL_PrologMode & BootMode)) { #if DEBUG #endif - } + } fprintf(stderr, "\n Exiting ....\n"); #if HAVE_BACKTRACE void *callstack[256]; @@ -447,36 +495,36 @@ static char tmpbuf[YAP_BUF_SIZE]; #undef E2 #undef END_ERRORS -#define BEGIN_ERROR_CLASSES() \ - static Atom mkerrorct(yap_error_class_number c) { \ +#define BEGIN_ERROR_CLASSES() \ + static Atom mkerrorct(yap_error_class_number c) { \ switch (c) { -#define ECLASS(CL, A, B) \ - case CL: \ - return Yap_LookupAtom(A); \ +#define ECLASS(CL, A, B) \ + case CL: \ + return Yap_LookupAtom(A); \ -#define END_ERROR_CLASSES() \ - } \ - return NULL; \ - } +#define END_ERROR_CLASSES() \ + } \ + return NULL; \ + } #define BEGIN_ERRORS() \ static Term mkerrort(yap_error_number e, Term culprit, Term info) { \ switch (e) { -#define E0(A, B) \ - case A: { \ - Term ft[2]; \ - ft[0] = MkAtomTerm(mkerrorct(B)); \ - ft[1] = info; \ +#define E0(A, B) \ + case A: { \ + Term ft[2]; \ + ft[0] = MkAtomTerm(mkerrorct(B)); \ + ft[1] = info; \ return Yap_MkApplTerm(FunctorError,2,ft); } #define E(A, B, C) \ case A: \ { Term ft[2], nt[2]; \ nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \ - nt[1] = MkVarTerm(); \ - Yap_unify(nt[1], culprit); \ + nt[1] = MkVarTerm(); \ + Yap_unify(nt[1], culprit); \ ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B),2), 2, nt); \ ft[1] = info; \ return Yap_MkApplTerm(FunctorError,2,ft); } @@ -485,19 +533,19 @@ static char tmpbuf[YAP_BUF_SIZE]; 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[1] = info; \ - return Yap_MkApplTerm(FunctorError,2,ft); \ + 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[1] = info; \ + return Yap_MkApplTerm(FunctorError,2,ft); \ } -#define END_ERRORS() \ - } \ - return TermNil; \ - } +#define END_ERRORS() \ + } \ + return TermNil; \ + } #include "YapErrors.h" @@ -554,7 +602,7 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, if (LOCAL_RestartEnv) { Yap_RestartYap(5); } - Yap_exit(5); + Yap_exit(5); } /** @@ -592,189 +640,189 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, */ yamop *Yap_Error__(bool throw, const char *file, const char *function, int lineno, yap_error_number type, Term where, ...) { - CACHE_REGS + CACHE_REGS va_list ap; - char *fmt; - char s[MAXPATHLEN]; - yap_error_number err; + char *fmt; + char s[MAXPATHLEN]; + yap_error_number err; - /* 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)); - Yap_RestartYap(1); - } - if (LOCAL_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) { - P = FAILCODE; - CalculateStackGap(PASS_REGS1); - return P; - } - LOCAL_ActiveError->errorNo = type; - LOCAL_ActiveError->errorAsText = Yap_errorName(type); - LOCAL_ActiveError->errorClass = Yap_errorClass(type); - LOCAL_ActiveError->classAsText = - Yap_errorClassName(LOCAL_ActiveError->errorClass); - LOCAL_ActiveError->errorLine = lineno; - LOCAL_ActiveError->errorFunction = function; - LOCAL_ActiveError->errorFile = file; - Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS1); - LOCAL_PrologMode |= InErrorMode; - Yap_ClearExs(); - // first, obtain current location - // sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno, - // function); - // tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)); + /* 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)); + Yap_RestartYap(1); + } + if (LOCAL_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) { + P = FAILCODE; + CalculateStackGap(PASS_REGS1); + return P; + } + LOCAL_ActiveError->errorNo = type; + LOCAL_ActiveError->errorAsText = Yap_errorName(type); + LOCAL_ActiveError->errorClass = Yap_errorClass(type); + LOCAL_ActiveError->classAsText = + Yap_errorClassName(LOCAL_ActiveError->errorClass); + LOCAL_ActiveError->errorLine = lineno; + LOCAL_ActiveError->errorFunction = function; + LOCAL_ActiveError->errorFile = file; + Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS1); + LOCAL_PrologMode |= InErrorMode; + Yap_ClearExs(); + // first, obtain current location + // sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno, + // function); + // tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)); #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); - else - fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type, - LOCAL_PrologMode, fmt); + 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); + else + fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type, + LOCAL_PrologMode, fmt); #endif - if (type == INTERRUPT_EVENT) { - fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n", - (int) IntOfTerm(where)); - LOCAL_PrologMode &= ~InErrorMode; - 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); + if (type == INTERRUPT_EVENT) { + fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n", + (int) IntOfTerm(where)); + LOCAL_PrologMode &= ~InErrorMode; + 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) { + } + 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); + (void)vsprintf(s, fmt, ap); #endif - // fprintf(stderr, "warning: "); - if (s[0]) { - LOCAL_ActiveError->errorMsgLen = strlen(s) + 1; - LOCAL_ActiveError->errorMsg = malloc(LOCAL_ActiveError->errorMsgLen); - strcpy(LOCAL_ActiveError->errorMsg, s); - } else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) { - LOCAL_ActiveError->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1; - LOCAL_ActiveError->errorMsg = malloc(LOCAL_ActiveError->errorMsgLen); - strcpy(LOCAL_ActiveError->errorMsg, LOCAL_ErrorMessage); - } else { - LOCAL_ActiveError->errorMsgLen = 0; - LOCAL_ActiveError->errorMsg = 0; - } - } - va_end(ap); - if (where == 0 || where == TermNil) { - LOCAL_ActiveError->culprit = 0; - } - if (P == (yamop *) (FAILCODE)) { - LOCAL_PrologMode &= ~InErrorMode; - return P; - } - /* PURE_ABORT may not have set where correctly, BootMode may not have the data - * terms ready */ - if (type == ABORT_EVENT || LOCAL_PrologMode & BootMode) { - LOCAL_PrologMode &= ~AbortMode; - LOCAL_PrologMode &= ~InErrorMode; - /* make sure failure will be seen at next port */ - // no need to lock & unlock - if (LOCAL_PrologMode & AsyncIntMode) - Yap_signal(YAP_FAIL_SIGNAL); - P = FAILCODE; + // fprintf(stderr, "warning: "); + if (s[0]) { + LOCAL_ActiveError->errorMsgLen = strlen(s) + 1; + LOCAL_ActiveError->errorMsg = malloc(LOCAL_ActiveError->errorMsgLen); + strcpy(LOCAL_ActiveError->errorMsg, s); + } else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) { + LOCAL_ActiveError->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1; + LOCAL_ActiveError->errorMsg = malloc(LOCAL_ActiveError->errorMsgLen); + strcpy(LOCAL_ActiveError->errorMsg, LOCAL_ErrorMessage); } else { - /* Exit Abort Mode, if we were there */ - LOCAL_PrologMode &= ~AbortMode; - LOCAL_PrologMode |= InErrorMode; + LOCAL_ActiveError->errorMsgLen = 0; + LOCAL_ActiveError->errorMsg = 0; } + } + va_end(ap); + if (where == 0 || where == TermNil) { + LOCAL_ActiveError->culprit = 0; + } + if (P == (yamop *) (FAILCODE)) { + LOCAL_PrologMode &= ~InErrorMode; + return P; + } + /* PURE_ABORT may not have set where correctly, BootMode may not have the data + * terms ready */ + if (type == ABORT_EVENT || LOCAL_PrologMode & BootMode) { + LOCAL_PrologMode &= ~AbortMode; + LOCAL_PrologMode &= ~InErrorMode; + /* make sure failure will be seen at next port */ + // no need to lock & unlock + if (LOCAL_PrologMode & AsyncIntMode) + Yap_signal(YAP_FAIL_SIGNAL); + P = FAILCODE; + } else { + /* Exit Abort Mode, if we were there */ + LOCAL_PrologMode &= ~AbortMode; + LOCAL_PrologMode |= InErrorMode; + } - 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); - error_exit_yap(1); - } + 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); + error_exit_yap(1); + } #ifdef DEBUG - // DumpActiveGoals( USES_REGS1 ); + // DumpActiveGoals( USES_REGS1 ); #endif /* DEBUG */ - switch (type) { - case SYSTEM_ERROR_INTERNAL: { - fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf); - // serious = true; - if (LOCAL_PrologMode & BootMode) { - fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf); - } 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); - } + switch (type) { + case SYSTEM_ERROR_INTERNAL: { + fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf); + // serious = true; + if (LOCAL_PrologMode & BootMode) { + fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf); + } 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); + } #if HAVE_BACKTRACE - void *callstack[256]; - int i; - int frames = backtrace(callstack, 256); - char **strs = backtrace_symbols(callstack, frames); - fprintf(stderr, "Execution stack:\n"); - for (i = 0; i < frames; ++i) { - fprintf(stderr, " %s\n", strs[i]); - } - free(strs); + void *callstack[256]; + int i; + int frames = backtrace(callstack, 256); + char **strs = backtrace_symbols(callstack, frames); + fprintf(stderr, "Execution stack:\n"); + for (i = 0; i < frames; ++i) { + fprintf(stderr, " %s\n", strs[i]); + } + free(strs); #endif - } - error_exit_yap(1); - } - case SYSTEM_ERROR_FATAL: { - fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf); - error_exit_yap(1); - } - case INTERRUPT_EVENT: { - error_exit_yap(1); - } - case ABORT_EVENT: - // fun = FunctorDollarVar; - // serious = true; - LOCAL_ActiveError->errorNo = ABORT_EVENT; - Yap_JumpToEnv(); - P = FAILCODE; - LOCAL_PrologMode &= ~InErrorMode; - return P; - case CALL_COUNTER_UNDERFLOW_EVENT: - /* Do a long jump */ - LOCAL_ReductionsCounterOn = FALSE; - LOCAL_PredEntriesCounterOn = FALSE; - LOCAL_RetriesCounterOn = FALSE; - LOCAL_ActiveError->errorNo = CALL_COUNTER_UNDERFLOW_EVENT; - Yap_JumpToEnv(); - P = FAILCODE; - LOCAL_PrologMode &= ~InErrorMode; - return P; - case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT: - /* Do a long jump */ - LOCAL_ReductionsCounterOn = FALSE; - LOCAL_PredEntriesCounterOn = FALSE; - LOCAL_RetriesCounterOn = FALSE; - LOCAL_ActiveError->errorNo = PRED_ENTRY_COUNTER_UNDERFLOW_EVENT; - Yap_JumpToEnv(); - P = FAILCODE; - LOCAL_PrologMode &= ~InErrorMode; - return P; - case RETRY_COUNTER_UNDERFLOW_EVENT: - /* Do a long jump */ - LOCAL_ReductionsCounterOn = FALSE; - LOCAL_PredEntriesCounterOn = FALSE; - LOCAL_RetriesCounterOn = FALSE; - LOCAL_ActiveError->errorNo = RETRY_COUNTER_UNDERFLOW_EVENT; - Yap_JumpToEnv(); - P = FAILCODE; - LOCAL_PrologMode &= ~InErrorMode; - return P; - default: - if (!Yap_pc_add_location(LOCAL_ActiveError, CP, B, ENV)) - Yap_env_add_location(LOCAL_ActiveError, CP, B, ENV, 0); - break; } + error_exit_yap(1); + } + case SYSTEM_ERROR_FATAL: { + fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf); + error_exit_yap(1); + } + case INTERRUPT_EVENT: { + error_exit_yap(1); + } + case ABORT_EVENT: + // fun = FunctorDollarVar; + // serious = true; + LOCAL_ActiveError->errorNo = ABORT_EVENT; + Yap_JumpToEnv(); + P = FAILCODE; + LOCAL_PrologMode &= ~InErrorMode; + return P; + case CALL_COUNTER_UNDERFLOW_EVENT: + /* Do a long jump */ + LOCAL_ReductionsCounterOn = FALSE; + LOCAL_PredEntriesCounterOn = FALSE; + LOCAL_RetriesCounterOn = FALSE; + LOCAL_ActiveError->errorNo = CALL_COUNTER_UNDERFLOW_EVENT; + Yap_JumpToEnv(); + P = FAILCODE; + LOCAL_PrologMode &= ~InErrorMode; + return P; + case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT: + /* Do a long jump */ + LOCAL_ReductionsCounterOn = FALSE; + LOCAL_PredEntriesCounterOn = FALSE; + LOCAL_RetriesCounterOn = FALSE; + LOCAL_ActiveError->errorNo = PRED_ENTRY_COUNTER_UNDERFLOW_EVENT; + Yap_JumpToEnv(); + P = FAILCODE; + LOCAL_PrologMode &= ~InErrorMode; + return P; + case RETRY_COUNTER_UNDERFLOW_EVENT: + /* Do a long jump */ + LOCAL_ReductionsCounterOn = FALSE; + LOCAL_PredEntriesCounterOn = FALSE; + LOCAL_RetriesCounterOn = FALSE; + LOCAL_ActiveError->errorNo = RETRY_COUNTER_UNDERFLOW_EVENT; + Yap_JumpToEnv(); + P = FAILCODE; + LOCAL_PrologMode &= ~InErrorMode; + return P; + default: + if (!Yap_pc_add_location(LOCAL_ActiveError, CP, B, ENV)) + Yap_env_add_location(LOCAL_ActiveError, CP, B, ENV, 0); + break; + } CalculateStackGap(PASS_REGS1); #if DEBUG @@ -785,16 +833,226 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen if (LOCAL_DoingUndefp) { LOCAL_Signals = 0; - Yap_PrintWarning(Yap_GetException()); + Yap_PrintWarning(MkErrorTerm(Yap_GetException())); return P; } + LOCAL_CommittedError = Yap_GetException(); //reset_error_description(); - // if (!throw) { + if (!throw) { Yap_JumpToEnv(); - // } + } + LOCAL_PrologMode = UserMode; return P; } +static Int close_error(USES_REGS1) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + return true; +} + +#undef BEGIN_ERROR_CLASSES +#undef ECLASS +#undef END_ERROR_CLASSES +#undef BEGIN_ERRORS +#undef E0 +#undef E +#undef E2 +#undef END_ERRORS + +#define BEGIN_ERROR_CLASSES() typedef enum aux_class { + +#define ECLASS(CL, A, B) CL##__, + +#define END_ERROR_CLASSES() \ + } \ + aux_class_t; + +#define BEGIN_ERRORS() +#define E0(X, Y) +#define E(X, Y, Z) +#define E2(X, Y, Z, W) +#define END_ERRORS() + +#include + +#undef BEGIN_ERROR_CLASSES +#undef ECLASS +#undef END_ERROR_CLASSES +#undef BEGIN_ERRORS +#undef E0 +#undef E +#undef E2 +#undef END_ERRORS + +#define BEGIN_ERROR_CLASSES() static const char *c_error_class_name[] = { + +#define ECLASS(CL, A, B) A, + +#define END_ERROR_CLASSES() \ + NULL \ + } + +typedef struct c_error_info { + int class; + const char *name; +} c_error_t; + +#define BEGIN_ERRORS() static struct c_error_info c_error_list[] = { +#define E0(X, Y) {Y##__, ""}, +#define E(X, Y, Z) {Y##__, Z}, +#define E2(X, Y, Z, W) {Y##__, Z " " W}, +#define END_ERRORS() \ + { YAPC_NO_ERROR, "" } \ + } \ + ; + +#include + +yap_error_class_number Yap_errorClass(yap_error_number e) { + return c_error_list[e].class; +} + +const char *Yap_errorName(yap_error_number e) { return c_error_list[e].name; } + +const char *Yap_errorClassName(yap_error_class_number e) { + return c_error_class_name[e]; +} + +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; + } + return 0; +} + +void Yap_PrintException(void) { + printErr(LOCAL_ActiveError); +} + +bool Yap_RaiseException(void) { + if (LOCAL_ActiveError->errorNo == YAP_NO_ERROR) + return false; + return Yap_JumpToEnv(); +} + +bool Yap_ResetException(yap_error_descriptor_t *i) { + // reset error descriptor + if(!i) + return true; + yap_error_descriptor_t *bf = i->top_error; + memset(i, 0, sizeof(*i)); + i->top_error = bf; + return true; +} + +static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } + +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)); +} + +static Int read_exception(USES_REGS1) { + yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); + Term rc = MkErrorTerm(t); + // Yap_DebugPlWriteln(rc); + return Yap_unify(ARG2, rc); +} + +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))) + 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); + return Yap_unify(ARG3, rc); + } else { + return setErr(query, y, t3); + } +} + + +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); +} + + +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); + LOCAL_CommittedError = NULL; + Int rc= Yap_unify(t, ARG1); + return rc; + } + return false; +} + + +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; + } + } + Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS1); + return + LOCAL_ActiveError; +} + static Int is_boolean(USES_REGS1) { Term t = Deref(ARG1); // Term Context = Deref(ARG2)Yap_Error(INSTANTIATION_ERROR, t, NULL);; @@ -879,159 +1137,14 @@ static Int is_predicate_indicator(USES_REGS1) { return false; } -static Int close_error(USES_REGS1) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - return true; -} - -#undef BEGIN_ERROR_CLASSES -#undef ECLASS -#undef END_ERROR_CLASSES -#undef BEGIN_ERRORS -#undef E0 -#undef E -#undef E2 -#undef END_ERRORS - -#define BEGIN_ERROR_CLASSES() typedef enum aux_class { - -#define ECLASS(CL, A, B) CL##__, - -#define END_ERROR_CLASSES() \ - } \ - aux_class_t; - -#define BEGIN_ERRORS() -#define E0(X, Y) -#define E(X, Y, Z) -#define E2(X, Y, Z, W) -#define END_ERRORS() - -#include - -#undef BEGIN_ERROR_CLASSES -#undef ECLASS -#undef END_ERROR_CLASSES -#undef BEGIN_ERRORS -#undef E0 -#undef E -#undef E2 -#undef END_ERRORS - -#define BEGIN_ERROR_CLASSES() static const char *c_error_class_name[] = { - -#define ECLASS(CL, A, B) A, - -#define END_ERROR_CLASSES() \ - NULL \ - } - -typedef struct c_error_info { - int class; - const char *name; -} c_error_t; - -#define BEGIN_ERRORS() static struct c_error_info c_error_list[] = { -#define E0(X, Y) {Y##__, ""}, -#define E(X, Y, Z) {Y##__, Z}, -#define E2(X, Y, Z, W) {Y##__, Z " " W}, -#define END_ERRORS() \ - { YAPC_NO_ERROR, "" } \ - } \ - ; - -#include - -yap_error_class_number Yap_errorClass(yap_error_number e) { - return c_error_list[e].class; -} - -const char *Yap_errorName(yap_error_number e) { return c_error_list[e].name; } - -const char *Yap_errorClassName(yap_error_class_number e) { - return c_error_class_name[e]; -} - - Term 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)); - Term rc = mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), MkAddressTerm(nt)); - Yap_ResetException(worker_id); - save_H(); - return rc; - } - return 0; - } - - void Yap_PrintException(void) { - printErr(LOCAL_ActiveError); - } - - bool Yap_RaiseException(void) { - if (LOCAL_ActiveError->errorNo == YAP_NO_ERROR) - return false; - return Yap_JumpToEnv(); - } - - bool Yap_ResetException(int wid) { - // reset error descriptor - yap_error_descriptor_t *bf = REMOTE_ActiveError(wid)->top_error; - memset(REMOTE_ActiveError(wid), 0, sizeof(*LOCAL_ActiveError)); - REMOTE_ActiveError(wid)->top_error = bf; - LOCAL_PrologMode &= ~InErrorMode; - return true; - } - - static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } - - static Int read_exception(USES_REGS1) { - yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); - Term rc = mkerrort(t->errorNo, Yap_BufferToTerm(t->culprit, TermNil), err2list(t)); - // Yap_DebugPlWriteln(rc); - return Yap_unify(ARG2, rc); - } - - 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); - yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2)); - Term rc = queryErr(query, y); - // Yap_DebugPlWriteln(rc); - return Yap_unify(ARG3, rc); - } - - - static Int drop_exception(USES_REGS1) { - yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1)); - free(t); - return true; - } - - - static Int get_exception(USES_REGS1) { - Term t; - if (Yap_HasException() && (t = Yap_GetException()) != 0) { - Int rc= Yap_unify(t, ARG1); - return rc; - } - return false; - } - void Yap_InitErrorPreds(void) { CACHE_REGS Yap_InitCPred("$reset_exception", 1, reset_exception, 0); - Yap_InitCPred("$get_exception", 1, get_exception, 0); - Yap_InitCPred("$drop_exception", 1, get_exception, 0); - Yap_InitCPred("$read_exception", 2, read_exception, 0); - Yap_InitCPred("$query_exception", 3, query_exception, 0); - Yap_InitCPred("$drop_exception", 1, drop_exception, 0); + Yap_InitCPred("$new_exception", 1, new_exception, 0); + Yap_InitCPred("$get_exception", 1, get_exception, 0); + Yap_InitCPred("$read_exception", 2, read_exception, 0); + Yap_InitCPred("$query_exception", 3, query_exception, 0); + Yap_InitCPred("$drop_exception", 1, drop_exception, 0); Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag); Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag); Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag); diff --git a/C/exec.c b/C/exec.c index f789f9ad5..f51de5e92 100755 --- a/C/exec.c +++ b/C/exec.c @@ -47,7 +47,7 @@ static choiceptr cp_from_integer(Term cpt USES_REGS) { */ Term Yap_cp_as_integer(choiceptr cp) { CACHE_REGS - return cp_as_integer(cp PASS_REGS); + return cp_as_integer(cp PASS_REGS); } /** @@ -127,7 +127,7 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) { */ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { CACHE_REGS - Term ts[4]; + Term ts[4]; ts[0] = g; ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ts[2] = g; @@ -140,8 +140,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) { Term Yap_PredicateIndicator(Term t, Term mod) { CACHE_REGS - // generate predicate indicator in this case - Term ti[2]; + // generate predicate indicator in this case + Term ti[2]; t = Yap_YapStripModule(t, &mod); if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) { ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); @@ -214,7 +214,7 @@ static Int save_env_b(USES_REGS1) { static PredEntry *new_pred(Term t, Term tmod, char *pname) { Term t0 = t; -restart: + restart: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t0, pname); return NULL; @@ -392,7 +392,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) { int j = -n; Term t0 = t, mod0 = mod; -restart_exec: + restart_exec: if (IsVarTerm(t)) { return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS); } else if (IsAtomTerm(t)) { @@ -431,8 +431,8 @@ restart_exec: } if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) { return EnterCreepMode( - copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), - mod PASS_REGS); + copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), + mod PASS_REGS); } if (arity > MaxTemps) { return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS); @@ -441,8 +441,8 @@ restart_exec: /* You thought we would be over by now */ /* but no meta calls require special preprocessing */ // if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) { - // Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); - //return (CallMetaCall(t0, mod0 PASS_REGS)); + // Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); + //return (CallMetaCall(t0, mod0 PASS_REGS)); //} /* now let us do what we wanted to do from the beginning !! */ /* I cannot use the standard macro here because @@ -649,7 +649,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */ yamop *code; Term clt = Deref(ARG3); -restart_exec: + restart_exec: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); return FALSE; @@ -817,8 +817,8 @@ static bool watch_cut(Term ext USES_REGS) { } CELL *port_pt = deref_ptr(RepAppl(task) + 2); CELL *completion_pt = deref_ptr(RepAppl(task) + 4); - if ((ex_mode = Yap_HasException())) { - e = Yap_GetException(); + if (LOCAL_CommittedError) { + e = MkErrorTerm(LOCAL_CommittedError); Term t; if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); @@ -873,8 +873,9 @@ static bool watch_retry(Term d0 USES_REGS) { // just do the frrpest if (B >= B0 && !ex_mode && !active) return true; - if ((ex_mode = Yap_HasException())) { - e = Yap_GetException(); + if (LOCAL_CommittedError && + LOCAL_CommittedError->errorNo != YAP_NO_ERROR) { + e = MkErrorTerm(LOCAL_CommittedError); if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); } else { @@ -980,9 +981,9 @@ static Int cleanup_on_exit(USES_REGS1) { static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) { CACHE_REGS - if (creeping) { - Yap_signal(YAP_CREEP_SIGNAL); - } + if (creeping) { + Yap_signal(YAP_CREEP_SIGNAL); + } CurrentModule = omod; Yap_CloseSlots(sl); if (out) { @@ -1012,7 +1013,7 @@ static Int _user_expand_goal(USES_REGS1) { ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args); ARG2 = Yap_GetFromSlot(h2); if ((pe = RepPredProp( - Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && + Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); @@ -1022,7 +1023,7 @@ static Int _user_expand_goal(USES_REGS1) { ARG3 = Yap_GetFromSlot(h2); /* user:goal_expansion(A,CurMod,B) */ if ((pe = RepPredProp( - Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && + Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); @@ -1034,7 +1035,7 @@ static Int _user_expand_goal(USES_REGS1) { /* user:goal_expansion(A,B) */ if (cmod != USER_MODULE && /* we have tried this before */ (pe = RepPredProp( - Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && + Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, NULL PASS_REGS, false)) { return complete_ge(true, omod, sl, creeping); @@ -1054,7 +1055,7 @@ static Int do_term_expansion(USES_REGS1) { ARG1 = g; if ((pe = RepPredProp( - Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) && + Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); @@ -1073,7 +1074,7 @@ static Int do_term_expansion(USES_REGS1) { ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args); ARG2 = Yap_GetFromSlot(h2); if ((pe = RepPredProp( - Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) && + Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, NULL, false PASS_REGS)) { return complete_ge(true, omod, sl, creeping); @@ -1091,7 +1092,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */ return EnterCreepMode(t, mod PASS_REGS); } t = Yap_YapStripModule(t, &mod); -restart_exec: + restart_exec: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); return false; @@ -1390,86 +1391,86 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { sigjmp_buf signew, *sighold = LOCAL_RestartEnv; LOCAL_RestartEnv = &signew; - REGSTORE *old_rs = Yap_regp; if (top && (lval = sigsetjmp(signew, 1)) != 0) { - switch (lval) { - case 1: { /* restart */ + switch (lval) { + case 1: { /* restart */ /* otherwise, SetDBForThrow will fail entering critical mode */ - LOCAL_PrologMode = UserMode; - /* find out where to cut to */ - /* siglongjmp resets the TR hardware register */ - /* TR and B are crucial, they might have been changed, or not */ - restore_TR(); - restore_B(); - /* H is not so important, because we're gonna backtrack */ - restore_H(); - /* set stack */ - ASP = (CELL *) PROTECT_FROZEN_B(B); - /* forget any signals active, we're reborne */ - LOCAL_Signals = 0; - CalculateStackGap(PASS_REGS1); - LOCAL_PrologMode = UserMode; - P = (yamop *) FAILCODE; - } - break; - case 2: { - /* arithmetic exception */ - /* must be done here, otherwise siglongjmp will clobber all the - * registers - */ - /* reset the registers so that we don't have trash in abstract - * machine */ - Yap_set_fpu_exceptions( - getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); - P = (yamop *) FAILCODE; - LOCAL_PrologMode = UserMode; - } - break; - case 3: { /* saved state */ - LOCAL_CBorder = OldBorder; - LOCAL_RestartEnv = sighold; - LOCAL_PrologMode = UserMode; - return false; - } - case 4: - /* abort */ - /* can be called from anywhere, must reset registers, - */ - while (B) { - LOCAL_ActiveError->errorNo = ABORT_EVENT; - Yap_JumpToEnv(); - } - LOCAL_PrologMode = UserMode; - P = (yamop *) FAILCODE; - LOCAL_RestartEnv = sighold; - return false; - break; - case 5: - // going up, unless there is no up to go to. or someone - // but we should inform the caller on what happened. - - Yap_regp = old_rs; - restore_TR(); - restore_B(); - /* H is not so important, because we're gonna backtrack */ - restore_H(); - /* set stack */ - ASP = (CELL *) PROTECT_FROZEN_B(B); - - if (B == NULL || B->cp_b == NULL || (CELL*)(B->cp_b) > LCL0 - LOCAL_CBorder) { - LOCAL_RestartEnv = sighold; - LOCAL_CBorder = OldBorder; - return false; - } - P = FAILCODE; - + LOCAL_PrologMode = UserMode; + /* find out where to cut to */ + /* siglongjmp resets the TR hardware register */ + /* TR and B are crucial, they might have been changed, or not */ + restore_TR(); + restore_B(); + /* H is not so important, because we're gonna backtrack */ + restore_H(); + /* set stack */ + ASP = (CELL *) PROTECT_FROZEN_B(B); + /* forget any signals active, we're reborne */ + LOCAL_Signals = 0; + CalculateStackGap(PASS_REGS1); + LOCAL_PrologMode = UserMode; + P = (yamop *) FAILCODE; + } + break; + case 2: { + /* arithmetic exception */ + /* must be done here, otherwise siglongjmp will clobber all the + * registers + */ + /* reset the registers so that we don't have trash in abstract + * machine */ + Yap_set_fpu_exceptions( + getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); + P = (yamop *) FAILCODE; + LOCAL_PrologMode = UserMode; + } + break; + case 3: { /* saved state */ + LOCAL_CBorder = OldBorder; + LOCAL_RestartEnv = sighold; + LOCAL_PrologMode = UserMode; + return false; + } + case 4: + /* abort */ + /* can be called from anywhere, must reset registers, + */ + while (B) { + LOCAL_ActiveError->errorNo = ABORT_EVENT; + Yap_JumpToEnv(); } + LOCAL_PrologMode = UserMode; + P = (yamop *) FAILCODE; + LOCAL_RestartEnv = sighold; + return false; + break; + case 5: + // going up, unless there is no up to go to. or someone + // but we should inform the caller on what happened. + + // Yap_regp = old_rs; + restore_TR(); + restore_B(); + /* H is not so important, because we're gonna backtrack */ + restore_H(); + /* set stack */ + Yap_JumpToEnv(); + ASP = (CELL *) PROTECT_FROZEN_B(B); + + if (B == NULL || B->cp_b == NULL || (CELL*)(B->cp_b) > LCL0 - LOCAL_CBorder) { + LOCAL_RestartEnv = sighold; + LOCAL_CBorder = OldBorder; + return false; + } + P = FAILCODE; + + } } YENV = ASP; YENV[E_CB] = Unsigned(B); -out = Yap_absmi(0); - /* make sure we don't leave a FAIL signal hanging around */ + out = Yap_absmi(0); + /* make sure we don't leave a FAIL signal hanging around */ Yap_get_signal(YAP_FAIL_SIGNAL); if (!Yap_has_a_signal()) CalculateStackGap(PASS_REGS1); @@ -1543,7 +1544,7 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { bool Yap_exec_absmi(bool top, yap_reset_t has_reset) { CACHE_REGS - return exec_absmi(top, has_reset PASS_REGS); + return exec_absmi(top, has_reset PASS_REGS); } /** @@ -1572,7 +1573,7 @@ void Yap_fail_all(choiceptr bb USES_REGS) { DEPTH = B->cp_depth; #endif /* DEPTH_LIMIT */ YENV = ENV = B->cp_env; -/* recover local stack */ + /* recover local stack */ #ifdef DEPTH_LIMIT DEPTH = ENV[E_DEPTH]; #endif @@ -1685,7 +1686,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { CACHE_REGS - Prop pe; + Prop pe; PredEntry *ppe; CELL *pt; /* preserve the current restart environment */ @@ -1722,7 +1723,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { void Yap_trust_last(void) { CACHE_REGS - ASP = B->cp_env; + ASP = B->cp_env; CP = B->cp_cp; HR = B->cp_h; #ifdef DEPTH_LIMIT @@ -1740,7 +1741,7 @@ void Yap_trust_last(void) { Term Yap_RunTopGoal(Term t, bool handle_errors) { CACHE_REGS - yamop *CodeAdr; + yamop *CodeAdr; Prop pe; PredEntry *ppe; CELL *pt; @@ -1755,9 +1756,9 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) { LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } if (IsPairTerm(t)) { - Term ts[2]; - ts[0] = t; - ts[1] = (CurrentModule == 0? TermProlog: CurrentModule); + Term ts[2]; + ts[0] = t; + ts[1] = (CurrentModule == 0? TermProlog: CurrentModule); t = Yap_MkApplTerm(FunctorCsult,2,ts); } if (IsAtomTerm(t)) { @@ -1978,7 +1979,7 @@ static Int cut_up_to_next_disjunction(USES_REGS1) { */ bool Yap_Reset(yap_reset_t mode, bool hard) { CACHE_REGS - int res = TRUE; + int res = TRUE; Yap_ResetException(worker_id); /* first, backtrack to the root */ @@ -2017,7 +2018,7 @@ bool is_cleanup_cp(choiceptr cp_b) { return pe == PredSafeCallCleanup; } - static Int JumpToEnv(USES_REGS1) { +static Int JumpToEnv(USES_REGS1) { choiceptr handler = B; /* just keep the throwm object away, we don't need to care about it */ @@ -2027,7 +2028,8 @@ bool is_cleanup_cp(choiceptr cp_b) { // DBTerm *dbt = Yap_RefToException(); while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch - && LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE + && LOCAL_CBorder < LCL0 - (CELL *)handler + && handler->cp_ap != NOCODE && handler->cp_b != NULL ) { //if (handler->cp_ap != NOCODE) @@ -2039,236 +2041,230 @@ bool is_cleanup_cp(choiceptr cp_b) { Yap_signal(YAP_FAIL_SIGNAL); } - //B = handler; + B = handler; P = FAILCODE; return true; } bool Yap_JumpToEnv(void) { CACHE_REGS - if (LOCAL_PrologMode & TopGoalMode) - return true; + if (LOCAL_PrologMode & TopGoalMode) + return true; return JumpToEnv(PASS_REGS1); } /* This does very nasty stuff!!!!! */ static Int jump_env(USES_REGS1) { - Term t = Deref(ARG1); + Term t = Deref(ARG1), t0 = t, t1; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound"); return false; - } else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) { - Term t2; - Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS); - // LOCAL_Error_TYPE = ERROR_EVENT; - Term t1 = ArgOfTerm(1, t); - 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(t)) { - LOCAL_ActiveError->errorAsText = RepAtom(AtomOfTerm(t1))->StrOfAE; - LOCAL_ActiveError->classAsText = NULL; - } - } else { - Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS); - LOCAL_ActiveError->errorAsText = NULL; - LOCAL_ActiveError->classAsText = NULL; - //return true; - } - LOCAL_ActiveError->prologPredName = NULL; - bool out = JumpToEnv(PASS_REGS1); - if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && - LCL0 - (CELL *)B > LOCAL_CBorder) { - // we're failing up to the top layer - } - return out; + } 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 { + LOCAL_Error_TYPE = THROW_EVENT; + LOCAL_ActiveError->errorAsText = NULL; + LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t); + LOCAL_ActiveError->classAsText = NULL; + //return true; } - - /* set up a meta-call based on . context info */ - static Int generate_pred_info(USES_REGS1) { - ARG1 = ARG3 = ENV[-EnvSizeInCells - 1]; - ARG4 = ENV[-EnvSizeInCells - 3]; - ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS); - return TRUE; + bool out = JumpToEnv(PASS_REGS1); + if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && + LCL0 - (CELL *)B > LOCAL_CBorder) { + // we're failing up to the top layer } + LOCAL_CommittedError = Yap_GetException(); + return out; +} - void Yap_InitYaamRegs(int myworker_id, bool full_reset) { - Term h0var; - // getchar(); +/* set up a meta-call based on . context info */ +static Int generate_pred_info(USES_REGS1) { + ARG1 = ARG3 = ENV[-EnvSizeInCells - 1]; + ARG4 = ENV[-EnvSizeInCells - 3]; + ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS); + return TRUE; +} + +void Yap_InitYaamRegs(int myworker_id, bool full_reset) { + Term h0var; + // getchar(); #if PUSH_REGS - /* Guarantee that after a longjmp we go back to the original abstract - machine registers */ + /* Guarantee that after a longjmp we go back to the original abstract + machine registers */ #ifdef THREADS - if (myworker_id) { - REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; - pthread_setspecific(Yap_yaamregs_key, (const void *)rs); - REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; - } - /* may be run by worker_id on behalf on myworker_id */ + if (myworker_id) { + REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; + pthread_setspecific(Yap_yaamregs_key, (const void *)rs); + REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; + } + /* may be run by worker_id on behalf on myworker_id */ #else - Yap_regp = &Yap_standard_regs; + Yap_regp = &Yap_standard_regs; #endif #endif /* PUSH_REGS */ - CACHE_REGS - Yap_ResetException(worker_id); - Yap_PutValue(AtomBreak, MkIntTerm(0)); - TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); - HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) + - 1; // +1: hack to ensure the gc does not try to mark mistakenly - LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); - CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); - /* notice that an initial choice-point and environment - *must* be created for the garbage collector to work */ - B = NULL; - ENV = NULL; - P = CP = YESCODE; + CACHE_REGS + Yap_ResetException(LOCAL_ActiveError); + Yap_PutValue(AtomBreak, MkIntTerm(0)); + TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) + + 1; // +1: hack to ensure the gc does not try to mark mistakenly + LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); + CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); + /* notice that an initial choice-point and environment + *must* be created for the garbage collector to work */ + B = NULL; + ENV = NULL; + P = CP = YESCODE; #ifdef DEPTH_LIMIT - DEPTH = RESET_DEPTH(); + DEPTH = RESET_DEPTH(); #endif - STATIC_PREDICATES_MARKED = FALSE; - if (full_reset) { - HR = H0+1; - h0var = MkVarTerm(); - REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); - REMOTE_GcCurrentPhase(myworker_id) = 0L; - REMOTE_GcPhase(myworker_id) = - Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id))); + STATIC_PREDICATES_MARKED = FALSE; + if (full_reset) { + HR = H0+1; + h0var = MkVarTerm(); + REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); + REMOTE_GcCurrentPhase(myworker_id) = 0L; + REMOTE_GcPhase(myworker_id) = + Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id))); #if COROUTINING - REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil); - h0var = MkVarTerm(); - REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); + REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil); + h0var = MkVarTerm(); + REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); #endif - Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id); - } else { - HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id)); - } - Yap_InitPreAllocCodeSpace(myworker_id); + Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id); + } else { + HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id)); + } + Yap_InitPreAllocCodeSpace(myworker_id); #ifdef FROZEN_STACKS - H_FZ = HR; + H_FZ = HR; #ifdef YAPOR_SBA - BSEG = + BSEG = #endif /* YAPOR_SBA */ - BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); - TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); + TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); #endif /* FROZEN_STACKS */ - CalculateStackGap(PASS_REGS1); - /* the first real choice-point will also have AP=FAIL */ - /* always have an empty slots for people to use */ + CalculateStackGap(PASS_REGS1); + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ #if defined(YAPOR) || defined(THREADS) - LOCAL = REMOTE(myworker_id); - worker_id = myworker_id; + LOCAL = REMOTE(myworker_id); + worker_id = myworker_id; #endif /* THREADS */ - Yap_RebootSlots(myworker_id); + Yap_RebootSlots(myworker_id); #if defined(YAPOR) || defined(THREADS) - PP = NULL; - PREG_ADDR = NULL; + PP = NULL; + PREG_ADDR = NULL; #endif - cut_c_initialize(myworker_id); - Yap_PrepGoal(0, NULL, NULL PASS_REGS); + cut_c_initialize(myworker_id); + Yap_PrepGoal(0, NULL, NULL PASS_REGS); #ifdef FROZEN_STACKS - H_FZ = HR; + H_FZ = HR; #ifdef YAPOR_SBA - BSEG = + BSEG = #endif /* YAPOR_SBA */ - BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); - TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); + TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); #endif /* FROZEN_STACKS */ - CalculateStackGap(PASS_REGS1); + CalculateStackGap(PASS_REGS1); #ifdef TABLING - /* ensure that LOCAL_top_dep_fr is always valid */ - if (REMOTE_top_dep_fr(myworker_id)) - DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B); + /* ensure that LOCAL_top_dep_fr is always valid */ + if (REMOTE_top_dep_fr(myworker_id)) + DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B); #endif +} + +int Yap_dogc(int extra_args, Term *tp USES_REGS) { + UInt arity; + yamop *nextpc; + int i; + + if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { + arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; + nextpc = P; + } else { + arity = 0; + nextpc = CP; } - - int Yap_dogc(int extra_args, Term *tp USES_REGS) { - UInt arity; - yamop *nextpc; - int i; - - if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { - arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; - nextpc = P; - } else { - arity = 0; - nextpc = CP; - } - for (i = 0; i < extra_args; i++) { - XREGS[arity + i + 1] = tp[i]; - } - if (!Yap_gc(arity + extra_args, ENV, nextpc)) { - return FALSE; - } - for (i = 0; i < extra_args; i++) { - tp[i] = XREGS[arity + i + 1]; - } - return TRUE; + for (i = 0; i < extra_args; i++) { + XREGS[arity + i + 1] = tp[i]; } + if (!Yap_gc(arity + extra_args, ENV, nextpc)) { + return FALSE; + } + for (i = 0; i < extra_args; i++) { + tp[i] = XREGS[arity + i + 1]; + } + return TRUE; +} - void Yap_InitExecFs(void) { - CACHE_REGS - YAP_opaque_handler_t catcher_ops; - memset(&catcher_ops, 0, sizeof(catcher_ops)); - catcher_ops.cut_handler = watch_cut; - catcher_ops.fail_handler = watch_retry; - setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops); +void Yap_InitExecFs(void) { + CACHE_REGS + YAP_opaque_handler_t catcher_ops; + memset(&catcher_ops, 0, sizeof(catcher_ops)); + catcher_ops.cut_handler = watch_cut; + catcher_ops.fail_handler = watch_retry; + setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops); - Term cm = CurrentModule; - Yap_InitComma(); - Yap_InitCPred("$execute", 1, execute, 0); - Yap_InitCPred("$execute", 2, execute2, 0); - Yap_InitCPred("$execute", 3, execute3, 0); - Yap_InitCPred("$execute", 4, execute4, 0); - Yap_InitCPred("$execute", 5, execute5, 0); - Yap_InitCPred("$execute", 6, execute6, 0); - Yap_InitCPred("$execute", 7, execute7, 0); - Yap_InitCPred("$execute", 8, execute8, 0); - Yap_InitCPred("$execute", 9, execute9, 0); - Yap_InitCPred("$execute", 10, execute10, 0); - Yap_InitCPred("$execute", 11, execute11, 0); - Yap_InitCPred("$execute", 12, execute12, 0); - Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0); - Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0); - Yap_InitCPred("call_with_args", 1, execute_0, 0); - Yap_InitCPred("call_with_args", 2, execute_1, 0); - Yap_InitCPred("call_with_args", 3, execute_2, 0); - Yap_InitCPred("call_with_args", 4, execute_3, 0); - Yap_InitCPred("call_with_args", 5, execute_4, 0); - Yap_InitCPred("call_with_args", 6, execute_5, 0); - Yap_InitCPred("call_with_args", 7, execute_6, 0); - Yap_InitCPred("call_with_args", 8, execute_7, 0); - Yap_InitCPred("call_with_args", 9, execute_8, 0); - Yap_InitCPred("call_with_args", 10, execute_9, 0); - Yap_InitCPred("call_with_args", 11, execute_10, 0); + Term cm = CurrentModule; + Yap_InitComma(); + Yap_InitCPred("$execute", 1, execute, 0); + Yap_InitCPred("$execute", 2, execute2, 0); + Yap_InitCPred("$execute", 3, execute3, 0); + Yap_InitCPred("$execute", 4, execute4, 0); + Yap_InitCPred("$execute", 5, execute5, 0); + Yap_InitCPred("$execute", 6, execute6, 0); + Yap_InitCPred("$execute", 7, execute7, 0); + Yap_InitCPred("$execute", 8, execute8, 0); + Yap_InitCPred("$execute", 9, execute9, 0); + Yap_InitCPred("$execute", 10, execute10, 0); + Yap_InitCPred("$execute", 11, execute11, 0); + Yap_InitCPred("$execute", 12, execute12, 0); + Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0); + Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0); + Yap_InitCPred("call_with_args", 1, execute_0, 0); + Yap_InitCPred("call_with_args", 2, execute_1, 0); + Yap_InitCPred("call_with_args", 3, execute_2, 0); + Yap_InitCPred("call_with_args", 4, execute_3, 0); + Yap_InitCPred("call_with_args", 5, execute_4, 0); + Yap_InitCPred("call_with_args", 6, execute_5, 0); + Yap_InitCPred("call_with_args", 7, execute_6, 0); + Yap_InitCPred("call_with_args", 8, execute_7, 0); + Yap_InitCPred("call_with_args", 9, execute_8, 0); + Yap_InitCPred("call_with_args", 10, execute_9, 0); + Yap_InitCPred("call_with_args", 11, execute_10, 0); #ifdef DEPTH_LIMIT - Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0); + Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0); #endif - Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag); - Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag); - Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); - Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); - Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); - Yap_InitCPred("$ ", 1, - current_choice_point, 0); - CurrentModule = HACKS_MODULE; - Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); - Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); - Yap_InitCPred("env_choice_point", 1, save_env_b, 0); - Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); - CurrentModule = cm; - Yap_InitCPred("$restore_regs", 1, restore_regs, - NoTracePredFlag | SafePredFlag); - Yap_InitCPred("$restore_regs", 2, restore_regs2, - NoTracePredFlag | SafePredFlag); - Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag); - Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction, - SafePredFlag); - Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0); - Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); - Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); - Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); - Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup, - 0); - Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0); - Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); - } + Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag); + Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag); + Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); + Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); + Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); + Yap_InitCPred("$ ", 1, + current_choice_point, 0); + CurrentModule = HACKS_MODULE; + Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); + Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); + Yap_InitCPred("env_choice_point", 1, save_env_b, 0); + Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); + CurrentModule = cm; + Yap_InitCPred("$restore_regs", 1, restore_regs, + NoTracePredFlag | SafePredFlag); + Yap_InitCPred("$restore_regs", 2, restore_regs2, + NoTracePredFlag | SafePredFlag); + Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag); + Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction, + SafePredFlag); + Yap_InitCPred("throw", 1, jump_env, 0); + Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); + Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); + Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); + Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup, + 0); + Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0); + Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); +} diff --git a/C/yap-args.c b/C/yap-args.c index 7f6f4ad6b..d9ab1906c 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -159,15 +159,14 @@ static void consult(const char *b_file USES_REGS) { Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1); - + char *full; + /* consult in C */ int lvl = push_text_stack(); - char *full = Malloc(YAP_FILENAME_MAX + 1); - full[0] = '\0'; /* the consult mode does not matter here, really */ if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0) osno = 0; - c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &oactive); + c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive); if (c_stream < 0) { fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); pop_text_stack(lvl); diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index a3e92f315..047e25861 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -433,11 +433,10 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) { // allow Prolog style exceotion handling // don't forget, on success these bindings will still be there); result = YAP_LeaveGoal(false, &q); - Term terr; - if ((terr = Yap_GetException()) != 0) { + if (LOCAL_CommittedError != nullptr) { std::cerr << "Exception received by " << __func__ << "( " - << YAPTerm(terr).text() << ").\n Forwarded...\n\n"; + << YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n"; // Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm); // throw YAPError(); } @@ -481,12 +480,9 @@ bool YAPEngine::mgoal(Term t, Term tmod) { __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); result = (bool)YAP_EnterGoal(ap, nullptr, &q); - Term terr; - if ((terr = Yap_GetException()) != 0) { + if (LOCAL_CommittedError != nullptr) { std::cerr << "Exception received by " << __func__ << "( " - << YAPTerm(terr).text() << ").\n Forwarded...\n\n"; - // Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm); - // throw YAPError(); + << YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n"; } { @@ -547,13 +543,12 @@ Term YAPEngine::fun(Term t) { q.cp = CP; // make sure this is safe // allow Prolog style exception handling - Term terr; __android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec "); bool result = (bool)YAP_EnterGoal(ap, nullptr, &q); - if ((terr = Yap_GetException()) != 0) { + if (LOCAL_CommittedError != nullptr) { std::cerr << "Exception received by " << __func__ << "( " - << YAPTerm(terr).text() << ").\n Forwarded...\n\n"; + << YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n"; // Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm); // throw YAPError(); } @@ -673,16 +668,12 @@ bool YAPQuery::next() { YAP_LeaveGoal(false, &q_h); Yap_CloseHandles(q_handles); q_open = false; - if (Yap_HasException()) { - terr = Yap_GetException(); - yap_error_descriptor_t *tp = LOCAL_ActiveError->top_error; - memset(LOCAL_ActiveError, 0, sizeof(yap_error_descriptor_t)); - LOCAL_ActiveError->top_error = tp; - std::cerr << "Exception at " << __func__ << "() " << YAPTerm(terr).text() - << ").\n\n\n"; + if (LOCAL_CommittedError != nullptr) { + // Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm); + // throw YAPError(); Term es[2]; es[0] = TermError; - es[1] = terr; + es[1] = MkErrorTerm(LOCAL_CommittedError); Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2); YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es)); // Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm); diff --git a/CXX/yapi.hh b/CXX/yapi.hh index 7a604e7c0..a12ed61de 100644 --- a/CXX/yapi.hh +++ b/CXX/yapi.hh @@ -42,6 +42,14 @@ extern "C" { #include + +#if YAP_PYTHON + +#include + +extern bool python_in_python; +#endif + #include "Yap.h" #include "Yatom.h" @@ -100,13 +108,6 @@ X_API extern void YAP_UserBackCutCPredicate(const char *name, X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp); -#if YAP_PYTHON - -#include - -extern bool python_in_python; -#endif - } diff --git a/CXX/yapie.hh b/CXX/yapie.hh index 09ebea608..c4e80d36b 100644 --- a/CXX/yapie.hh +++ b/CXX/yapie.hh @@ -40,6 +40,11 @@ public: if (ID != YAP_NO_ERROR) {}; std::cerr << "Error detected" << ID << "\n"; } + YAPError(yap_error_descriptor_t *des){ + ID = des->errorNo; + if (ID != YAP_NO_ERROR) {}; + std::cerr << "Error detected" << ID << "\n"; + } /// error handler object with initial data when receiving the error term YAPError(yap_error_number id, YAPTerm culprit, std::string txt); diff --git a/H/Yatom.h b/H/Yatom.h index c904c4eb6..bdb62e0e2 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1601,14 +1601,22 @@ INLINE_ONLY inline EXTERN const char *AtomTermName(Term t) { return RepAtom(AtomOfTerm(t))->rep.uStrOfAE; } -extern bool Yap_ResetException(int wid); +extern Term MkErrorTerm(yap_error_descriptor_t *t); + +extern bool Yap_ResetException(yap_error_descriptor_t *i); extern bool Yap_HasException(void); -extern Term Yap_GetException(void); +extern yap_error_descriptor_t * Yap_GetException(void); extern void Yap_PrintException(void); INLINE_ONLY inline EXTERN bool Yap_HasException(void) { return LOCAL_ActiveError->errorNo != YAP_NO_ERROR; } +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); + extern bool Yap_RaiseException(void); #endif diff --git a/H/locals.h b/H/locals.h index 70a7d9c48..cd2e8810a 100644 --- a/H/locals.h +++ b/H/locals.h @@ -195,6 +195,7 @@ LOCAL(ADDR, TrailTop); /* error handling info, designed to be easy to pass to the foreign world */ LOCAL_INIT(yap_error_descriptor_t *, ActiveError, calloc(sizeof(yap_error_descriptor_t), 1)); +LOCAL_INIT(yap_error_descriptor_t *, CommittedError, calloc(sizeof(yap_error_descriptor_t), 1)); /// pointer to an exception term, from throw LOCAL(jmp_buf, IOBotch); diff --git a/include/YapErrors.h b/include/YapErrors.h index 0114638e4..4255617a3 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -156,6 +156,7 @@ E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow") E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow") E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow") E(INTERRUPT_EVENT, EVENT, "interrupt") +E(USER_EVENT, EVENT, "user event") E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array") E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom") diff --git a/include/YapInterface.h b/include/YapInterface.h index f283e6f30..f2ef4c30f 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -408,7 +408,7 @@ extern X_API void YAP_Write(YAP_Term t, FILE *s, int); extern X_API FILE *YAP_TermToStream(YAP_Term t); -extern X_API int YAP_InitConsult(int mode, const char *filename, char *buf, +extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf, int *previous_sno); extern X_API void YAP_EndConsult(int s, int *previous_sno, const char *previous_cwd); diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 6f114ad6b..fcd2df8e1 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -33,6 +33,7 @@ set(PL_BOOT_SOURCES load_foreign.yap messages.yap meta.yap + metadecls.yap modules.yap newmod.yap os.yap diff --git a/pl/boot.yap b/pl/boot.yap index daad9c7b2..1174bc4ba 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -119,8 +119,6 @@ print_message(L,E) :- format( user_error, '~w in bootstrap: got ~w~n',[L,E]) ). - - '$undefp0'([M|G], _Action) :- stream_property( loop_stream, file_name(F)), stream_property( loop_stream, line_number(L)), @@ -129,6 +127,25 @@ print_message(L,E) :- :- '$undefp_handler'('$undefp0'(_,_),prolog). +/** + * @pred $system_meta_predicates'( +L ) + * + * @param L declare a set of system meta-predicates + * + * @return system predicates +*/ +'$system_meta_predicates'([]). +'$system_meta_predicates'([P|L]) :- + functor(P,N,A), + '$new_meta_pred'(P, prolog), + G = ('$meta_predicate'(N,_M2,A,P) :- true), + '$compile'(G, assertz, G, prolog, _R), + '$system_meta_predicates'(L). + + :- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog). + :- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog). +:- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog). +:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog). /** @@ -175,7 +192,6 @@ print_message(L,E) :- % These are pseudo declarations % so that the user will get a redefining system predicate - % just create a choice-point % the 6th argument marks the time-stamp. '$do_log_upd_clause'(_,_,_,_,_,_). @@ -232,8 +248,9 @@ print_message(L,E) :- :- c_compile('bootlists.yap'). :- c_compile('consult.yap'). :- c_compile('preddecls.yap'). -:- c_compile('preddyns.yap'). :- c_compile('meta.yap'). +:- c_compile('metadecls.yap'). +:- c_compile('preddyns.yap'). :- c_compile('builtins.yap'). :- c_compile('newmod.yap'). @@ -461,5 +478,3 @@ If this hook preodicate succeeds it must instantiate the _Action_ argument to t :- ensure_loaded('../pl/pathconf.yap'). :- yap_flag(user:unknown,error). - - diff --git a/pl/checker.yap b/pl/checker.yap index e409592cb..325a0a2cf 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -72,7 +72,6 @@ The style_check/1 built-in is now deprecated. Please use % % A Small style checker for YAP -:- op(1150, fx, [multifile,discontiguous]). style_check(V) :- var(V), !, fail. style_check(V) :- diff --git a/pl/consult.yap b/pl/consult.yap index 696bc9e93..4178741b5 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -1,4 +1,4 @@ -s444444444444444444444444444444444444444444444444444444444444444444444444/************************************************************************* +/************************************************************************* * * * YAP Prolog * * * @@ -74,6 +74,20 @@ s444444444444444444444444444444444444444444444444444444444444444444444444/****** :- use_system_module( '$_preds', ['$current_predicate'/4]). + +:- '$system_meta_predicates'([ + compile(:), + consult(:), + db_files(:), + ensure_loaded(:), + exo_files(:), + load_files(:,+), + reconsult(:), + use_module(:), + use_module(:,+), + use_module(?,:,+) + ] ). + /** @defgroup YAPConsulting Loading files into YAP diff --git a/pl/errors.yap b/pl/errors.yap index 9b0156be4..c272c5656 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -63,12 +63,7 @@ system_error(Type,Goal) :- '$do_error'(Type,Goal) :- -% format('~w~n', [Type]), - ancestor_location(Call, Caller), - throw(error(Type, [ - [g|g(Goal)], - [p|Call], - [e|Caller]])). + throw(error(Type, [error(Goal)])). /** * @pred system_error( +Error, +Cause, +Culprit) @@ -82,13 +77,8 @@ system_error(Type,Goal) :- * */ system_error(Type,Goal,Culprit) :- - % format('~w~n', [Type]), - ancestor_location(Call, Caller), - throw(error(Type, [ - [i|Culprit], - [g|g(Goal)], - [p|Call], - [e|Caller]])). + ancestor_location(Goal, Culprit), + throw(error(Type, [error(Goal, Culprit)])). '$do_pi_error'(type_error(callable,Name/0),Message) :- !, '$do_error'(type_error(callable,Name),Message). diff --git a/pl/messages.yap b/pl/messages.yap index 1b6777060..b2498ac3d 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -68,7 +68,7 @@ handling in YAP: An error record comsists of An ISO compatible descriptor of the format -error(errror_kind(Culprit,..), Info) +error(errror_kind(Culprit,..), In) In YAP, the info field describes: @@ -213,6 +213,9 @@ 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,_), _), _) --> + !, + [ 'UNEXPECTED SIGNAL: ~a' - [SIG] ]. compose_message(trace_command(C), _Leve) --> !, [ '~a is not a valid debugger command.' - [C] ]. @@ -227,20 +230,74 @@ compose_message(myddas_version(Version), _Leve) --> [ 'MYDDAS version ~a' - [Version] ]. compose_message(yes, _Level) --> !, [ 'yes'- [] ]. -compose_message(Term, Level) --> +compose_message(error(E, exception(Exc)), Level) --> { '$show_consult_level'(LC) }, - location( Term, Level, LC), - main_message( Term, Level, LC ), - c_goal( Term, Level ), - caller( Term, Level ), - extra_info( Term, Level ), + location( Exc, Level, LC), + main_message( Exc, Level, LC ), + c_goal( Exc, Level ), + caller( Exc, Level ), + extra_info( Exc, Level ), !, [nl,nl]. -compose_message(Term, Level) --> +compose_message(error(E,[I|Is]), Level) --> { Level == error -> true ; Level == warning }, - { '$show_consult_level'(LC) }, - main_message( Term, Level, LC), + { '$show_consult_level'(LC), + translate_info([I|Is], In)) + }, + compose_message( e(Err, In), Level), [nl,nl]. +compose_message(Throw), _Leve) --> + !, + [ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ]. + +translate_info([I1|I2],exception(R) ) :- + !, + '$new_exception'(R), + tinfo(R, [I1|I2], []). +translate_info(E, none ). + +tinfo(_Reg) --> + !. +tinfo(Reg) --> + addinfo(Reg), + tinfo(Reg). + +addinfo( Desc) --> + ( [[p|p(M,Na,Ar,File,FilePos)]] + -> + { + '$query_exception'(prologPredFile, Desc, File), + '$query_exception'(prologPredLine, Desc, FilePos), + '$query_exception'(prologPredModule, Desc, M), + '$query_exception'(prologPredName, Desc, Na), + '$query_exception'(prologPredArity, Desc, Ar) + } + ; + [e|p(M,Na,Ar,File,FilePos)], Desc) + -> + { + '$query_exception'(prologPredFile, Desc, File), + '$query_exception'(prologPredLine, Desc, FilePos), + '$query_exception'(prologPredModule, Desc, M), + '$query_exception'(prologPredName, Desc, Na), + '$query_exception'(prologPredArity, Desc, Ar) + } + ; +[[c|c(File, Line, Func)]] + -> + { + '$query_exception'(errorFile, Desc, File), + '$query_exception'(errorFunction, Desc, Func), + '$query_exception'(errorLine, Desc, Line) + } + ; +[[g|g(Call)] +-> + { + '$query_exception'(errorGoal, Desc, Call) + } +). + location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), _ , _) --> !, @@ -249,28 +306,28 @@ 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(_,Desc), Level, LC ) --> +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 ) + '$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(_,Desc), Level, LC ) --> - { '$query_exception'(prologPredFile, Desc, File), - display_consulting( File, Level, LC ), +location( error(_,exception(Desc)), Level, LC ) --> + { '$query_exception'(prologPredFile, Desc, File), '$query_exception'(prologPredLine, Desc, FilePos), '$query_exception'(prologPredModule, Desc, M), '$query_exception'(prologPredName, Desc, Na), '$query_exception'(prologPredArity, Desc, Ar) }, + display_consulting( File, Level, LC ), [ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ]. %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, -main_message(error(Msg,Info), _, _) --> {var(Info)}, !, +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 ) --> !, @@ -336,8 +393,8 @@ display_consulting( F, Level, LC) --> display_consulting(_F, _, _LC) --> []. -caller( error(_,Desc), _) --> - { +caller( error(_,exception(Desc)), _) --> + { '$query_exception'(errorGoal, Desc, Call), Call \= [], '$query_exception'(prologPredFile, Desc, File), @@ -352,8 +409,8 @@ caller( error(_,Desc), _) --> [nl], ['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], [nl]. -caller( error(_,Desc), _) --> - { +caller( error(_,exception(Desc)), _) --> + { '$query_exception'(prologPredFile, Desc, File), File \= [], '$query_exception'(prologPredLine, Desc, FilePos), @@ -364,7 +421,7 @@ caller( error(_,Desc), _) --> !, ['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], [nl]. -caller( error(_,Desc), _) --> +caller( error(_,exception(Desc)), _) --> { '$query_exception'(errorGoal, Desc, Call), Call \= [] }, @@ -374,8 +431,8 @@ caller( error(_,Desc), _) --> caller( _, _) --> []. -c_goal( error(_,Desc), Level ) --> - { '$query_exception'(errorFile, Desc, Func), +c_goal( error(_,exception(Desc)), Level ) --> + { '$query_exception'(errorFile, Desc, File), Func \= [], '$query_exception'(errorFunction, Desc, File), '$query_exception'(errorLine, Desc, Line) @@ -389,9 +446,9 @@ c_goal( _, _Level ) --> []. prolog_message(X) --> system_message(X). -system_message(error(Msg,Info)) --> - ( { var(Msg) } ; { var(Info)} ), !, - ['bad error ~w' - [error(Msg,Info)]]. +system_message(error(Msg,In)) --> + ( { var(Msg) } ; { var(In)} ), !, + ['bad error ~w' - [error(Msg,In)]]. system_message(error(consistency_error(Who),Where)) --> [ 'CONSISTENCY ERROR (arguments not compatible with format)- ~w ~w' - [Who,Where] ]. system_message(error(context_error(Goal,Who),Where)) --> diff --git a/pl/meta.yap b/pl/meta.yap index 9d7b0396b..a98792f08 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -23,22 +23,20 @@ For example, the declaration for call/1 and setof/3 are: :- meta_predicate call(0), setof(?,0,?). ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -meta_predicate declaration - implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration) +The meta_predicate declaration is + implemented by: + - asserting `$meta_predicate(SourceModule,Functor,Arity,Declaration)` + - setting up a `MetaPredicate` flag in the internal predicate descriptor. */ % directive now meta_predicate Ps :- $meta_predicate(Ps). :- use_system_module( '$_arith', ['$c_built_in'/4]). - -:- dynamic prolog:'$meta_predicate'/4. - -:- multifile prolog:'$meta_predicate'/4, - '$inline'/2, - '$full_clause_optimisation'/4. - +meta_predicate(P) :- + source_module(SM), + '$meta_predicate'(P, SM). '$meta_predicate'(P,M) :- var(P), @@ -66,7 +64,7 @@ meta_predicate declaration '$meta_predicate'( _D, _M ). '$install_meta_predicate'(P,M,_F,_N) :- - '$new_meta_pred'(P, M), + '$new_meta_pred'(P, M), fail. '$install_meta_predicate'(_P,M,F,N) :- ( M = prolog -> M2 = _ ; M2 = M), @@ -220,8 +218,8 @@ meta_predicate declaration % % % head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les. -% goals or arguments/sub-arguments? -% I cannot use call here because of format/3 + % goals or arguments/sub-arguments? + % I cannot use call here because of format/3 % modules: % A4: module for body of clause (this is the one used in looking up predicates) % A5: context module (this is the current context @@ -231,16 +229,16 @@ meta_predicate declaration %'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):- writeln(V), fail. '$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :- var(V), - !, + !, ( lists:identical_member(V, HVars) -> - '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) + '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H) ; ( atom(BM) - -> - NG = call(BM:V), - NGO = '$execute_in_mod'(V,BM) - ; + -> + NG = call(BM:V), + NGO = '$execute_in_mod'(V,BM) + ; '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H) ) ). @@ -500,112 +498,3 @@ expand_goal(Input, Output) :- '$yap_strip_module'(SM:G, M, IG), '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), '$yap_strip_module'(M:GF0, MF, GF). - -:- '$install_meta_predicate'((0,0),prolog,(','),2). - -meta_predicate(P) :- - source_module(SM), -'$meta_predicate'(P, SM). - - - -:- meta_predicate - abolish(:), - abolish(:,+), - all(?,0,-), - assert(:), - assert(:,+), - assert_static(:), - asserta(:), - asserta(:,+), - asserta_static(:), - assertz(:), - assertz(:,+), - assertz_static(:), - at_halt(0), - bagof(?,0,-), - bb_get(:,-), - bb_put(:,+), - bb_delete(:,?), - bb_update(:,?,?), - call(0), - call(1,?), - call(2,?,?), - call(3,?,?,?), - call_with_args(0), - call_with_args(1,?), - call_with_args(2,?,?), - call_with_args(3,?,?,?), - call_with_args(4,?,?,?,?), - call_with_args(5,?,?,?,?,?), - call_with_args(6,?,?,?,?,?,?), - call_with_args(7,?,?,?,?,?,?,?), - call_with_args(8,?,?,?,?,?,?,?,?), - call_with_args(9,?,?,?,?,?,?,?,?,?), - call_cleanup(0,0), - call_cleanup(0,?,0), - call_residue(0,?), - call_residue_vars(0,?), - call_shared_object_function(:,+), - catch(0,?,0), - clause(:,?), - clause(:,?,?), - compile(:), - consult(:), - current_predicate(:), - current_predicate(?,:), - db_files(:), - depth_bound_call(0,+), - discontiguous(:), - ensure_loaded(:), - exo_files(:), - findall(?,0,-), - findall(?,0,-,?), - forall(0,0), - format(+,:), - format(+,+,:), - freeze(?,0), - hide_predicate(:), - if(0,0,0), - ignore(0), - incore(0), - initializon(0), - multifile(:), - nospy(:), - not(0), - notrace(0), - once(0), - phrase(2,?), - phrase(2,?,+), - predicate_property(:,?), - predicate_statistics(:,-,-,-), - on_exception(+,0,0), - qsave_program(+,:), - reconsult(:), - retract(:), - retract(:,?), - retractall(:), - reconsult(:), - setof(?,0,-), - setup_call_cleanup(0,0,0), - setup_call_catcher_cleanup(0,0,?,0), - spy(:), - stash_predicate(:), - use_module(:), - use_module(:,+), - use_module(?,:,+), - when(+,0), - with_mutex(+,0), - with_output_to(?,0), - '->'(0 , 0), - '*->'(0 , 0), - ';'(0 , 0), - ^(+,0), - {}(0,?,?), - ','(2,2,?,?), - ';'(2,2,?,?), - '|'(2,2,?,?), - ->(2,2,?,?), - \+(2,?,?), - \+( 0 ) - . diff --git a/pl/metadecls.yap b/pl/metadecls.yap new file mode 100644 index 000000000..9cf0c5068 --- /dev/null +++ b/pl/metadecls.yap @@ -0,0 +1,101 @@ + +/** + * @file metadecl.yap + * @author VITOR SANTOS COSTA + * @date Sat Apr 7 03:08:03 2018 + * + * @brief meta=declarations to run early. + * + * @ingroup YAPMetaPredicates + * +*/ + + +:- '$system_meta_predicates'([ + abolish(:), + abolish(:,+), + all(?,0,-), + assert(:), + assert(:,+), + assert_static(:), + asserta(:), + asserta(:,+), + asserta_static(:), + assertz(:), + assertz(:,+), + assertz_static(:), + at_halt(0), + bagof(?,0,-), + bb_get(:,-), + bb_put(:,+), + bb_delete(:,?), + bb_update(:,?,?), + call(0), + call(1,?), + call(2,?,?), + call(3,?,?,?), + call_with_args(0), + call_with_args(1,?), + call_with_args(2,?,?), + call_with_args(3,?,?,?), + call_with_args(4,?,?,?,?), + call_with_args(5,?,?,?,?,?), + call_with_args(6,?,?,?,?,?,?), + call_with_args(7,?,?,?,?,?,?,?), + call_with_args(8,?,?,?,?,?,?,?,?), + call_with_args(9,?,?,?,?,?,?,?,?,?), + call_cleanup(0,0), + call_cleanup(0,?,0), + call_residue(0,?), + call_residue_vars(0,?), + call_shared_object_function(:,+), + clause(:,?), + clause(:,?,?), + current_predicate(:), + current_predicate(?,:), + depth_bound_call(0,+), + findall(?,0,-), + findall(?,0,-,?), + forall(0,0), + format(+,:), + format(+,+,:), + freeze(?,0), + hide_predicate(:), + if(0,0,0), + ignore(0), + incore(0), + initializon(0), + nospy(:), + not(0), + notrace(0), + once(0), + phrase(2,?), + phrase(2,?,+), + predicate_property(:,?), + predicate_statistics(:,-,-,-), + on_exception(+,0,0), + qsave_program(+,:), + retract(:), + retract(:,?), + retractall(:), + reconsult(:), + setof(?,0,-), + setup_call_cleanup(0,0,0), + setup_call_catcher_cleanup(0,0,?,0), + spy(:), + stash_predicate(:), + when(+,0), + with_mutex(+,0), + with_output_to(?,0), + '->'(0 , 0), + '*->'(0 , 0), + ';'(0 , 0), + ','(0 , 0), + ^(+,0), + {}(0,?,?), + ','(2,2,?,?), + ';'(2,2,?,?), + '|'(2,2,?,?), + ->(2,2,?,?), + \+(2,?,?), + \+( 0 )]). diff --git a/pl/preddecls.yap b/pl/preddecls.yap index 49e58500e..e957db1c6 100644 --- a/pl/preddecls.yap +++ b/pl/preddecls.yap @@ -25,6 +25,15 @@ :- use_system_module( '$_errors', ['$do_error'/2]). + +:- '$system_meta_predicates'([ + discontiguous(:), + multifile(:) + ] + ). + +:- op(1150, fx, [multifile,discontiguous]). + '$log_upd'(1). /** diff --git a/pl/top.yap b/pl/top.yap index f95cd4925..2366bf19c 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -1,3 +1,19 @@ +/** + * @file top.yap + * @author VITOR SANTOS COSTA + * @date Sat Apr 7 03:14:17 2018 + * + * @brief top-level implementation plus system booting.x + * + * @defgroup Top-Level and Boot Predicates + * @ingroup YAPControl + * +*/ + +:- '$system_meta_predicates'([ + catch(0,?,0), + log_event(+,:)]). + live :- '$live'. @@ -64,8 +80,8 @@ live :- '$live'. % stop at spy-points if debugging is on. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), -'$command'(Command,Varnames,Pos,top), -current_prolog_flag(break_level, BreakLevel), + '$command'(Command,Varnames,Pos,top), + current_prolog_flag(break_level, BreakLevel), ( BreakLevel \= 0 -> @@ -985,9 +1001,6 @@ stopped, and the exception is sent to the ancestor goals until reaching a matching catch/3, or until reaching top-level. */ -throw(Ball) :- - % get current jump point - '$jump_env_and_store_ball'(Ball). '$run_toplevel_hooks' :- current_prolog_flag(break_level, 0 ),