This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/errors.c

1259 lines
41 KiB
C
Executable File

/*************************************************************************
* *
* Yap Prolog *
* *
* Yap Prolog Was Developed At Nccup - Universidade Do Porto *
* *
* Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: errors.c *
* Last Rev: *
* Mods: *
* Comments: Yap's error handlers *
* *
*************************************************************************/
#include "absmi.h"
#include "yapio.h"
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_EXECINFO_H
#include <execinfo.h>
#endif
#include "Foreign.h"
#define set_key_b(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = t == TermTrue ? true : false; \
return i->k || t == TermFalse; \
}
#define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
}
#define set_key_s(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
const char *s = IsAtomTerm(t) ? RepAtom(AtomOfTerm(t))->StrOfAE \
: IsStringTerm(t) ? StringOfTerm(t) : NULL; \
if (s) { \
char *tmp = calloc(1,strlen(s) + 1); \
strcpy(tmp, s); \
i->k = tmp; \
} \
return i->k != NULL; \
}
static bool setErr(const char *q, yap_error_descriptor_t *i, Term t) {
set_key_i(errorNo, "errorNo", q, i, t);
set_key_i(errorClass, "errorClass", q, i, t);
set_key_s(errorAsText, "errorAsText", q, i, t);
set_key_s(errorGoal, "errorGoal", q, i, t);
set_key_s(classAsText, "classAsText", q, i, t);
set_key_i(errorLine, "errorLine", q, i, t);
set_key_s(errorFunction, "errorFunction", q, i, t);
set_key_s(errorFile, "errorFile", q, i, t);
set_key_i(prologPredLine, "prologPredLine", q, i, t);
set_key_i(prologPredFirstLine, "prologPredFirstLine", q, i, t);
set_key_i(prologPredLastLine, "prologPredLastLine", q, i, t);
set_key_s(prologPredName, "prologPredName", q, i, t);
set_key_i(prologPredArity, "prologPredArity", q, i, t);
set_key_s(prologPredModule, "prologPredModule", q, i, t);
set_key_s(prologPredFile, "prologPredFile", q, i, t);
set_key_i(prologParserPos, "prologParserPos", q, i, t);
set_key_i(prologParserLine, "prologParserLine", q, i, t);
set_key_i(prologParserFirstLine, "prologParserFirstLine", q, i, t);
set_key_i(prologParserLastLine, "prologParserLastLine", q, i, t);
set_key_s(prologParserText, "prologParserText", q, i, t);
set_key_s(prologParserFile, "prologParserFile", q, i, t);
set_key_b(prologConsulting, "prologConsulting", q, i, t);
set_key_s(culprit, "culprit", q, i, t);
set_key_s(errorMsg, "errorMsg", q, i, t);
set_key_i(errorMsgLen, "errorMsgLen", q, i, t);
return false;
}
#define query_key_b(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return i->k ? TermTrue : TermFalse; \
}
#define query_key_i(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return MkIntegerTerm(i->k); \
}
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0) { \
return (i->k && i->k[0] ? MkStringTerm(i->k) : TermNil); \
}
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i(errorNo, "errorNo", q, i);
query_key_i(errorClass, "errorClass", q, i);
query_key_s(errorAsText, "errorAsText", q, i);
query_key_s(errorGoal, "errorGoal", q, i);
query_key_s(classAsText, "classAsText", q, i);
query_key_i(errorLine, "errorLine", q, i);
query_key_s(errorFunction, "errorFunction", q, i);
query_key_s(errorFile, "errorFile", q, i);
query_key_i(prologPredLine, "prologPredLine", q, i);
query_key_i(prologPredFirstLine, "prologPredFirstLine", q, i);
query_key_i(prologPredLastLine, "prologPredLastLine", q, i);
query_key_s(prologPredName, "prologPredName", q, i);
query_key_i(prologPredArity, "prologPredArity", q, i);
query_key_s(prologPredModule, "prologPredModule", q, i);
query_key_s(prologPredFile, "prologPredFile", q, i);
query_key_i(prologParserPos, "prologParserPos", q, i);
query_key_i(prologParserLine, "prologParserLine", q, i);
query_key_i(prologParserFirstLine, "prologParserFirstLine", q, i);
query_key_i(prologParserLastLine, "prologParserLastLine", q, i);
query_key_s(prologParserText, "prologParserText", q, i);
query_key_s(prologParserFile, "prologParserFile", q, i);
query_key_b(prologConsulting, "prologConsulting", q, i);
query_key_s(culprit, "culprit", q, i);
query_key_s(errorMsg, "errorMsg", q, i);
query_key_i(errorMsgLen, "errorMsgLen", q, i);
return TermNil;
}
static void print_key_b(const char *key, bool v) {
const char *b = v ? "true" : "false";
fprintf(stderr, "%s: %s\n", key, b);
}
static void print_key_i(const char *key, YAP_Int v) {
fprintf(stderr, "%s: " Int_FORMAT "\n", key, v);
}
static void print_key_s(const char *key, const char *v) {
fprintf(stderr, "%s: %s\n", key, v);
}
static void printErr(yap_error_descriptor_t *i) {
if (i->errorNo == YAP_NO_ERROR) {
return;
}
print_key_i("errorNo", i->errorNo);
print_key_i("errorClass", (i->errorClass = Yap_errorClass(i->errorNo)));
print_key_s("errorAsText", (i->errorAsText=Yap_errorName(i->errorNo) ) );
print_key_s("errorGoal", i->errorGoal);
print_key_s("classAsText", (i->classAsText=Yap_errorClassName(i->errorClass)));
print_key_i("errorLine", i->errorLine);
print_key_s("errorFunction", i->errorFunction);
print_key_s("errorFile", i->errorFile);
print_key_i("prologPredLine", i->prologPredLine);
print_key_i("prologPredFirstLine", i->prologPredFirstLine);
print_key_i("prologPredLastLine", i->prologPredLastLine);
print_key_s("prologPredName", i->prologPredName);
print_key_i("prologPredArity", i->prologPredArity);
print_key_s("prologPredModule", i->prologPredModule);
print_key_s("prologPredFile", i->prologPredFile);
print_key_i("prologParserPos", i->prologParserPos);
print_key_i("prologParserLine", i->prologParserLine);
print_key_i("prologParserFirstLine", i->prologParserFirstLine);
print_key_i("prologParserLastLine", i->prologParserLastLine);
print_key_s("prologParserText", i->prologParserText);
print_key_s("prologParserFile", i->prologParserFile);
print_key_b("prologConsulting", i->prologConsulting);
print_key_s("culprit", i->culprit);
if (i->errorMsgLen) {
print_key_s("errorMsg", i->errorMsg);
print_key_i("errorMsgLen", i->errorMsgLen);
}
}
static YAP_Term add_key_b(const char *key, bool v, YAP_Term o0) {
YAP_Term tkv[2];
tkv[1] = v ? TermTrue : TermFalse;
tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
static YAP_Term add_key_i(const char *key, YAP_Int v, YAP_Term o0) {
YAP_Term tkv[2];
tkv[1] = MkIntegerTerm(v), tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
static YAP_Term add_key_s(const char *key, const char *v, YAP_Term o0) {
Term tkv[2];
if (!v || v[0] == '\0')
return o0;
tkv[1] = MkStringTerm(v), tkv[0] = MkStringTerm(key);
Term node = Yap_MkApplTerm(FunctorEq, 2, tkv);
return MkPairTerm(node, o0);
}
static Term err2list(yap_error_descriptor_t *i) {
Term o = TermNil;
if (i->errorNo == YAP_NO_ERROR) {
return o;
}
o = add_key_i("errorNo", i->errorNo, o);
o = add_key_i("errorClass", i->errorClass, o);
o = add_key_s("errorAsText", i->errorAsText, o);
o = add_key_s("errorGoal", i->errorGoal, o);
o = add_key_s("classAsText", i->classAsText, o);
o = add_key_i("errorLineq", i->errorLine, o);
o = add_key_s("errorFunction", i->errorFunction, o);
o = add_key_s("errorFile", i->errorFile, o);
o = add_key_i("prologPredLine", i->prologPredLine, o);
o = add_key_i("prologPredFirstLine", i->prologPredFirstLine, o);
o = add_key_i("prologPredLastLine", i->prologPredLastLine, o);
o = add_key_s("prologPredName", i->prologPredName, o);
o = add_key_i("prologPredArity", i->prologPredArity, o);
o = add_key_s("prologPredModule", i->prologPredModule, o);
o = add_key_s("prologPredFile", i->prologPredFile, o);
o = add_key_i("prologParserPos", i->prologParserPos, o);
o = add_key_i("prologParserLine", i->prologParserLine, o);
o = add_key_i("prologParserFirstLine", i->prologParserFirstLine, o);
o = add_key_i("prologParserLastLine", i->prologParserLastLine, o);
o = add_key_s("prologParserText", i->prologParserText, o);
o = add_key_s("prologParserFile", i->prologParserFile, o);
o = add_key_b("prologConsulting", i->prologConsulting, o);
o = add_key_s("culprit", i->culprit, o);
if (i->errorMsgLen) {
o = add_key_s("errorMsg", i->errorMsg, o);
o = add_key_i("errorMsgLen", i->errorMsgLen, o);
}
return o;
}
bool Yap_Warning(const char *s, ...) {
CACHE_REGS
va_list ap;
PredEntry *pred;
bool rc;
Term ts[2];
const char *fmt;
char tmpbuf[MAXPATHLEN];
yap_error_number err;
LOCAL_DoingUndefp = true;
if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) {
fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s,
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
Yap_RestartYap(1);
}
LOCAL_PrologMode |= InErrorMode;
pred = RepPredProp(PredPropByFunc(FunctorPrintMessage,
PROLOG_MODULE)); // PROCEDURE_print_message2
va_start(ap, s);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(tmpbuf, fmt, ap);
#endif
} else {
return false;
}
va_end(ap);
if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) {
fprintf(stderr, "warning message: %s\n", tmpbuf);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
return false;
}
ts[1] = MkAtomTerm(AtomWarning);
ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_PrologMode &= ~InErrorMode;
return rc;
}
void Yap_InitError__(const char *file, const char *function, int lineno,
yap_error_number e, Term t, ...) {
CACHE_REGS
va_list ap;
va_start(ap, t);
const char *fmt;
char tmpbuf[MAXPATHLEN];
fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(tmpbuf, fmt, ap);
#endif
} else
return;
va_end(ap);
if (LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
yap_error_number err = LOCAL_ActiveError->errorNo;
fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", Yap_errorName(e),
Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
return;
}
LOCAL_ActiveError->errorNo = e;
LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0;
if (fmt) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy(LOCAL_ActiveError->errorMsg, tmpbuf);
} else {
LOCAL_Error_Size = 0;
}
}
bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, ENC_ISO_UTF8,Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc;
Term ts[2], err;
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;
}
LOCAL_PrologMode |= InErrorMode;
if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) {
fprintf(stderr, "warning message:\n");
Yap_DebugPlWrite(twarning);
fprintf(stderr, "\n");
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod;
return false;
}
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode;
return rc;
}
bool Yap_HandleError__(const char *file, const char *function, int lineno,
const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
arity_t arity = 2;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = s;
}
if (P != FAILCODE) {
if (P->opc == Yap_opcode(_try_c) || P->opc == Yap_opcode(_try_userc) ||
P->opc == Yap_opcode(_retry_c) || P->opc == Yap_opcode(_retry_userc)) {
arity = P->y_u.OtapFs.p->ArityOfPE;
} else {
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
}
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(arity, ENV, gc_P(P, CP))) {
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_STACK, ARG1,
serr);
return false;
}
LOCAL_PrologMode = UserMode;
return true;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK,
ARG1, serr);
return false;
}
LOCAL_PrologMode = UserMode;
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error__(false, file, function, lineno, RESOURCE_ERROR_HEAP, ARG2,
serr);
return false;
}
default:
if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else
LOCAL_PrologMode &= ~InErrorMode;
return false;
}
}
int Yap_SWIHandleError(const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
} else {
serr = (char *)s;
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return true;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(false, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return false;
}
default:
Yap_Error(err, TermNil, serr);
return false;
}
}
void Yap_RestartYap(int flag) {
CACHE_REGS
#if PUSH_REGS
restore_absmi_regs(&Yap_standard_regs);
#endif
siglongjmp(*LOCAL_RestartEnv, flag);
}
static void error_exit_yap(int value) {
CACHE_REGS
if (!(LOCAL_PrologMode & BootMode)) {
#if DEBUG
#endif
}
fprintf(stderr, "\n Exiting ....\n");
#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
Yap_exit(value);
}
/* This needs to be a static because I can't trust the stack (WIN32), and
I can't trust the Yap stacks (error) */
#define YAP_BUF_SIZE 512
static char tmpbuf[YAP_BUF_SIZE];
// error classes: based on OSI errors.
//
// - The extra argument says whether there different instances
//
// - Events are treated within the same pipeline as errors.
//
#undef BEGIN_ERROR_CLASSES
#undef ECLASS
#undef END_ERROR_CLASSES
#undef BEGIN_ERRORS
#undef E0
#undef E
#undef E1
#undef E2
#undef END_ERRORS
#define BEGIN_ERROR_CLASSES() \
static Atom mkerrorct(yap_error_class_number c) { \
switch (c) {
#define ECLASS(CL, A, B) \
case CL: \
return Yap_LookupAtom(A);
#define END_ERROR_CLASSES() \
} \
return NULL; \
}
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term culprit, Term info) { \
switch (e) {
#define E0(A, B) \
case A: { \
Term ft[2]; \
ft[0] = MkAtomTerm(mkerrorct(B)); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E(A, B, C) \
case A: { \
Term ft[2], nt[2]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkVarTerm(); \
Yap_unify(nt[1], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 2), 2, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E1(A, B, C) \
case A: { \
Term ft[2], nt[1]; \
nt[0] = MkVarTerm(); \
Yap_unify(nt[0], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(C), 1), 1, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define E2(A, B, C, D) \
case A: { \
Term ft[2], nt[3]; \
nt[0] = MkAtomTerm(Yap_LookupAtom(C)); \
nt[1] = MkAtomTerm(Yap_LookupAtom(D)); \
nt[2] = MkVarTerm(); \
Yap_unify(nt[2], culprit); \
ft[0] = Yap_MkApplTerm(Yap_MkFunctor(mkerrorct(B), 3), 3, nt); \
ft[1] = info; \
return Yap_MkApplTerm(FunctorError, 2, ft); \
}
#define END_ERRORS() \
} \
return TermNil; \
}
#include "YapErrors.h"
bool Yap_pushErrorContext(bool pass, 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;
return true;
}
/* static void */
/* reset_error_description(void) { */
/* yap_error_descriptor_t *bf = LOCAL_ActiveError->top_error; */
/* if (Yap_HasException()) */
/* memset(LOCAL_ActiveError, 0, sizeof(*LOCAL_ActiveError)); */
/* LOCAL_ActiveError->top_error = bf; */
/* } */
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) {
memmove(LOCAL_ActiveError, e, sizeof(*LOCAL_ActiveError));
} else {
return e;
}
} else {
if (e->errorNo)
return e;
}
return NULL;
}
/**
* Throw an error directly to the error handler
*
* @param file where
* @param function who
* @param lineno when
* @param type what, error code
* @param where how, user information
*/
void Yap_ThrowError__(const char *file, const char *function, int lineno,
yap_error_number type, Term where, ...) {
va_list ap;
char tmpbuf[MAXPATHLEN];
va_start(ap, where);
char *fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(tnpbuf, fmt, ap);
#endif
// fprintf(stderr, "warning: ");
Yap_Error__(true, file, function, lineno, type, where, tmpbuf);
} else {
Yap_Error__(true, file, function, lineno, type, where);
}
if (LOCAL_RestartEnv && !LOCAL_delay) {
Yap_RestartYap(5);
}
Yap_exit(5);
}
/**
* complete delayed error.
*
*/
void Yap_ThrowExistingError(void) {
if (LOCAL_RestartEnv) {
Yap_RestartYap(5);
}
Yap_exit(5);
}
bool Yap_MkErrorRecord(yap_error_descriptor_t *r, const char *file,
const char *function, int lineno, yap_error_number type,
Term where, const char *s) {
if (!Yap_pc_add_location(r, CP, B, ENV))
Yap_env_add_location(r, CP, B, ENV, 0);
if (where == 0L || where == TermNil || type == INSTANTIATION_ERROR) {
r->culprit = NULL;
} else {
r->culprit = Yap_TermToBuffer(
where, ENC_ISO_UTF8, Quote_illegal_f | Ignore_ops_f | Unfold_cyclics_f);
}
if (LOCAL_consult_level > 0) {
r->prologParserFile = Yap_ConsultingFile(PASS_REGS1)->StrOfAE;
r->prologParserLine = Yap_source_line_no();
}
r->errorNo = type;
r->errorAsText = Yap_errorName(type);
r->errorClass = Yap_errorClass(type);
r->classAsText = Yap_errorClassName(r->errorClass);
r->errorLine = lineno;
r->errorFunction = function;
r->errorFile = file;
Yap_prolog_add_culprit(r PASS_REGS1);
LOCAL_PrologMode |= InErrorMode;
Yap_ClearExs();
// first, obtain current location
// sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno,
// function);
// tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf));
#if DEBUG_STRICT
if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode))
fprintf(stderr, "***** Processing Error %d (%lx,%x) %s***\n", type,
(unsigned long int)LOCAL_Signals, LOCAL_PrologMode, fmt);
else
fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type,
LOCAL_PrologMode, fmt);
#endif
if (r->errorNo == SYNTAX_ERROR) {
r->errorClass = SYNTAX_ERROR_CLASS;
} else if (r->errorNo == SYNTAX_ERROR_NUMBER) {
r->errorClass = SYNTAX_ERROR_CLASS;
r->errorNo = SYNTAX_ERROR;
}
if (type == INTERRUPT_EVENT) {
fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n",
(int)IntOfTerm(where));
Yap_exit(1);
}
// fprintf(stderr, "warning: ");
if (s && s[0]) {
r->errorMsgLen = strlen(s) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, s);
} else if (LOCAL_ErrorMessage && LOCAL_ErrorMessage[0]) {
r->errorMsgLen = strlen(LOCAL_ErrorMessage) + 1;
r->errorMsg = malloc(r->errorMsgLen);
strcpy(r->errorMsg, LOCAL_ErrorMessage);
} else {
r->errorMsgLen = 0;
r->errorMsg = 0;
}
return true;
}
/**
* @brief Yap_Error
* This function handles errors in the C code. Check errors.yap for the
*corresponding Prolog code.
*
* @param file C source
* @param function C function
* @param lineno C exact line
* @param type the error ID (in YAP this is a single integer)
* @param where the culprit
* @return usually FAILCODE
*
* In a good day, the error handler's job is to generate a throw. This includes:
* - constructing an ISO style error term;
* - constructing a list with all available info on the bug
* - generating the throw
* - forcing backtracking in order to restart.
*
* In a bad day, it has to deal with OOM, abort, and errors within errorts.
*
*/
yamop *Yap_Error__(bool throw, const char *file, const char *function,
int lineno, yap_error_number type, Term where, ...) {
CACHE_REGS
va_list ap;
char *fmt;
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:
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
(void)vsprintf(s, fmt, ap);
#endif
va_end(ap);
break;
}
}
Yap_MkErrorRecord(LOCAL_ActiveError, file, function, lineno, type, where, s);
if (where == 0 || where == TermNil) {
LOCAL_ActiveError->culprit = 0;
}
if (P == (yamop *)(FAILCODE)) {
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
/* PURE_ABORT may not have set where correctly, BootMode may not have the data
* terms ready */
if (type == ABORT_EVENT || LOCAL_PrologMode & BootMode) {
LOCAL_PrologMode &= ~AbortMode;
LOCAL_PrologMode &= ~InErrorMode;
/* make sure failure will be seen at next port */
// no need to lock & unlock
if (LOCAL_PrologMode & AsyncIntMode)
Yap_signal(YAP_FAIL_SIGNAL);
P = FAILCODE;
} else {
/* Exit Abort Mode, if we were there */
LOCAL_PrologMode &= ~AbortMode;
LOCAL_PrologMode |= InErrorMode;
}
#ifdef DEBUG
// DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */
CalculateStackGap(PASS_REGS1);
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
#endif
/* wait if we we are in user code,
it's up to her to decide */
if (LOCAL_delay)
return P;
if (LOCAL_DoingUndefp) {
LOCAL_DoingUndefp = false;
LOCAL_Signals = 0;
Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
return P;
}
// LOCAL_ActiveError = Yap_GetException();
// reset_error_description();
if (!throw) {
Yap_JumpToEnv();
pop_text_stack(LOCAL_MallocDepth+1);
}
LOCAL_PrologMode = UserMode;
return P;
}
static Int close_error(USES_REGS1) {
if (!LOCAL_CommittedError)
return true;
LOCAL_CommittedError->errorNo = YAP_NO_ERROR;
LOCAL_ErrorMessage = NULL;
free(LOCAL_CommittedError);
LOCAL_CommittedError = NULL;
return true;
}
#undef BEGIN_ERROR_CLASSES
#undef ECLASS
#undef END_ERROR_CLASSES
#undef BEGIN_ERRORS
#undef E0
#undef E
#undef E1
#undef E2
#undef END_ERRORS
#define BEGIN_ERROR_CLASSES() typedef enum aux_class {
#define ECLASS(CL, A, B) CL##__,
#define END_ERROR_CLASSES() \
} \
aux_class_t;
#define BEGIN_ERRORS()
#define E0(X, Y)
#define E(X, Y, Z)
#define E1(X, Y, Z)
#define E2(X, Y, Z, W)
#define END_ERRORS()
#include <YapErrors.h>
#undef BEGIN_ERROR_CLASSES
#undef ECLASS
#undef END_ERROR_CLASSES
#undef BEGIN_ERRORS
#undef E0
#undef E
#undef E1
#undef E2
#undef END_ERRORS
#define BEGIN_ERROR_CLASSES() static const char *c_error_class_name[] = {
#define ECLASS(CL, A, B) A,
#define END_ERROR_CLASSES() \
NULL \
}
typedef struct c_error_info {
int class;
const char *name;
} c_error_t;
#define BEGIN_ERRORS() static struct c_error_info c_error_list[] = {
#define E0(X, Y) {Y##__, ""},
#define E(X, Y, Z) {Y##__, Z},
#define E1(X, Y, Z) {Y##__, Z},
#define E2(X, Y, Z, W) {Y##__, Z " " W},
#define END_ERRORS() \
{ YAPC_NO_ERROR, "" } \
} \
;
#include <YapErrors.h>
#include <iopreds.h>
yap_error_class_number Yap_errorClass(yap_error_number e) {
return c_error_list[e].class;
}
const char *Yap_errorName(yap_error_number e) { return c_error_list[e].name; }
const char *Yap_errorClassName(yap_error_class_number e) {
return c_error_class_name[e];
}
yap_error_descriptor_t *Yap_GetException(yap_error_descriptor_t *i) {
CACHE_REGS
if (i->errorNo != YAP_NO_ERROR) {
yap_error_descriptor_t *t = LOCAL_ActiveError,
*nt = calloc(1,sizeof(yap_error_descriptor_t));
memmove(nt, t, sizeof(yap_error_descriptor_t));
return nt;
}
return 0;
}
void Yap_PrintException(void) { printErr(LOCAL_ActiveError); }
bool Yap_RaiseException(void) {
if (LOCAL_ActiveError == NULL ||
LOCAL_ActiveError->errorNo == YAP_NO_ERROR)
return false;
Yap_RestartYap(5);
return false;
//return Yap_JumpToEnv();
}
bool Yap_ResetException(yap_error_descriptor_t *i) {
// reset error descriptor
if (!i)
return true;
yap_error_descriptor_t *bf = i->top_error;
memset(i, 0, sizeof(*i));
i->top_error = bf;
return true;
}
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT)
return t->errorRawTerm;
return mkerrort(t->errorNo,
t->culprit ? Yap_BufferToTerm(t->culprit, TermNil) : TermNil,
err2list(t));
}
static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = MkErrorTerm(t);
// Yap_DebugPlWriteln(rc);
return Yap_unify(ARG2, rc);
}
static Int print_exception(USES_REGS1) {
Term t1 = Deref(ARG1);
if (IsAddressTerm(t1)) {
yap_error_descriptor_t *t = AddressOfTerm(t1);
printErr(t);
} else {
return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS);
}
// Yap_DebugPlWriteln(rc);
return true;
}
static Int query_exception(USES_REGS1) {
const char *query;
Term t;
if (IsAtomTerm((t = Deref(ARG1))))
query = RepAtom(AtomOfTerm(t))->StrOfAE;
if (IsStringTerm(t))
query = StringOfTerm(t);
if (!IsAddressTerm(Deref(ARG2)))
return false;
yap_error_descriptor_t *y = AddressOfTerm(Deref(ARG2));
Term t3 = Deref(ARG3);
if (IsVarTerm(t3)) {
Term rc = queryErr(query, y);
// Yap_DebugPlWriteln(rc);
return Yap_unify(ARG3, rc);
} else {
return setErr(query, y, t3);
}
}
static Int drop_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
free(t);
return true;
}
static Int new_exception(USES_REGS1) {
Term t = MkSysError(calloc(1, sizeof(yap_error_descriptor_t)));
return Yap_unify(ARG1, t);
}
static Int get_exception(USES_REGS1) {
yap_error_descriptor_t *i;
Term t;
if (LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
i = Yap_GetException(LOCAL_ActiveError);
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) {
t = mkerrort(i->errorNo, Yap_BufferToTerm(i->culprit, TermNil),
MkSysError(i));
} else {
t = mkerrort(i->errorNo, TermNil, MkSysError(i));
}
return Yap_unify(ARG1, t);
}
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 n = t;
bool found = false, wellformed = true;
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 if (i->errorNo != YAP_NO_ERROR && i->errorNo != ERROR_EVENT) {
LOCAL_Error_TYPE = i->errorNo;
LOCAL_ActiveError->errorClass = Yap_errorClass(i->errorNo);
LOCAL_ActiveError->errorAsText = Yap_errorName(i->errorNo);
LOCAL_ActiveError->classAsText =
Yap_errorClassName(Yap_errorClass(i->errorNo));
LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t);
LOCAL_ActiveError->culprit = NULL;
} else {
Term t1, t2;
t1 = ArgOfTerm(1, t);
t2 = ArgOfTerm(2, t);
// LOCAL_Error_TYPE = ERROR_EVENT;
wellformed = wellformed && (i->errorAsText != NULL);
if (wellformed) {
int j;
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;
}
}
if (i->errorAsText && i->errorAsText[0]) {
char *errs = malloc(strlen(i->errorAsText) + 1);
strcpy(errs, i->errorAsText);
i->errorAsText = errs;
}
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);
}
Yap_prolog_add_culprit(i PASS_REGS);
return i;
}
static Int is_boolean(USES_REGS1) {
Term t = Deref(ARG1);
// Term Context = Deref(ARG2)Yap_Error(INSTANTIATION_ERROR, t, NULL);;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, NULL);
return false;
}
return t == TermTrue || t == TermFalse;
}
static Int is_atom(USES_REGS1) {
Term t = Deref(ARG1);
// Term Context = Deref(ARG2)Yap_Error(INSTANTIATION_ERROR, t, NULL);;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, NULL);
return false;
}
return IsAtomTerm(t);
}
static Int is_callable(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
while (true) {
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
}
if (f == FunctorModule) {
Term tm = ArgOfTerm(1, G);
if (IsVarTerm(tm)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsAtomTerm(tm)) {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
G = ArgOfTerm(2, G);
} else {
return true;
}
} else if (IsPairTerm(G) || IsAtomTerm(G)) {
return true;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, G, NULL);
return false;
}
}
return false;
}
static Int is_predicate_indicator(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
Term mod = CurrentModule;
G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
}
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
return false;
}
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
}
if (f == FunctorSlash || f == FunctorDoubleSlash) {
return true;
}
}
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
return false;
}
void Yap_InitErrorPreds(void) {
CACHE_REGS
Yap_InitCPred("$print_exception", 1, print_exception, 0);
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0);
Yap_InitCPred("$read_exception", 2, read_exception, 0);
Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator,
TestPredFlag);
}