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

more exception handling.

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-04-16 14:54:53 +01:00
parent df961cbd62
commit abb328abf0
15 changed files with 262 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/arith0.c
View File

@ -284,6 +284,7 @@ Yap_InitConstExps(void)
}
}
/* This routine is called from Restore to make sure we have the same arithmetic operators */
int
Yap_ReInitConstExps(void)

20
C/arith1.c
View File

@ -972,7 +972,7 @@ p_unary_is( USES_REGS1 )
{ /* X is Y */
Term t = Deref(ARG2);
Term top;
yap_error_number err;
bool go;
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR, t, "unbound unary operator");
@ -980,22 +980,12 @@ p_unary_is( USES_REGS1 )
}
Yap_ClearExs();
top = Yap_Eval(Deref(ARG3));
if ((err=Yap_FoundArithError())) {
Yap_EvalError(err,ARG3,"X is op(Y): error in Y ");
return FALSE;
}
if (IsIntTerm(t)) {
Term tout;
Int i;
i = IntegerOfTerm(t);
tout = eval1(i, top PASS_REGS);
if ((err=Yap_FoundArithError())) {
Functor f = Yap_MkFunctor( Yap_NameOfUnaryOp(i), 1 );
Term t = Yap_MkApplTerm( f, 1, &top );
Yap_EvalError(err, t ,"error in %s/1 ", RepAtom(NameOfFunctor(f))->StrOfAE);
return FALSE;
}
return Yap_unify_constant(ARG1,tout);
} else if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
@ -1008,13 +998,13 @@ p_unary_is( USES_REGS1 )
RepAtom(name)->StrOfAE);
return FALSE;
}
do {
out= eval1(p->FOfEE, top PASS_REGS);
if ((err=Yap_FoundArithError())) {
return FALSE;
}
go = Yap_CheckArithError();
} while(go);
return Yap_unify_constant(ARG1,out);
}
return(FALSE);
return false;
}
static Int

98
C/arith2.c
View File

