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

fix errors, goes òn. 

fix overflow detection by using clang/gcc buit-ins..
This commit is contained in:
Vitor Santos Costa 2018-04-14 16:25:29 +01:00
parent d172c9a0f7
commit df961cbd62
17 changed files with 407 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
C/arith2.c
View File

@ -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 <bowman@math.ualberta.ca>
*/
@ -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);
}

2
C/cdmgr.c
View File

@ -1480,7 +1480,7 @@ return
);
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
Term cmod = LOCAL_SourceModule;
arity_t extra_arity = 0;

239
C/errors.c
View File

@ -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);

28
C/eval.c
View File

@ -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);

26
C/exec.c
View File

@ -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) {

2
C/scanner.c
View File

@ -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 == '%') {

19
C/stack.c
View File

@ -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;
}

204
H/YapEval.h
View File

@ -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)) {

29
H/arith2.h
View File

@ -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() \
{ \

2
H/locals.h
View File

@ -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);

5
os/getw.h
View File

@ -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);
}

9
os/iopreds.c
View File

@ -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) {

9
os/readterm.c
View File

@ -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;
}
}

10
pl/arith.yap
View File

@ -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).

19
pl/errors.yap
View File

@ -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)).
%% @}

154
pl/messages.yap
View File

@ -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 ).
/**
@}
*/

27
pl/top.yap
View File

@ -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 ).
%