From df961cbd62e160914a9acd5cb70b29583c16fc5f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 14 Apr 2018 16:25:29 +0100 Subject: [PATCH] =?UTF-8?q?fix=20errors,=20goes=20=C3=B2n.=20fix=20overflo?= =?UTF-8?q?w=20detection=20by=20using=20clang/gcc=20buit-ins..?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- C/arith2.c | 33 ++++--- C/cdmgr.c | 2 +- C/errors.c | 239 +++++++++++++++++++++++++++--------------------- C/eval.c | 28 +++--- C/exec.c | 26 ++---- C/scanner.c | 2 + C/stack.c | 19 ++-- H/YapEval.h | 204 +++++++++++++++++++++-------------------- H/arith2.h | 29 ++++-- H/locals.h | 2 + os/getw.h | 5 +- os/iopreds.c | 9 +- os/readterm.c | 9 +- pl/arith.yap | 10 +- pl/errors.yap | 19 ++-- pl/messages.yap | 154 +++++++++---------------------- pl/top.yap | 27 +++++- 17 files changed, 407 insertions(+), 410 deletions(-) diff --git a/C/arith2.c b/C/arith2.c index 5a26fced4..143aaf8eb 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -213,7 +213,7 @@ p_div2(Term t1, Term t2 USES_REGS) { Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is " Int_FORMAT " div 0", i1); if (i1 == Int_MIN && i2 == -1) { #ifdef USE_GMP - return Yap_gmp_add_ints(Int_MAX, 1); + return Yap_gmp_add_ints(Int_MAX, 1); #else Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, "// /2 with %d and %d", i1, i2); @@ -443,7 +443,7 @@ p_xor(Term t1, Term t2 USES_REGS) { switch (ETypeOfTerm(t1)) { case long_int_e: - + switch (ETypeOfTerm(t2)) { case long_int_e: /* two integers */ @@ -643,7 +643,7 @@ p_power(Term t1, Term t2 USES_REGS) } /* next function is adapted from: - Inline C++ integer exponentiation routines + Inline C++ integer exponentiation routines Version 1.01 Copyright (C) 1999-2004 John C. Bowman */ @@ -654,9 +654,9 @@ ipow(Int x, Int p) if (p == 0) return ((CELL)1); if (x == 0 && p > 0) return 0L; - if(p < 0) + if(p < 0) return (-p % 2) ? x : ((CELL)1); - + r = ((CELL)1); for(;;) { if(p & 1) { @@ -1142,7 +1142,7 @@ static InitBinEntry InitBinTab[] = { {"rdiv", op_rdiv} }; -static Int +static Int p_binary_is( USES_REGS1 ) { /* X is Y */ Term t = Deref(ARG2); @@ -1222,7 +1222,7 @@ p_binary_is( USES_REGS1 ) -static Int +static Int do_arith23(arith2_op op USES_REGS) { /* X is Y */ Term t = Deref(ARG1); @@ -1254,55 +1254,55 @@ do_arith23(arith2_op op USES_REGS) return Yap_unify_constant(ARG3,out); } -static Int +static Int export_p_plus( USES_REGS1 ) { /* X is Y */ return do_arith23(op_plus PASS_REGS); } -static Int +static Int export_p_minus( USES_REGS1 ) { /* X is Y */ return do_arith23(op_minus PASS_REGS); } -static Int +static Int export_p_times( USES_REGS1 ) { /* X is Y */ return do_arith23(op_times PASS_REGS); } -static Int +static Int export_p_div( USES_REGS1 ) { /* X is Y */ return do_arith23(op_div PASS_REGS); } -static Int +static Int export_p_and( USES_REGS1 ) { /* X is Y */ return do_arith23(op_and PASS_REGS); } -static Int +static Int export_p_or( USES_REGS1 ) { /* X is Y */ return do_arith23(op_or PASS_REGS); } -static Int +static Int export_p_slr( USES_REGS1 ) { /* X is Y */ return do_arith23(op_slr PASS_REGS); } -static Int +static Int export_p_sll( USES_REGS1 ) { /* X is Y */ return do_arith23(op_sll PASS_REGS); } -static Int +static Int p_binary_op_as_integer( USES_REGS1 ) { /* X is Y */ Term t = Deref(ARG1); @@ -1376,4 +1376,3 @@ Yap_ReInitBinaryExps(void) { return(TRUE); } - diff --git a/C/cdmgr.c b/C/cdmgr.c index c1f327a32..2a12978df 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1480,7 +1480,7 @@ return ); } - + PredEntry *Yap_PredFromClause(Term t USES_REGS) { Term cmod = LOCAL_SourceModule; arity_t extra_arity = 0; diff --git a/C/errors.c b/C/errors.c index 34f90e09b..ed6db0b76 100755 --- a/C/errors.c +++ b/C/errors.c @@ -326,7 +326,7 @@ bool Yap_PrintWarning(Term twarning) { bool rc; Term ts[2], err; - if (LOCAL_PrologMode & InErrorMode && LOCAL_CommittedError && (err = LOCAL_CommittedError->errorNo)) { + if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError && (err = LOCAL_ActiveError->errorNo)) { fprintf(stderr, "%% Warning %s while processing error: %s %s\n", Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f), Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err)); return false; @@ -359,6 +359,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *serr; arity_t arity = 2; + if (LOCAL_ErrorMessage) { serr = LOCAL_ErrorMessage; } else { @@ -499,7 +500,7 @@ static char tmpbuf[YAP_BUF_SIZE]; #define BEGIN_ERROR_CLASSES() \ static Atom mkerrorct(yap_error_class_number c) { \ - switch (c) { + switch (c) { #define ECLASS(CL, A, B) \ case CL: \ @@ -512,7 +513,7 @@ static char tmpbuf[YAP_BUF_SIZE]; #define BEGIN_ERRORS() \ static Term mkerrort(yap_error_number e, Term culprit, Term info) { \ - switch (e) { + switch (e) { #define E0(A, B) \ case A: { \ @@ -641,25 +642,27 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, va_list ap; char *fmt; char s[MAXPATHLEN]; - yap_error_number err; - + yap_error_number err = LOCAL_ActiveError->errorNo; /* disallow recursive error handling */ - if (LOCAL_PrologMode & InErrorMode && - ((err = LOCAL_ActiveError->errorNo) || - ( LOCAL_CommittedError && - LOCAL_CommittedError->errorNo && - (err = LOCAL_CommittedError->errorNo)))) { + if (LOCAL_PrologMode & InErrorMode && 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)); return P; } + if (LOCAL_PrologMode & BootMode || type == SYSTEM_ERROR_FATAL) { + /* 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_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) { P = FAILCODE; CalculateStackGap(PASS_REGS1); return P; } - if (where == 0L || where == TermNil) { + if (where == 0L || where == TermNil||type==INSTANTIATION_ERROR) { LOCAL_ActiveError->culprit = NULL; } else { LOCAL_ActiveError->culprit = Yap_TermToBuffer( @@ -688,7 +691,12 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type, LOCAL_PrologMode, fmt); #endif - if (type == INTERRUPT_EVENT) { +if (LOCAL_ActiveError->errorNo == SYNTAX_ERROR) { + ; +LOCAL_ActiveError->errorClass = SYNTAX_ERROR_CLASS; + return P; +} +if (type == INTERRUPT_EVENT) { fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n", (int)IntOfTerm(where)); Yap_exit(1); @@ -739,13 +747,6 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, 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); - } #ifdef DEBUG // DumpActiveGoals( USES_REGS1 ); #endif /* DEBUG */ @@ -838,7 +839,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, Yap_PrintWarning(MkErrorTerm(Yap_GetException())); return P; } - LOCAL_CommittedError = Yap_GetException(); + //LOCAL_ActiveError = Yap_GetException(); // reset_error_description(); if (!throw) { Yap_JumpToEnv(); @@ -952,10 +953,11 @@ 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) { - if (t->errorNo == THROW_EVENT) + if (t->errorClass == EVENT) return t->errorRawTerm; return mkerrort(t->errorNo, - Yap_BufferToTerm(t->culprit, TermNil), + t->culprit? + Yap_BufferToTerm(t->culprit, TermNil): TermNil, err2list(t)); } @@ -998,115 +1000,141 @@ static Int new_exception(USES_REGS1) { return Yap_unify(ARG1, t); } +static Int committed_exception(USES_REGS1) { + Term t = MkSysError(LOCAL_CommittedError); + return Yap_unify(ARG1, t); +} + static Int get_exception(USES_REGS1) { yap_error_descriptor_t *i; Term t; - i = LOCAL_CommittedError; - LOCAL_CommittedError = NULL; + LOCAL_CommittedError = i = LOCAL_ActiveError; if (i && i->errorNo != YAP_NO_ERROR) { - printErr(i); - if (i->errorNo == THROW_EVENT) + i = Yap_GetException(); + Yap_ResetException(LOCAL_ActiveError); + LOCAL_PrologMode = UserMode; + if (i->errorRawTerm && + (i->errorClass == EVENT || i->errorNo == SYNTAX_ERROR)) { t = i->errorRawTerm; - else if (i->culprit != NULL) { + } 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_DebugPlWriteln(t); } - Yap_ResetException(LOCAL_ActiveError); return Yap_unify(t, ARG1); - } + } return false; } +yap_error_descriptor_t *event(Term t, yap_error_descriptor_t *i) { + i->errorNo = ERROR_EVENT; + i->errorClass = EVENT; + i->errorRawTerm = Yap_SaveTerm(t); + return i; +} + + 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]; Term n = t; - - // LOCAL_Error_TYPE = ERROR_EVENT; - LOCAL_ActiveError->errorNo = USER_EVENT; - LOCAL_ActiveError->errorClass = EVENT; - 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; - } + bool found = false, wellformed = true; + LOCAL_PrologMode = InErrorMode; + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound"); + return false; + } else if (!IsApplTerm(t) || FunctorOfTerm(t) != FunctorError) { + LOCAL_Error_TYPE = THROW_EVENT; + LOCAL_ActiveError->errorClass = EVENT; + LOCAL_ActiveError->errorAsText = Yap_errorName(THROW_EVENT); + LOCAL_ActiveError->classAsText = Yap_errorClassName(Yap_errorClass(THROW_EVENT)); + LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t); + LOCAL_ActiveError->culprit = NULL; + } else { + // LOCAL_Error_TYPE = ERROR_EVENT; + i->errorNo = ERROR_EVENT; + i->errorClass = EVENT; + if (IsApplTerm(t1)) { + Functor f1 = FunctorOfTerm(t1); + arity_t a1 = ArityOfFunctor(f1); + i->errorAsText = ename; + i->classAsText = RepAtom(NameOfFunctor(f1))->StrOfAE; + if (a1 == 1) { + wellformed = false; + } else { + Term ti; + if (!IsAtomTerm((ti = ArgOfTerm(1, t1)))) { + wellformed = false; + } + strncpy(ename, RepAtom(AtomOfTerm(ti))->StrOfAE, 64); + } + if (a1 == 3) { + Term ti; + if (!IsAtomTerm((ti = ArgOfTerm(2, t1)))) + wellformed = false; + strncat(ename, " ", 64); + strncat(ename, RepAtom(AtomOfTerm(ti))->StrOfAE, 64); + } else if (a1 > 3) { + wellformed = false; + } + i->culprit = + Yap_TermToBuffer(ArgOfTerm(a1, t1), ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); + int j; + if (wellformed) { + for (j = 0; j < sizeof(c_error_list) / sizeof(struct c_error_info); j++) { + if (!strcmp(c_error_list[j].name, i->errorAsText) && + (c_error_list[j].class == 0 || + !strcmp(i->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) && + c_error_list[j].class != EVENT)) { + i->errorNo = j; + i->errorClass = c_error_list[j].class; + found = true; + break; + } + } + } + } + } else if (IsAtomTerm(t1)) { + const char *err = RepAtom(AtomOfTerm(t1))->StrOfAE; + if (!strcmp(err, "instantiation_error")) { + i->errorClass = INSTANTIATION_ERROR_CLASS; + i->classAsText = "instantiation_error"; + i->errorAsText = "instantiation_error"; + i->errorNo = INSTANTIATION_ERROR; + found = true; + } else if (!strcmp(err, "uninstantiation_error")) { + i->errorClass = UNINSTANTIATION_ERROR_CLASS; + i->classAsText = "uninstantiation_error"; + i->errorAsText = "uninstantiation_error"; + i->errorNo = UNINSTANTIATION_ERROR; + found = true; } } - } 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; + if (i->errorAsText && i->errorAsText[0]) { + char *errs = malloc(strlen(i->errorAsText) + 1); + strcpy(errs, i->errorAsText); + i->errorAsText = errs; } - } - n = t2; - while (IsPairTerm(t2)) { - Term hd = HeadOfTerm(t2); - if (IsPairTerm(hd)) { - Term hdhd = HeadOfTerm(hd); - Term hdtl = TailOfTerm(hd); - if (hdhd == Termg) { - n = ArgOfTerm(1,hdtl); - - } - - t2 = TailOfTerm(t2); + if (!found) { + return event(t, i); } + if (found) { + n = t2; + } + i->errorGoal = + Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); } - LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(n, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f); - 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; + Yap_prolog_add_culprit(i PASS_REGS); + return i; } static Int is_boolean(USES_REGS1) { @@ -1200,6 +1228,7 @@ void Yap_InitErrorPreds(void) { 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("$committed_exception", 1, committed_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); diff --git a/C/eval.c b/C/eval.c index 452ed8bef..a2a8cd528 100644 --- a/C/eval.c +++ b/C/eval.c @@ -91,6 +91,8 @@ static Term get_matrix_element(Term t1, Term t2 USES_REGS) { } static Term Eval(Term t USES_REGS) { + eval_context_t ctx; + ctx.p = LOCAL_ctx; if (IsVarTerm(t)) { Yap_ArithError(INSTANTIATION_ERROR, t, "in arithmetic"); @@ -134,21 +136,20 @@ static Term Eval(Term t USES_REGS) { return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS); } } + ctx.f = fun; + ctx.fp = RepAppl(t); + LOCAL_ctx = &ctx; *RepAppl(t) = (CELL)AtomFoundVar; t1 = Eval(ArgOfTerm(1, t) PASS_REGS); - if (t1 == 0L) { - *RepAppl(t) = (CELL)fun; - return FALSE; - } if (n == 1) { *RepAppl(t) = (CELL)fun; + LOCAL_ctx = ctx.p; return Yap_eval_unary(p->FOfEE, t1); } t2 = Eval(ArgOfTerm(2, t) PASS_REGS); *RepAppl(t) = (CELL)fun; - if (t2 == 0L) - return FALSE; - return Yap_eval_binary(p->FOfEE, t1, t2); + LOCAL_ctx = ctx.p; + return Yap_eval_binary(p->FOfEE, t1, t2); } } /* else if (IsPairTerm(t)) */ { @@ -161,7 +162,9 @@ static Term Eval(Term t USES_REGS) { } } -Term Yap_InnerEval__(Term t USES_REGS) { return Eval(t PASS_REGS); } +Term Yap_InnerEval__(Term t USES_REGS) { + return Eval(t PASS_REGS); + } #ifdef BEAM Int BEAM_is(void); @@ -196,18 +199,18 @@ arithmetic_operators /// @memberof is/2 static Int p_is(USES_REGS1) { /* X is Y */ - Term out; + Term out = TermNil; yap_error_number err; Term t = Deref(ARG2); if (IsVarTerm(t)) { - Yap_EvalError(INSTANTIATION_ERROR, t, "X is Y"); + Yap_ThrowError(INSTANTIATION_ERROR, t, "var(Y) in X is Y"); return (FALSE); } Yap_ClearExs(); do { out = Yap_InnerEval(Deref(ARG2)); - if ((err = Yap_FoundArithError()) == YAP_NO_ERROR) + if ( (err = Yap_FoundArithError()) == YAP_NO_ERROR ) break; if (err == RESOURCE_ERROR_STACK) { LOCAL_Error_TYPE = YAP_NO_ERROR; @@ -215,9 +218,6 @@ static Int p_is(USES_REGS1) { /* X is Y */ Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage); return FALSE; } - } else { - Yap_EvalError(err, takeIndicator(ARG2), "X is Exp"); - return FALSE; } } while (TRUE); return Yap_unify_constant(ARG1, out); diff --git a/C/exec.c b/C/exec.c index e59a22216..717187cf1 100755 --- a/C/exec.c +++ b/C/exec.c @@ -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 (LOCAL_CommittedError && LOCAL_CommittedError->errorNo != YAP_NO_ERROR) { - e = MkErrorTerm(LOCAL_CommittedError); + if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) { + e = MkErrorTerm(LOCAL_ActiveError); Term t; if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); @@ -873,9 +873,9 @@ static bool watch_retry(Term d0 USES_REGS) { // just do the frrpest if (B >= B0 && !ex_mode && !active) return true; - if (LOCAL_CommittedError && - LOCAL_CommittedError->errorNo != YAP_NO_ERROR) { - e = MkErrorTerm(LOCAL_CommittedError); + if (LOCAL_ActiveError && + LOCAL_ActiveError->errorNo != YAP_NO_ERROR) { + e = MkErrorTerm(LOCAL_ActiveError); if (active) { t = Yap_MkApplTerm(FunctorException, 1, &e); } else { @@ -956,7 +956,7 @@ static Int cleanup_on_exit(USES_REGS1) { while (B->cp_ap->opc == FAIL_OPCODE) B = B->cp_b; - + if (complete) { return true; } @@ -979,7 +979,7 @@ static Int cleanup_on_exit(USES_REGS1) { if (Yap_RaiseException()) { return false; } - return true; + return true; } static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) { @@ -2058,18 +2058,8 @@ bool Yap_JumpToEnv(void) { /* This does very nasty stuff!!!!! */ static Int jump_env(USES_REGS1) { 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) { + // Yap_DebugPlWriteln(t); LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError); - } else { - LOCAL_Error_TYPE = THROW_EVENT; - LOCAL_ActiveError->errorAsText = NULL; - LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t); - LOCAL_ActiveError->classAsText = NULL; - //return true; - } bool out = JumpToEnv(PASS_REGS1); if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && LCL0 - (CELL *)B > LOCAL_CBorder) { diff --git a/C/scanner.c b/C/scanner.c index d4e77042a..be67c6fad 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1671,6 +1671,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments, int pch; if (ch == '.' && (pch = Yap_peek(st - GLOBAL_Stream)) && (chtype(pch) == BS || chtype(pch) == EF || pch == '%')) { + if (chtype(ch) != EF) + getchr(st); t->Tok = Ord(kind = eot_tok); // consume... if (pch == '%') { diff --git a/C/stack.c b/C/stack.c index 1d2988a85..fd7185d95 100644 --- a/C/stack.c +++ b/C/stack.c @@ -548,7 +548,7 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp, t->prologPredLine = cl->lusl.ClLine; } else { t->prologPredLine = cl->lusl.ClSource->ag.line_number; - } + } } else if (pp->PredFlags & DynamicPredFlag) { // DynamicClause *cl; // cl = ClauseCodeToDynamicClause(clcode); @@ -1145,7 +1145,7 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod } else if (pp->cs.p_code.NOfClauses) { if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) { - t->prologPredLine = 0; + t->prologPredLine = 0; } else { t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp)); } @@ -1207,11 +1207,11 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R } else { CELL *curENV = ENV; yamop *curCP = CP; - choiceptr curB; + choiceptr curB = B; PredEntry *pe = EnvPreg(curCP); - while (curCP != YESCODE && curB) { - if (curENV < (CELL *)curB) { + while (curCP != YESCODE) { + if (curENV ) { pe = EnvPreg(curCP); curENV = (CELL *)(curENV[E_E]); if (curENV < ASP || curENV >= LCL0) { @@ -1223,16 +1223,19 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R } if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)) return set_clause_info(t, curCP, pe); - } else { + curCP = (yamop *)(curENV[E_CP]); +} else if (0) { +if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE +&& curB->cp_ap != FAILCODE) { 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; } } - curCP = (yamop *)(curENV[E_CP]); } - + return NULL; } diff --git a/H/YapEval.h b/H/YapEval.h index fa8614f42..fa9863f21 100644 --- a/H/YapEval.h +++ b/H/YapEval.h @@ -49,7 +49,7 @@ in YAP When YAP is built using the GNU multiple precision arithmetic library (GMP), integer arithmetic is unbounded, which means that the size of -integers is only limited by available memory. The type of integer +extern integers is only limited by available memory. The type of integer support can be detected using the Prolog flags bounded, min_integer and max_integer. As the use of GMP is default, most of the following descriptions assume unbounded integer arithmetic. @@ -391,26 +391,34 @@ void Yap_InitConstExps(void); void Yap_InitUnaryExps(void); void Yap_InitBinaryExps(void); -int Yap_ReInitConstExps(void); -int Yap_ReInitUnaryExps(void); -int Yap_ReInitBinaryExps(void); +extern int Yap_ReInitConstExps(void); +extern int Yap_ReInitUnaryExps(void); +extern int Yap_ReInitBinaryExps(void); -Term Yap_eval_atom(Int); -Term Yap_eval_unary(Int, Term); -Term Yap_eval_binary(Int, Term, Term); +extern Term Yap_eval_atom(Int); +extern Term Yap_eval_unary(Int, Term); +extern Term Yap_eval_binary(Int, Term, Term); -Term Yap_InnerEval__(Term USES_REGS); + +typedef struct eval_context { + Functor f; + CELL *fp; + struct eval_context *p; +} eval_context_t; + +extern Term Yap_InnerEval__(Term USES_REGS); #define Yap_EvalError(id, t, ...) \ Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__) #define Yap_ArithError(id, t, ...) \ - { Yap_Error__(false,__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__); return 0L; } + { eval_context_t *ctx = LOCAL_ctx; LOCAL_ctx = NULL; while(ctx) {*ctx->fp = (CELL)(ctx->f); ctx = ctx->p; } \ + Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__);} #define Yap_BinError(id) \ Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, 0L, "") #define Yap_AbsmiError(id) \ - Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, 0L, "") + Yap_ThrowError__( __FILE__, __FUNCTION__, __LINE__, id, 0L, "") #include "inline-only.h" @@ -436,8 +444,6 @@ inline static void Yap_ClearExs(void) {} #endif inline static yap_error_number Yap_FoundArithError__(USES_REGS1) { - if (LOCAL_PrologMode & InErrorMode) - return YAP_NO_ERROR; if (LOCAL_Error_TYPE != YAP_NO_ERROR ) return LOCAL_Error_TYPE; if (trueGlobalPrologFlag( @@ -490,97 +496,97 @@ static inline blob_type ETypeOfTerm(Term t) { } #if USE_GMP -char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base); +extern char *Yap_mpz_to_string(MP_INT *b, char *s, size_t sz, int base); -Term Yap_gmq_rdiv_int_int(Int, Int); -Term Yap_gmq_rdiv_int_big(Int, Term); -Term Yap_gmq_rdiv_big_int(Term, Int); -Term Yap_gmq_rdiv_big_big(Term, Term); +extern Term Yap_gmq_rdiv_int_int(Int, Int); +extern Term Yap_gmq_rdiv_int_big(Int, Term); +extern Term Yap_gmq_rdiv_big_int(Term, Int); +extern Term Yap_gmq_rdiv_big_big(Term, Term); -Term Yap_gmp_add_ints(Int, Int); -Term Yap_gmp_sub_ints(Int, Int); -Term Yap_gmp_mul_ints(Int, Int); -Term Yap_gmp_sll_ints(Int, Int); -Term Yap_gmp_add_int_big(Int, Term); -Term Yap_gmp_sub_int_big(Int, Term); -Term Yap_gmp_sub_big_int(Term, Int); -Term Yap_gmp_mul_int_big(Int, Term); -Term Yap_gmp_div_int_big(Int, Term); -Term Yap_gmp_div_big_int(Term, Int); -Term Yap_gmp_div2_big_int(Term, Int); -Term Yap_gmp_fdiv_int_big(Int, Term); -Term Yap_gmp_fdiv_big_int(Term, Int); -Term Yap_gmp_and_int_big(Int, Term); -Term Yap_gmp_ior_int_big(Int, Term); -Term Yap_gmp_xor_int_big(Int, Term); -Term Yap_gmp_sll_big_int(Term, Int); -Term Yap_gmp_add_big_big(Term, Term); -Term Yap_gmp_sub_big_big(Term, Term); -Term Yap_gmp_mul_big_big(Term, Term); -Term Yap_gmp_div_big_big(Term, Term); -Term Yap_gmp_div2_big_big(Term, Term); -Term Yap_gmp_fdiv_big_big(Term, Term); -Term Yap_gmp_and_big_big(Term, Term); -Term Yap_gmp_ior_big_big(Term, Term); -Term Yap_gmp_xor_big_big(Term, Term); -Term Yap_gmp_mod_big_big(Term, Term); -Term Yap_gmp_mod_big_int(Term, Int); -Term Yap_gmp_mod_int_big(Int, Term); -Term Yap_gmp_rem_big_big(Term, Term); -Term Yap_gmp_rem_big_int(Term, Int); -Term Yap_gmp_rem_int_big(Int, Term); -Term Yap_gmp_exp_int_int(Int, Int); -Term Yap_gmp_exp_int_big(Int, Term); -Term Yap_gmp_exp_big_int(Term, Int); -Term Yap_gmp_exp_big_big(Term, Term); -Term Yap_gmp_gcd_int_big(Int, Term); -Term Yap_gmp_gcd_big_big(Term, Term); +extern Term Yap_gmp_add_ints(Int, Int); +extern Term Yap_gmp_sub_ints(Int, Int); +extern Term Yap_gmp_mul_ints(Int, Int); +extern Term Yap_gmp_sll_ints(Int, Int); +extern Term Yap_gmp_add_int_big(Int, Term); +extern Term Yap_gmp_sub_int_big(Int, Term); +extern Term Yap_gmp_sub_big_int(Term, Int); +extern Term Yap_gmp_mul_int_big(Int, Term); +extern Term Yap_gmp_div_int_big(Int, Term); +extern Term Yap_gmp_div_big_int(Term, Int); +extern Term Yap_gmp_div2_big_int(Term, Int); +extern Term Yap_gmp_fdiv_int_big(Int, Term); +extern Term Yap_gmp_fdiv_big_int(Term, Int); +extern Term Yap_gmp_and_int_big(Int, Term); +extern Term Yap_gmp_ior_int_big(Int, Term); +extern Term Yap_gmp_xor_int_big(Int, Term); +extern Term Yap_gmp_sll_big_int(Term, Int); +extern Term Yap_gmp_add_big_big(Term, Term); +extern Term Yap_gmp_sub_big_big(Term, Term); +extern Term Yap_gmp_mul_big_big(Term, Term); +extern Term Yap_gmp_div_big_big(Term, Term); +extern Term Yap_gmp_div2_big_big(Term, Term); +extern Term Yap_gmp_fdiv_big_big(Term, Term); +extern Term Yap_gmp_and_big_big(Term, Term); +extern Term Yap_gmp_ior_big_big(Term, Term); +extern Term Yap_gmp_xor_big_big(Term, Term); +extern Term Yap_gmp_mod_big_big(Term, Term); +extern Term Yap_gmp_mod_big_int(Term, Int); +extern Term Yap_gmp_mod_int_big(Int, Term); +extern Term Yap_gmp_rem_big_big(Term, Term); +extern Term Yap_gmp_rem_big_int(Term, Int); +extern Term Yap_gmp_rem_int_big(Int, Term); +extern Term Yap_gmp_exp_int_int(Int, Int); +extern Term Yap_gmp_exp_int_big(Int, Term); +extern Term Yap_gmp_exp_big_int(Term, Int); +extern Term Yap_gmp_exp_big_big(Term, Term); +extern Term Yap_gmp_gcd_int_big(Int, Term); +extern Term Yap_gmp_gcd_big_big(Term, Term); -Term Yap_gmp_big_from_64bits(YAP_LONG_LONG); +extern Term Yap_gmp_big_from_64bits(YAP_LONG_LONG); -Term Yap_gmp_float_to_big(Float); -Term Yap_gmp_float_to_rational(Float); -Term Yap_gmp_float_rationalize(Float); +extern Term Yap_gmp_float_to_big(Float); +extern Term Yap_gmp_float_to_rational(Float); +extern Term Yap_gmp_float_rationalize(Float); Float Yap_gmp_to_float(Term); -Term Yap_gmp_add_float_big(Float, Term); -Term Yap_gmp_sub_float_big(Float, Term); -Term Yap_gmp_sub_big_float(Term, Float); -Term Yap_gmp_mul_float_big(Float, Term); -Term Yap_gmp_fdiv_float_big(Float, Term); -Term Yap_gmp_fdiv_big_float(Term, Float); +extern Term Yap_gmp_add_float_big(Float, Term); +extern Term Yap_gmp_sub_float_big(Float, Term); +extern Term Yap_gmp_sub_big_float(Term, Float); +extern Term Yap_gmp_mul_float_big(Float, Term); +extern Term Yap_gmp_fdiv_float_big(Float, Term); +extern Term Yap_gmp_fdiv_big_float(Term, Float); -int Yap_gmp_cmp_big_int(Term, Int); -int Yap_gmp_cmp_int_big(Int, Term); -int Yap_gmp_cmp_big_float(Term, Float); +extern int Yap_gmp_cmp_big_int(Term, Int); +extern int Yap_gmp_cmp_int_big(Int, Term); +extern int Yap_gmp_cmp_big_float(Term, Float); #define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D)) -int Yap_gmp_cmp_big_big(Term, Term); +extern int Yap_gmp_cmp_big_big(Term, Term); -int Yap_gmp_tcmp_big_int(Term, Int); -int Yap_gmp_tcmp_int_big(Int, Term); -int Yap_gmp_tcmp_big_float(Term, Float); +extern int Yap_gmp_tcmp_big_int(Term, Int); +extern int Yap_gmp_tcmp_int_big(Int, Term); +extern int Yap_gmp_tcmp_big_float(Term, Float); #define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D)) -int Yap_gmp_tcmp_big_big(Term, Term); +extern int Yap_gmp_tcmp_big_big(Term, Term); -Term Yap_gmp_neg_int(Int); -Term Yap_gmp_abs_big(Term); -Term Yap_gmp_neg_big(Term); -Term Yap_gmp_unot_big(Term); -Term Yap_gmp_floor(Term); -Term Yap_gmp_ceiling(Term); -Term Yap_gmp_round(Term); -Term Yap_gmp_trunc(Term); -Term Yap_gmp_float_fractional_part(Term); -Term Yap_gmp_float_integer_part(Term); -Term Yap_gmp_sign(Term); -Term Yap_gmp_lsb(Term); -Term Yap_gmp_msb(Term); -Term Yap_gmp_popcount(Term); +extern Term Yap_gmp_neg_int(Int); +extern Term Yap_gmp_abs_big(Term); +extern Term Yap_gmp_neg_big(Term); +extern Term Yap_gmp_unot_big(Term); +extern Term Yap_gmp_floor(Term); +extern Term Yap_gmp_ceiling(Term); +extern Term Yap_gmp_round(Term); +extern Term Yap_gmp_trunc(Term); +extern Term Yap_gmp_float_fractional_part(Term); +extern Term Yap_gmp_float_integer_part(Term); +extern Term Yap_gmp_sign(Term); +extern Term Yap_gmp_lsb(Term); +extern Term Yap_gmp_msb(Term); +extern Term Yap_gmp_popcount(Term); char *Yap_gmp_to_string(Term, char *, size_t, int); size_t Yap_gmp_to_size(Term, int); -int Yap_term_to_existing_big(Term, MP_INT *); -int Yap_term_to_existing_rat(Term, MP_RAT *); +extern int Yap_term_to_existing_big(Term, MP_INT *); +extern int Yap_term_to_existing_rat(Term, MP_RAT *); void Yap_gmp_set_bit(Int i, Term t); #endif @@ -602,15 +608,19 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) { } } -#if __clang__ && FALSE /* not in OSX yet */ -#define DO_ADD() \ - if (__builtin_sadd_overflow(i1, i2, &z)) { \ - goto overflow; \ - } -#endif inline static Term add_int(Int i, Int j USES_REGS) { -#if USE_GMP +#if defined(__clang__) + Int w; + if (!__builtin_add_overflow(i,j,&w)) + RINT(w); + return Yap_gmp_add_ints(i, j);; +#elif defined(__GNUC__) + Int w; + if (!__builtin_add_overflow_p(i,j,w)) + RINT(w); + return Yap_gmp_add_ints(i, j);; +#elif USE_GMP UInt w = (UInt)i + (UInt)j; if (i > 0) { if (j > 0 && (Int)w < 0) @@ -629,7 +639,7 @@ overflow: } /* calculate the most significant bit for an integer */ -Int Yap_msb(Int inp USES_REGS); +extern Int Yap_msb(Int inp USES_REGS); static inline Term p_plus(Term t1, Term t2 USES_REGS) { switch (ETypeOfTerm(t1)) { diff --git a/H/arith2.h b/H/arith2.h index fe815f14a..e58eb0b20 100755 --- a/H/arith2.h +++ b/H/arith2.h @@ -24,7 +24,19 @@ inline static int sub_overflow(Int x, Int i, Int j) { } inline static Term sub_int(Int i, Int j USES_REGS) { - Int x = i - j; +#if defined(__clang__) + Int w; + if (!__builtin_sub_overflow(i,j,&w)) + RINT(w); + return Yap_gmp_add_ints(i, j); +#elif defined(__GNUC__) + Int w; + if (!__builtin_sub_overflow_p(i,j,w)) + RINT(w); + return Yap_gmp_add_ints(i, j); +#else + Int x = i - j; + #if USE_GMP Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0; /* Integer overflow, we need to use big integers */ @@ -38,6 +50,7 @@ inline static Term sub_int(Int i, Int j USES_REGS) { #else RINT(x); #endif +#endif } inline static Int SLR(Int i, Int shift) { @@ -50,8 +63,12 @@ inline static int mul_overflow(Int z, Int i1, Int i2) { return (i2 && z / i2 != i1); } -# -#if defined(__GNUC__) && defined(__i386__) +#if defined(__clang__) || defined(__GNUC__) +#define DO_MULTI() \ + if (__builtin_mul_overflow(i1, i2, &z)) { \ + goto overflow; \ + } +#elif defined(__GNUC__) && defined(__i386__) #define DO_MULTI() \ { \ Int tmp1; \ @@ -75,11 +92,7 @@ inline static int mul_overflow(Int z, Int i1, Int i2) { goto overflow; \ z = i1 * i2; \ } -#elif __clang__ && FALSE /* not in OSX yet */ -#define DO_MULTI() \ - if (__builtin_smul_overflow(i1, i2, &z)) { \ - goto overflow; \ - } + #elif SIZEOF_DOUBLE == 2 * SIZEOF_INT_P #define DO_MULTI() \ { \ diff --git a/H/locals.h b/H/locals.h index cd2e8810a..554340dcb 100644 --- a/H/locals.h +++ b/H/locals.h @@ -236,6 +236,8 @@ LOCAL(struct db_globs *, s_dbg); // eval.c LOCAL(Term, mathtt); LOCAL_INIT(char *, mathstring, NULL); +LOCAL_INIT(struct eval_context *, ctx, NULL); + // grow.c LOCAL_INIT(int, heap_overflows, 0); diff --git a/os/getw.h b/os/getw.h index b2574b0d4..3a0d9004c 100644 --- a/os/getw.h +++ b/os/getw.h @@ -11,7 +11,7 @@ static int post_process_f_weof(StreamDesc *st) } else { return post_process_weof(st); } - + } /// compose a wide char from a sequence of getchars @@ -89,7 +89,7 @@ extern int get_wchar(int sno) { if ( !utf_cont(c1) || !utf_cont(c2)) { return encoding_error(ch, 2, st); // Check for surrogate chars - + } wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f); return post_process_read_wchar(wch, 3, st); @@ -129,6 +129,7 @@ extern int get_wchar(int sno) { wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET; return post_process_read_wchar(wch, 4, st); } + printf("%d %C\n", wch, wch); return post_process_read_wchar(wch, 2, st); } diff --git a/os/iopreds.c b/os/iopreds.c index aeb6e3d80..b9c29c6a3 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1305,7 +1305,7 @@ do_open(Term file_name, Term t2, // Skip scripts that start with !#/.. or similar pop_text_stack(lvl); - + if (open_mode == AtomRead) { strncpy(io_mode, "r", 8); } else if (open_mode == AtomWrite) { @@ -1392,10 +1392,11 @@ do_open(Term file_name, Term t2, check_bom(sno, st); // can change encoding } // follow declaration unless there is v - if (st->status & HAS_BOM_f) + if (st->status & HAS_BOM_f) { st->encoding = enc_id(s_encoding, st->encoding); - else + } else st->encoding = encoding; + Yap_DefaultStreamOps(st); if (script) { open_header(sno, open_mode); } @@ -1575,7 +1576,7 @@ int Yap_OpenStream(const char *fname, const char* io_mode, Term user_name, encod int sno; StreamDesc *st; struct vfs *vfsp; - int flags; + int flags; sno = GetFreeStreamD(); if (sno < 0) { diff --git a/os/readterm.c b/os/readterm.c index c2bfa117e..c1b1e6daa 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -940,7 +940,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { Term t = syntax_error(fe->toklast, inp_stream, fe->cmod, re->cpos); if (ParserErrorStyle == TermError) { - LOCAL_ActiveError->culprit = Yap_TermToBuffer(t, LOCAL_encoding, TermNil); + LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t); LOCAL_Error_TYPE = SYNTAX_ERROR; // dec-10 } else if (Yap_PrintWarning(t)) { @@ -948,7 +948,6 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { return YAP_SCANNING; } } - LOCAL_Error_TYPE = YAP_NO_ERROR; return YAP_PARSING_FINISHED; } @@ -1029,14 +1028,14 @@ Term Yap_read_term(int sno, Term opts, bool clause) { fe.t = 0; break; } - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); - } #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ Yap_popErrorContext(true); pop_text_stack(lvl); + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); + } return fe.t; } } diff --git a/pl/arith.yap b/pl/arith.yap index 1cc22afea..a3244b3cf 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -129,14 +129,18 @@ do_c_built_in(Mod:G, _, H, OUT) :- var(G1), !, do_c_built_metacall(G1, M1, H, OUT). do_c_built_in('$do_error'( Error, Goal), M, Head, - (clause_location(Call, Caller), - strip_module(M:Goal,M1,NGoal), + (strip_module(M:Goal,M1,NGoal), throw(error(Error, - [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]] + print_message( + ['while executing goal ~w' -M1:NGoal,nl, + 'in clause matching ~w'-Head,nl] + ) ) ) ) ) :- !. +do_c_built_in(system_error( Error, Goal), M, Head, ErrorG) :- + do_c_built_in('$do_error'( Error, Goal), M, Head, ErrorG). do_c_built_in(X is Y, M, H, P) :- primitive(X), !, do_c_built_in(X =:= Y, M, H, P). diff --git a/pl/errors.yap b/pl/errors.yap index 88c55202d..47b641a3a 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -63,7 +63,7 @@ system_error(Type,Goal) :- '$do_error'(Type,Goal) :- - throw(error(Type, [[g|g(Goal)]])). + throw(error(Type, print_message(['while calling goal = ~w'-Goal,nl]))). /** * @pred system_error( +Error, +Cause, +Culprit) @@ -77,7 +77,7 @@ system_error(Type,Goal) :- * */ system_error(Type,Goal) :- - hrow(error(Type, [[g|g(Goal)]])). + throw(error(Type, print_message(['while calling goal = ~w'-Goal,nl]))) . '$do_pi_error'(type_error(callable,Name/0),Message) :- !, '$do_error'(type_error(callable,Name),Message). @@ -85,7 +85,7 @@ system_error(Type,Goal) :- '$do_error'(Error,Message). '$Error'(E) :- - '$LoopError'(E,top). + '$LoopError'(E, top). '$LoopError'(_, _) :- flush_output(user_output), @@ -99,7 +99,7 @@ system_error(Type,Goal) :- '$close_error', fail. -'$process_error'('$forward'(Msg), _) :- +'$process_error'('$forward'(Msg), _) :- !, throw( '$forward'(Msg) ). '$process_error'(abort, Level) :- @@ -119,20 +119,13 @@ system_error(Type,Goal) :- current_prolog_flag(break_level, I), throw(abort) ). -'$process_error'(error(thread_cancel(_Id), _G),top) :- - !. -'$process_error'(error(thread_cancel(Id), G), _) :- - !, - throw(error(thread_cancel(Id), G)). '$process_error'(error(permission_error(module,redefined,A),B), Level) :- Level \= top, !, throw(error(permission_error(module,redefined,A),B)). '$process_error'(Error, _Level) :- functor(Error, Severity, _), print_message(Severity, Error), !. -%'$process_error'(error(Msg, Where), _) :- -% Print_message(error,error(Msg, [g|fWhere])), !. -'$process_error'(Throw, _) :- - print_message(error,error(unhandled_exception,Throw)). +'$process_error'(error(Type,Info), _, _) :- + print_message(error,error(unhandled_exception(Type),Info)). %% @} diff --git a/pl/messages.yap b/pl/messages.yap index 018ff3ae8..b84204973 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -197,6 +197,17 @@ compose_message( leash([A|B]), _Level) --> [ 'Leashing set to ~w.' - [[A|B]] ]. compose_message( halt, _Level) --> !, [ 'YAP execution halted.'-[] ]. + + % syntax error. +compose_message(error(E, Exc), Level) --> + { '$show_consult_level'(LC) }, + location(error(E, Exc), Level, LC), + main_message(error(E,Exc) , Level, LC ), + c_goal( Exc, Level ), + caller( Exc, Level ), + extra_info( Exc, Level ), + !, + [nl,nl]. compose_message( false, _Level) --> !, [ 'false.'-[] ]. compose_message( '$abort', _Level) --> !, @@ -228,113 +239,42 @@ compose_message(version(Version), _Leve) --> compose_message(myddas_version(Version), _Leve) --> !, [ 'MYDDAS version ~a' - [Version] ]. -compose_message(yes, _Level) --> !, - [ 'yes'- [] ]. compose_message(style_check(What,FILE,Line,Clause), Level)--> !, { '$show_consult_level'(LC) }, location(style_check(What,FILE,Line,Clause), Level, LC), - main_message(style_check(What,FILE,Line,Clause) , Level, LC ) - ]. -compose_message(error(E, exception(Exc)), Level) --> - { '$show_consult_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) --> - { translate_info([I|Is], In) }, - compose_message( e(E, In), Level), - [nl,nl]. + main_message(style_check(What,FILE,Line,Clause) , Level, LC ). +compose_message(yes, _Level) --> !, + [ 'yes'- [] ]. 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|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]] - -> - [] - ; - [[e|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) - } - ; -[[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) - } - ; - [h|p(M,Na,Ar,File,FilePos)] --> - [] -). - - location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), _ , _) --> !, [ '~a:~d:~d ' - [FileName,LN,0] ] . - location(style_check(_,LN,FileName,_ ), Level , LC) --> !, display_consulting( FileName, Level, LC ), [ '~a:~d:0 ~s ' - [FileName,LN,Level] ] . -location( error(_,exception(Desc)), Level, LC ) --> - { '$query_exception'(prologPredFile, Desc, File), +location( error(_,Info), Level, LC ) --> + { '$error_descriptor'(Info, 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) }, - display_consulting( File, Level, LC ), + !, + display_consulting( File, Level, LC ), [ '~s:~d:0 ~a in ~s:~s/~d:'-[File, FilePos,Level,M,Na,Ar] ]. +location( _Ball, _Level, _LC ) --> []. + %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(Msg,In), _, _) --> {var(Msg)}, !, + [ 'ninstantiated message ~w~n.' - [error(Msg,In)], nl ]. main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) --> !, [' ~a: syntax error ~s' - [Level,Msg]], @@ -354,7 +294,7 @@ main_message(style_check(singleton(SVs),_Pos,_File,P), Level, _LC) --> { svs(SVs,SVs,SVsL), ( SVs = [_] -> NVs = 0 ; NVs = 1 ) }. -main_message(style_check(multiple(N,A,Mod,I0),_Pos,File,_P),_), Level, _LC) --> +main_message(style_check(multiple(N,A,Mod,I0),_Pos,File,_P), Level, _LC) --> !, [ ' ~a: ~a redefines ~q from ~a.' - [Level,File, Mod:N/A, I0] ]. main_message(style_check(discontiguous(N,A,Mod),_S,_W,_P) , Level, _LC)--> @@ -399,11 +339,17 @@ display_consulting( F, Level, LC) --> display_consulting(_F, _, _LC) --> []. -caller( error(_,exception(Desc)), _) --> - { - '$query_exception'(errorGoal, Desc, Call), - Call \= [], - '$query_exception'(prologPredFile, Desc, File), +caller( error(_,Info), _) --> + { '$error_descriptor'(Info, Desc) }, + ({ '$query_exception'(errorGoal, Desc, Call), + Call \= [] + } + -> + ['~*|by ~w' - [10,Call]] + ; + true + ), + { '$query_exception'(prologPredFile, Desc, File), File \= [], '$query_exception'(prologPredLine, Desc, FilePos), '$query_exception'(prologPredModule, Desc, M), @@ -411,33 +357,14 @@ caller( error(_,exception(Desc)), _) --> '$query_exception'(prologPredArity, Desc, Ar) }, !, - ['~*|goal was ~s' - [10,Call]], [nl], - ['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], - [nl]. -caller( error(_,exception(Desc)), _) --> - { - '$query_exception'(prologPredFile, Desc, File), - File \= [], - '$query_exception'(prologPredLine, Desc, FilePos), - '$query_exception'(prologPredModule, Desc, M), - '$query_exception'(prologPredName, Desc, Na), - '$query_exception'(prologPredArity, Desc, Ar) - }, - !, - ['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], - [nl]. -caller( error(_,exception(Desc)), _) --> - { - '$query_exception'(errorGoal, Desc, Call), - Call \= [] }, - !, - ['~*|goal ~q '-[10,Call]], + ['~*| raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]], [nl]. caller( _, _) --> []. -c_goal( error(_,exception(Desc)), Level ) --> +c_goal( error(_,Info), Level ) --> +{ '$error_descriptor'(Info, Desc) }, { '$query_exception'(errorFile, Desc, File), Func \= [], '$query_exception'(errorFunction, Desc, File), @@ -1079,7 +1006,8 @@ prolog:print_message(Severity, Term) :- prolog:print_message(Severity, _Term) :- format('No handler for ~a message ~q,~n',[Severity, _Term]). - +'$error_descriptor'(_Info, Desc) :- + '$committed_exception'( Desc ). /** @} */ diff --git a/pl/top.yap b/pl/top.yap index 274af10cc..27ae78770 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -965,8 +965,31 @@ catch(G, C, A) :- ). '$catch'(_,C,A) :- '$get_exception'(C), - '$execute'(A), - '$true'. + '$run_catch'(A, C). + +% variable throws are user-handled. +'$run_catch'(G,E) :- + E = '$VAR'(_), + !, + call(G ). +'$run_catch'(abort,_) :- + abort. +'$run_catch'('$Error'(E),E) :- + !, + '$LoopError'(E, top ). +'$run_catch'('$LoopError'(E, Where),E) :- + !, + '$LoopError'(E, Where). +'$run_catch'('$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger),E) :- + !, + '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger). +'$run_catch'(_Signal,E) :- + functor( E, N, _), + '$hidden_atom'(N), !, + throw(E). +'$run_catch'( Signal, _E) :- + call( Signal ). + %