@ -1146,28 +1146,16 @@ static Int
p_binary_is( USES_REGS1 )
{ /* X is Y */
Term t = Deref(ARG2);
Term t1, t2;
yap_error_number err;
Term t1, t2, tout;
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "VAR(X , Y)");
return(FALSE);
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
if ((err = Yap_FoundArithError())) {
Atom name;
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
name = Yap_NameOfBinaryOp(i);
} else {
name = AtomOfTerm(Deref(ARG2));
}
Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
return FALSE;
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
t2 = Yap_Eval(Deref(ARG4));
if ((err=Yap_FoundArithError())) {
{
Atom name;
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
@ -1175,47 +1163,35 @@ p_binary_is( USES_REGS1 )
} else {
name = AtomOfTerm(Deref(ARG2));
}
Yap_EvalError(err,ARG3,"X is ~s/2: error in first argument ", RepAtom(name)->StrOfAE);
return FALSE;
}
if (IsIntTerm(t)) {
Int i = IntOfTerm(t);
Term tout = eval2(i, t1, t2 PASS_REGS);
if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
Term ts[2], terr;
Atom name = Yap_NameOfBinaryOp( i );
Functor f = Yap_MkFunctor( name, 2 );
ts[0] = t1;
ts[1] = t2;
terr = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, terr ,"error in %s/2 ", RepAtom(name)->StrOfAE);
return FALSE;
}
bool go;
do {
go = false;
tout = eval2(i, t1, t2 PASS_REGS);
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
Term out;
bool go;
int j;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
Yap_EvalError(TYPE_ERROR_EVALUABLE, takeIndicator(t),
"functor %s/2 for arithmetic expression",
RepAtom(name)->StrOfAE);
P = FAILCODE;
return(FALSE);
Yap_EvalError(TYPE_ERROR_EVALUABLE, t, "`%s ", name->StrOfAE
);
}
out= eval2(p->FOfEE, t1, t2 PASS_REGS);
if ((err = Yap_FoundArithError()) != YAP_NO_ERROR) {
Term ts[2], terr;
Functor f = Yap_MkFunctor( name, 2 );
ts[0] = t1;
ts[1] = t2;
terr = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, terr ,"error in ~s/2 ", RepAtom(name)->StrOfAE);
return FALSE;
}
return Yap_unify_constant(ARG1,out);
j = p->FOfEE;
do {
go = false;
Yap_ClearExs();
tout = eval2(j, t1, t2 PASS_REGS);
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1,tout);
}
return FALSE;
}
@ -1226,31 +1202,22 @@ static Int
do_arith23(arith2_op op USES_REGS)
{ /* X is Y */
Term t = Deref(ARG1);
Int out;
Term t1, t2;
yap_error_number err;
bool go;
Term t1, t2, out;
Yap_ClearExs();
if (IsVarTerm(t)) {
Yap_EvalError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
t1 = Yap_Eval(t);
if (t1 == 0L)
return FALSE;
do {
go = false;
Yap_ClearExs();
t1 = Yap_Eval(t);
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
out= eval2(op, t1, t2 PASS_REGS);
if ((err=Yap_FoundArithError())) {
Term ts[2], t;
Functor f = Yap_MkFunctor( Yap_NameOfBinaryOp(op), 2 );
ts[0] = t1;
ts[1] = t2;
t = Yap_MkApplTerm( f, 2, ts );
Yap_EvalError(err, t ,"error in ~s(Y,Z) ",Yap_NameOfBinaryOp(op));
return FALSE;
}
go = Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG3,out);
}
@ -1317,7 +1284,6 @@ p_binary_op_as_integer( USES_REGS1 )
if (IsAtomTerm(t)) {
Atom name = AtomOfTerm(t);
ExpEntry *p;
if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) {
return Yap_unify(ARG1,ARG2);
}

5
C/dbase.c
View File

@ -3940,11 +3940,11 @@ static void complete_lu_erase(LogUpdClause *clau) {
static void EraseLogUpdCl(LogUpdClause *clau) {
PredEntry *ap;
ap = clau->ClPred;
/* no need to erase what has been erased */
if (!(clau->ClFlags & ErasedMask)) {
/* get ourselves out of the list */
clau->ClFlags |= ErasedMask;
/* get ourselves out of the list */
if (clau->ClNext != NULL) {
clau->ClNext->ClPrev = clau->ClPrev;
}
@ -3968,7 +3968,6 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
}
ap->cs.p_code.NOfClauses--;
}
clau->ClFlags |= ErasedMask;
#ifndef THREADS
{
LogUpdClause *er_head = DBErasedList;

208
C/errors.c
View File

@ -264,7 +264,6 @@ bool Yap_Warning(const char *s, ...) {
(void)vsprintf(tmpbuf, fmt, ap);
#endif
} else {
Yap_popErrorContext(false);
return false;
}
va_end(ap);
@ -272,14 +271,12 @@ bool Yap_Warning(const char *s, ...) {
fprintf(stderr, "warning message: %s\n", tmpbuf);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
Yap_popErrorContext(false);
return false;
}
ts[1] = MkAtomTerm(AtomWarning);
ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
Yap_popErrorContext(false);
LOCAL_PrologMode &= ~InErrorMode;
return rc;
}
@ -553,11 +550,12 @@ static char tmpbuf[YAP_BUF_SIZE];
#include "YapErrors.h"
void Yap_pushErrorContext(yap_error_descriptor_t *new_error) {
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
LOCAL_PrologMode = UserMode;
bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error) {
yap_error_number err = LOCAL_ActiveError->errorNo;
memset(new_error, 0, sizeof(yap_error_descriptor_t));
new_error->top_error = LOCAL_ActiveError;
LOCAL_ActiveError = new_error;
return true;
}
/* static void */
@ -568,17 +566,24 @@ void Yap_pushErrorContext(yap_error_descriptor_t *new_error) {
/* LOCAL_ActiveError->top_error = bf; */
/* } */
yap_error_descriptor_t *Yap_popErrorContext(bool pass) {
if (pass && LOCAL_ActiveError->top_error->errorNo == YAP_NO_ERROR &&
LOCAL_ActiveError->errorNo != YAP_NO_ERROR)
memcpy(LOCAL_ActiveError->top_error, LOCAL_ActiveError,
sizeof(yap_error_descriptor_t));
yap_error_descriptor_t *new_error = LOCAL_ActiveError;
LOCAL_ActiveError = LOCAL_ActiveError->top_error;
return new_error;
yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
yap_error_descriptor_t *e =LOCAL_ActiveError;
// last block
LOCAL_ActiveError = e->top_error;
if (e->errorNo) {
if (!LOCAL_ActiveError->errorNo && pass) {
memcpy(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError));
} else {
return e;
}
} else {
if (e->errorNo)
return e;
}
return NULL;
}
void Yap_ThrowError__(const char *file, const char *function, int lineno,
yap_error_number type, Term where, ...) {
va_list ap;
@ -642,6 +647,82 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
va_list ap;
char *fmt;
char s[MAXPATHLEN];
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);
#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;
}
yap_error_number err = LOCAL_ActiveError->errorNo;
/* disallow recursive error handling */
if (LOCAL_PrologMode & InErrorMode && err) {
@ -751,81 +832,6 @@ if (type == INTERRUPT_EVENT) {
// 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);
}
#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);
#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;
}
CalculateStackGap(PASS_REGS1);
#if DEBUG
@ -1037,25 +1043,21 @@ yap_error_descriptor_t *event(Term t, yap_error_descriptor_t *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;
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;
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;
char ename[65];
Term t1, t2;
t1 = ArgOfTerm(1, t);
t2 = ArgOfTerm(2, t);
// LOCAL_Error_TYPE = ERROR_EVENT;
i->errorNo = ERROR_EVENT;
i->errorClass = EVENT;
if (IsApplTerm(t1)) {

17
C/eval.c
View File

@ -200,26 +200,17 @@ arithmetic_operators
/// @memberof is/2
static Int p_is(USES_REGS1) { /* X is Y */
Term out = TermNil;
yap_error_number err;
bool go;
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "var(Y) in X is Y");
return (FALSE);
}
Yap_ClearExs();
do {
go = false;
out = Yap_InnerEval(Deref(ARG2));
if ( (err = Yap_FoundArithError()) == YAP_NO_ERROR )
break;
if (err == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_EvalError(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
}
} while (TRUE);
Yap_CheckArithError();
} while (go);
return Yap_unify_constant(ARG1, out);
}

9
C/exec.c
View File

@ -770,8 +770,10 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B;
yap_error_descriptor_t ctx;
bool newxp = Yap_pushErrorContext(true, &ctx);
bool rc = Yap_RunTopGoal(t, false);
Yap_popErrorContext(newxp, true);
if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB));
// We'll pass it through
@ -948,7 +950,7 @@ static Int tag_cleanup(USES_REGS1) {
static Int cleanup_on_exit(USES_REGS1) {
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1))), bp;
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
@ -2058,6 +2060,9 @@ 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_ThrowError(INSTANTIATION_ERROR, t, "throw/1 must be called instantiated");
}
// Yap_DebugPlWriteln(t);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1);

