int
outOfStack(void *stack, stack_overflow_action how)
{ GET_LD
Stack s = stack;
const char *msg = "unhandled stack overflow";
if ( LD->outofstack )
{ Sdprintf("[Thread %d]: failed to recover from %s-overflow\n",
PL_thread_self(), s->name);
print_backtrace_named(msg);
save_backtrace("crash");
print_backtrace_named("crash");
fatalError("Sorry, cannot continue");
return FALSE; /* NOTREACHED */
}
save_backtrace(msg);
LD->trim_stack_requested = TRUE;
LD->exception.processing = TRUE;
LD->outofstack = stack;
switch(how)
{ case STACK_OVERFLOW_THROW:
case STACK_OVERFLOW_RAISE:
{ fid_t fid;
blockGC(0 PASS_LD);
if ( (fid=PL_open_foreign_frame()) )
{ PL_clearsig(SIG_GC);
s->gced_size = 0; /* after handling, all is new */
if ( !PL_unify_term(LD->exception.tmp,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_stack,
PL_CHARS, s->name) )
fatalError("Out of stack inside out-of-stack handler");
if ( how == STACK_OVERFLOW_THROW )
{ PL_close_foreign_frame(fid);
unblockGC(0 PASS_LD);
PL_throw(LD->exception.tmp);
warning("Out of %s stack while not in Prolog!?", s->name);
assert(0);
} else
{ PL_raise_exception(LD->exception.tmp);
}
PL_close_foreign_frame(fid);
}
unblockGC(0 PASS_LD);
fail;
}
}
assert(0);
fail;
}
int
PL_error(const char *pred, int arity, const char *msg, PL_error_code id, ...)
{ GET_LD
char msgbuf[50];
Definition caller;
term_t except, formal, swi, msgterm=0;
va_list args;
int do_throw = FALSE;
fid_t fid;
int rc;
if ( exception_term ) /* do not overrule older exception */
return FALSE;
if ( environment_frame )
caller = environment_frame->predicate;
else
caller = NULL;
if ( id == ERR_FILE_OPERATION &&
!truePrologFlag(PLFLAG_FILEERRORS) )
fail;
if ( msg == MSG_ERRNO )
{ if ( errno == EPLEXCEPTION )
return FALSE;
msg = OsError();
}
LD->exception.processing = TRUE; /* allow using spare stack */
if ( !(fid = PL_open_foreign_frame()) )
goto nomem;
except = PL_new_term_ref();
formal = PL_new_term_ref();
swi = PL_new_term_ref();
/* build (ISO) formal part */
va_start(args, id);
switch(id)
{ case ERR_INSTANTIATION:
err_instantiation:
rc = PL_unify_atom(formal, ATOM_instantiation_error);
break;
case ERR_UNINSTANTIATION:
{ int argn = va_arg(args, int);
term_t bound = va_arg(args, term_t);
if ( !msg && argn > 0 )
{ Ssprintf(msgbuf, "%d-%s argument",
argn, argn == 1 ? "st" : argn == 2 ? "nd" : "th");
msg = msgbuf;
}
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_uninstantiation_error1,
PL_TERM, bound);
break;
}
case ERR_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ atom_t expected = va_arg(args, atom_t);
term_t actual = va_arg(args, term_t);
case_type_error:
if ( expected == ATOM_callable )
rewrite_callable(&expected, actual);
if ( PL_is_variable(actual) && expected != ATOM_variable )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, expected,
PL_TERM, actual);
break;
case ERR_PTR_TYPE: /* atom_t, Word */
{ Word ptr;
expected = va_arg(args, atom_t);
ptr = va_arg(args, Word);
actual = PL_new_term_ref();
*valTermRef(actual) = *ptr;
goto case_type_error;
}
}
case ERR_CHARS_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ const char *expected = va_arg(args, const char*);
term_t actual = va_arg(args, term_t);
if ( PL_is_variable(actual) && !streq(expected, "variable") )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_CHARS, expected,
PL_TERM, actual);
break;
}
case ERR_AR_TYPE: /* arithmetic type error */
{ atom_t expected = va_arg(args, atom_t);
Number num = va_arg(args, Number);
term_t actual = PL_new_term_ref();
rc = (_PL_put_number(actual, num) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, expected,
PL_TERM, actual));
break;
}
case ERR_AR_DOMAIN:
{ atom_t domain = va_arg(args, atom_t);
Number num = va_arg(args, Number);
term_t actual = PL_new_term_ref();
rc = (_PL_put_number(actual, num) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_ATOM, domain,
PL_TERM, actual));
break;
}
case ERR_AR_UNDEF:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_undefined);
break;
}
case ERR_AR_OVERFLOW:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_float_overflow);
break;
}
case ERR_AR_UNDERFLOW:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_float_underflow);
break;
}
case ERR_DOMAIN: /* ERR_INSTANTIATION if var(arg) */
{ atom_t domain = va_arg(args, atom_t);
term_t arg = va_arg(args, term_t);
if ( PL_is_variable(arg) )
goto err_instantiation;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_ATOM, domain,
PL_TERM, arg);
break;
}
case ERR_RANGE: /* domain_error(range(low,high), arg) */
{ term_t low = va_arg(args, term_t);
term_t high = va_arg(args, term_t);
term_t arg = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_domain_error2,
PL_FUNCTOR, FUNCTOR_range2,
PL_TERM, low,
PL_TERM, high,
PL_TERM, arg);
break;
}
case ERR_REPRESENTATION:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_representation_error1,
PL_ATOM, what);
break;
}
{ Definition def; /* shared variables */
Procedure proc;
term_t pred;
case ERR_MODIFY_STATIC_PROC:
proc = va_arg(args, Procedure);
def = proc->definition;
goto modify_static;
case ERR_MODIFY_STATIC_PREDICATE:
def = va_arg(args, Definition);
modify_static:
rc = ((pred = PL_new_term_ref()) &&
unify_definition(MODULE_user, pred, def, 0,
GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, ATOM_modify,
PL_ATOM, ATOM_static_procedure,
PL_TERM, pred));
break;
}
case ERR_MODIFY_THREAD_LOCAL_PROC:
{ Procedure proc = va_arg(args, Procedure);
term_t pred = PL_new_term_ref();
rc = (unify_definition(MODULE_user, pred, proc->definition, 0,
GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, ATOM_modify,
PL_ATOM, ATOM_thread_local_procedure,
PL_TERM, pred));
break;
}
case ERR_UNDEFINED_PROC:
{ Definition def = va_arg(args, Definition);
Definition clr = va_arg(args, Definition);
term_t pred = PL_new_term_ref();
if ( clr )
caller = clr;
rc = (unify_definition(MODULE_user, pred, def, 0, GP_NAMEARITY) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, ATOM_procedure,
PL_TERM, pred));
break;
}
case ERR_PERMISSION_PROC:
{ atom_t op = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
predicate_t pred = va_arg(args, predicate_t);
term_t pi = PL_new_term_ref();
rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY|GP_HIDESYSTEM) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, op,
PL_ATOM, type,
PL_TERM, pi));
break;
}
case ERR_NOT_IMPLEMENTED_PROC:
{ const char *name = va_arg(args, const char *);
int arity = va_arg(args, int);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_not_implemented2,
PL_ATOM, ATOM_procedure,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, name,
PL_INT, arity);
break;
}
case ERR_IMPORT_PROC:
{ predicate_t pred = va_arg(args, predicate_t);
atom_t dest = va_arg(args, atom_t);
atom_t old = va_arg(args, atom_t);
term_t pi = PL_new_term_ref();
rc = ( PL_unify_predicate(pi, pred, GP_NAMEARITY) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_FUNCTOR, FUNCTOR_import_into1,
PL_ATOM, dest,
PL_ATOM, ATOM_procedure,
PL_TERM, pi));
if ( rc && old )
{ rc = ( (msgterm = PL_new_term_ref()) &&
PL_unify_term(msgterm,
PL_FUNCTOR_CHARS, "already_from", 1,
PL_ATOM, old) );
}
break;
}
case ERR_FAILED:
{ term_t goal = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_failure_error1,
PL_TERM, goal);
break;
}
case ERR_EVALUATION:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, what);
break;
}
case ERR_NOT_EVALUABLE:
{ functor_t f = va_arg(args, functor_t);
term_t actual = PL_new_term_ref();
rc = (put_name_arity(actual, f) &&
PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_type_error2,
PL_ATOM, ATOM_evaluable,
PL_TERM, actual));
break;
}
case ERR_DIV_BY_ZERO:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_evaluation_error1,
PL_ATOM, ATOM_zero_divisor);
break;
}
case ERR_PERMISSION:
{ atom_t op = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, op,
PL_ATOM, type,
PL_TERM, obj);
break;
}
case ERR_OCCURS_CHECK:
{ Word p1 = va_arg(args, Word);
Word p2 = va_arg(args, Word);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_occurs_check2,
PL_TERM, pushWordAsTermRef(p1),
PL_TERM, pushWordAsTermRef(p2));
popTermRef();
popTermRef();
break;
}
case ERR_TIMEOUT:
{ atom_t op = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_timeout_error2,
PL_ATOM, op,
PL_TERM, obj);
break;
}
case ERR_EXISTENCE:
{ atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, obj);
break;
}
case ERR_EXISTENCE3:
{ atom_t type = va_arg(args, atom_t);
term_t obj = va_arg(args, term_t);
term_t in = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error3,
PL_ATOM, type,
PL_TERM, obj,
PL_TERM, in);
break;
}
case ERR_FILE_OPERATION:
{ atom_t action = va_arg(args, atom_t);
atom_t type = va_arg(args, atom_t);
term_t file = va_arg(args, term_t);
switch(errno)
{ case EAGAIN:
action = ATOM_lock; /* Hack for file-locking*/
/*FALLTHROUGH*/
case EACCES:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_permission_error3,
PL_ATOM, action,
PL_ATOM, type,
PL_TERM, file);
break;
case EMFILE:
case ENFILE:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_max_files);
break;
#ifdef EPIPE
case EPIPE:
if ( !msg )
msg = "Broken pipe";
/*FALLTHROUGH*/
#endif
default: /* what about the other cases? */
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, type,
PL_TERM, file);
break;
}
break;
}
case ERR_STREAM_OP:
{ atom_t action = va_arg(args, atom_t);
term_t stream = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_io_error2,
PL_ATOM, action,
PL_TERM, stream);
break;
}
case ERR_DDE_OP:
{ const char *op = va_arg(args, const char *);
const char *err = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_dde_error2,
PL_CHARS, op,
PL_CHARS, err);
break;
}
case ERR_SHARED_OBJECT_OP:
{ atom_t action = va_arg(args, atom_t);
const char *err = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shared_object2,
PL_ATOM, action,
PL_CHARS, err);
break;
}
case ERR_NOT_IMPLEMENTED: /* non-ISO */
{ const char *what = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_not_implemented2,
PL_ATOM, ATOM_feature,
PL_CHARS, what);
break;
}
case ERR_RESOURCE:
{ atom_t what = va_arg(args, atom_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, what);
break;
}
case ERR_SYNTAX:
{ const char *what = va_arg(args, const char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_syntax_error1,
PL_CHARS, what);
break;
}
case ERR_NOMEM:
{ rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
}
case ERR_SYSCALL:
{ const char *op = va_arg(args, const char *);
if ( !msg )
msg = op;
switch(errno)
{ case ENOMEM:
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_no_memory);
break;
default:
rc = PL_unify_atom(formal, ATOM_system_error);
break;
}
break;
}
case ERR_SHELL_FAILED:
{ term_t cmd = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shell2,
PL_ATOM, ATOM_execute,
PL_TERM, cmd);
break;
}
case ERR_SHELL_SIGNALLED:
{ term_t cmd = va_arg(args, term_t);
int sig = va_arg(args, int);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_shell2,
PL_FUNCTOR, FUNCTOR_signal1,
PL_INT, sig,
PL_TERM, cmd);
break;
}
case ERR_SIGNALLED:
{ int sig = va_arg(args, int);
char *signame = va_arg(args, char *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_signal2,
PL_CHARS, signame,
PL_INT, sig);
break;
}
case ERR_CLOSED_STREAM:
{ IOSTREAM *s = va_arg(args, IOSTREAM *);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_existence_error2,
PL_ATOM, ATOM_stream,
PL_POINTER, s);
do_throw = TRUE;
break;
}
case ERR_BUSY:
{ atom_t type = va_arg(args, atom_t);
term_t mutex = va_arg(args, term_t);
rc = PL_unify_term(formal, PL_FUNCTOR, FUNCTOR_busy2, type, mutex);
break;
}
case ERR_FORMAT:
{ const char *s = va_arg(args, const char*);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format", 1,
PL_CHARS, s);
break;
}
case ERR_FORMAT_ARG:
{ const char *s = va_arg(args, const char*);
term_t arg = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format_argument_type", 2,
PL_CHARS, s,
PL_TERM, arg);
break;
}
case ERR_DUPLICATE_KEY:
{ term_t key = va_arg(args, term_t);
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_duplicate_key1,
PL_TERM, key);
break;
}
default:
assert(0);
}
va_end(args);
/* build SWI-Prolog context term */
if ( rc && (pred || msg || msgterm || caller) )
{ term_t predterm = PL_new_term_ref();
if ( !msgterm )
msgterm = PL_new_term_ref();
if ( pred )
{ rc = PL_unify_term(predterm,
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, pred,
PL_INT, arity);
} else if ( caller )
{ rc = unify_definition(MODULE_user, predterm, caller, 0, GP_NAMEARITY);
}
if ( rc && msg )
{ rc = PL_put_atom_chars(msgterm, msg);
}
if ( rc )
rc = PL_unify_term(swi,
PL_FUNCTOR, FUNCTOR_context2,
PL_TERM, predterm,
PL_TERM, msgterm);
}
if ( rc )
rc = PL_unify_term(except,
PL_FUNCTOR, FUNCTOR_error2,
PL_TERM, formal,
PL_TERM, swi);
if ( !rc )
{ nomem:
fatalError("Cannot report error: no memory");
}
if ( do_throw )
rc = PL_throw(except);
else
rc = PL_raise_exception(except);
PL_close_foreign_frame(fid);
return rc;
}