12
C/text.c
View File

@ -735,21 +735,21 @@ static size_t write_length(const unsigned char *s0, seq_tv_t *out USES_REGS) {
static Term write_number(unsigned char *s, seq_tv_t *out,
bool error_on USES_REGS) {
Term t;
yap_error_descriptor_t new_error;
yap_error_descriptor_t new_error;
int i = push_text_stack();
Yap_pushErrorContext(&new_error);
bool new_rec = Yap_pushErrorContext(true,&new_error);
t = Yap_StringToNumberTerm((char *)s, &out->enc,true);
pop_text_stack(i);
Yap_popErrorContext(error_on);
Yap_popErrorContext(new_rec , true);
return t;
}
static Term string_to_term(void *s, seq_tv_t *out USES_REGS) {
Term o;
yap_error_descriptor_t new_error;
Yap_pushErrorContext(&new_error);
yap_error_descriptor_t new_error;
bool mdnew = Yap_pushErrorContext(true, &new_error);
o = out->val.t = Yap_BufferToTerm(s, TermNil);
Yap_popErrorContext(true);
Yap_popErrorContext(mdnew, true);
return o;
}

3
C/tracer.c
View File

@ -114,7 +114,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
return s;
}
#if defined(__GNUC__)
#if defined(__GNUC__) || defined(__clang__)
unsigned long long vsc_count;
#else
unsigned long vsc_count;
@ -202,6 +202,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
int l = push_text_stack();
/* extern int gc_calls; */
vsc_count++;
//fprintf(stderr,"%p-%p\n",B->cp_tr,TR);
// if (HR < ASP ) return;
// fif (vsc_count == 12534) jmp_deb( 2 );
char *buf = Malloc(512), *top = buf + 511, *b = buf;

4
C/write.c
View File

@ -1231,9 +1231,9 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.Write_strings = flags & BackQuote_String_f;
/* protect slots for portray */
yap_error_descriptor_t ne;
Yap_pushErrorContext(&ne);
bool err = Yap_pushErrorContext(true, &ne);
writeTerm(from_pointer(&t, &rwt, &wglb), priority, 1, FALSE, &wglb, &rwt);
Yap_popErrorContext(true);
Yap_popErrorContext(err,true);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);

146
H/YapEval.h
View File

@ -1,19 +1,18 @@
/*************************************************************************
* *
* YAP Prolog @(#)YapEval.h 1.2
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: YapEval.h *
* Last rev: *
* mods: *
* comments: arithmetical functions info *
* *
*************************************************************************/
* *
* YAP Prolog @(#)YapEval.h 1.2
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: YapEval.h
** Last rev: * mods:
** comments: arithmetical functions info *
* *
*************************************************************************/
/**
@ -165,7 +164,7 @@ overflow
* @addtogroup arithmetic_operators
* @enum arith0_op constant operators
* @brief specifies the available unary arithmetic operators
*/
*/
typedef enum {
/** pi [ISO]
@ -259,25 +258,25 @@ typedef enum {
*/
op_log,
/** log10( _X_ ) [ISO]
*
* Decimal logarithm.
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
*
* Decimal logarithm.
*
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~{.prolog}
* ?- between(1, 10, I), Delta is log10(I*10) + log10(1/(I*10)), format('0
* == ~3g~n',[Delta]), fail.
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 2.22e-16
* 0 == 0
* false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 0
* 0 == 2.22e-16
* 0 == 0
* false.
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
*/
op_log10,
op_sqrt,
op_sin,
@ -399,7 +398,6 @@ extern Term Yap_eval_atom(Int);
extern Term Yap_eval_unary(Int, Term);
extern Term Yap_eval_binary(Int, Term, Term);
typedef struct eval_context {
Functor f;
CELL *fp;
@ -409,17 +407,31 @@ typedef struct eval_context {
extern Term Yap_InnerEval__(Term USES_REGS);
#define Yap_EvalError(id, t, ...) \
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, t, __VA_ARGS__)
{ \
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_ArithError(id, t, ...) \
{ 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__);}
{ \
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_ThrowError__( __FILE__, __FUNCTION__, __LINE__, id, 0L, "")
Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, 0L, "")
#include "inline-only.h"
@ -427,7 +439,28 @@ extern Term Yap_InnerEval__(Term USES_REGS);
#define Yap_InnerEval(x) Yap_InnerEval__(x PASS_REGS)
#define Yap_Eval(x) Yap_Eval__(x PASS_REGS)
#define Yap_FoundArithError() Yap_FoundArithError__(PASS_REGS1)
static inline bool Yap_CheckArithError(void)
{
bool on = false;
yap_error_number err;
if (LOCAL_Error_TYPE== RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
on = false;
Yap_ThrowError(RESOURCE_ERROR_STACK, ARG2, "while running arithmetic");
} else {
on = true;
}
};
if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG) &&
(err = Yap_MathException())) {
Yap_ThrowError(err,ARG2,"Math Error");
}
return on;
}
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
@ -443,14 +476,6 @@ inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); }
inline static void Yap_ClearExs(void) {}
#endif
inline static yap_error_number Yap_FoundArithError__(USES_REGS1) {
if (LOCAL_Error_TYPE != YAP_NO_ERROR )
return LOCAL_Error_TYPE;
if (trueGlobalPrologFlag(
ARITHMETIC_EXCEPTIONS_FLAG)) // test support for exception
return Yap_MathException();
return YAP_NO_ERROR;
}
static inline Term takeIndicator(Term t) {
Term ts[2];
@ -475,9 +500,7 @@ Atom Yap_NameOfBinaryOp(int i);
#define RFLOAT(v) return (MkFloatTerm(v))
#define RBIG(v) return (Yap_MkBigIntTerm(v))
#define RERROR() \
{ \
return (0L); \
}
{ return (0L); }
static inline blob_type ETypeOfTerm(Term t) {
if (IsIntTerm(t))
@ -608,18 +631,19 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS) {
}
}
inline static Term add_int(Int i, Int j USES_REGS) {
#if defined(__clang__)
Int w;
if (!__builtin_add_overflow(i,j,&w))
RINT(w);
return Yap_gmp_add_ints(i, j);;
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);;
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) {

4
include/YapError.h
View File

@ -247,7 +247,7 @@ extern yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,vo
extern const char *Yap_errorName(yap_error_number e);
extern const char *Yap_errorClassName(yap_error_class_number e);
extern void Yap_pushErrorContext(yap_error_descriptor_t * new_error);
extern yap_error_descriptor_t *Yap_popErrorContext(bool pass);
extern bool Yap_pushErrorContext(bool pass, yap_error_descriptor_t *new_error);
extern yap_error_descriptor_t *Yap_popErrorContext(bool oerr, bool pass);
#endif

8
os/readterm.c
View File

@ -991,7 +991,7 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
yap_error_descriptor_t new;
Yap_pushErrorContext(&new);
bool err = Yap_pushErrorContext(true,&new);
int lvl = push_text_stack();
parser_state_t state = YAP_START_PARSING;
while (true) {
@ -1000,7 +1000,7 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
state = initParser(opts, &fe, &re, sno, clause);
if (state == YAP_PARSING_FINISHED) {
pop_text_stack(lvl);
Yap_popErrorContext(true);
Yap_popErrorContext(err, true);
return 0;
}
break;
@ -1031,8 +1031,8 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
#if EMACS
first_char = tokstart->TokPos;
#endif /* EMACS */
Yap_popErrorContext(true);
pop_text_stack(lvl);
Yap_popErrorContext(err, true);
if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
}
@ -1040,7 +1040,7 @@ Term Yap_read_term(int sno, Term opts, bool clause) {
}
}
}
Yap_popErrorContext(true);
Yap_popErrorContext(err,true);
pop_text_stack(lvl);
return 0;
}

3
os/writeterm.c
View File

@ -299,17 +299,14 @@ bool Yap_WriteTerm(int output_stream, Term t, Term opts USES_REGS) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
}
yap_error_descriptor_t new;
Yap_pushErrorContext(&new);
yhandle_t mySlots = Yap_StartSlots();
LOCK(GLOBAL_Stream[output_stream].streamlock);
write_term(output_stream, t, args PASS_REGS);
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
free(args);
Yap_CloseSlots(mySlots);
Yap_popErrorContext(true);
return (TRUE);
}

7
pl/top.yap
View File

@ -965,11 +965,14 @@ catch(G, C, A) :-
).
'$catch'(_,C,A) :-
'$get_exception'(C),
'$run_catch'(A, C).
!,
'$run_catch'(A, C).
'$catch'(_,_C,A) :-
throw(A).
% variable throws are user-handled.
'$run_catch'(G,E) :-
E = '$VAR'(_),
var(E),
!,
call(G ).
'$run_catch'(abort,_) :-