static void
registerWakeup(Word name, Word value ARG_LD)
{ Word wake;
Word tail = valTermRef(LD->attvar.tail);
assert(gTop+6 <= gMax && tTop+4 <= tMax);
wake = gTop;
gTop += 4;
wake[0] = FUNCTOR_wakeup3;
wake[1] = needsRef(*name) ? makeRef(name) : *name;
wake[2] = needsRef(*value) ? makeRef(value) : *value;
wake[3] = ATOM_nil;
if ( *tail )
{ Word t; /* Non-empty list */
deRef2(tail, t);
TrailAssignment(t);
*t = consPtr(wake, TAG_COMPOUND|STG_GLOBAL);
TrailAssignment(tail); /* on local stack! */
*tail = makeRef(wake+3);
DEBUG(1, Sdprintf("appended to wakeup\n"));
} else /* empty list */
{ Word head = valTermRef(LD->attvar.head);
assert(isVar(*head));
TrailAssignment(head); /* See (*) */
*head = consPtr(wake, TAG_COMPOUND|STG_GLOBAL);
TrailAssignment(tail);
*tail = makeRef(wake+3);
LD->alerted |= ALERT_WAKEUP;
DEBUG(1, Sdprintf("new wakeup\n"));
}
}
static int
compare_term_refs(const void *a, const void *b, void *arg)
{ const int *ip1 = a;
const int *ip2 = b;
order_term_refs *ctx = arg;
GET_LDARG(ctx->ld);
Word p = valTermRef(ctx->av[*ip1*2]);
Word q = valTermRef(ctx->av[*ip2*2]);
assert(!isRef(*p));
assert(!isRef(*q));
return (*p<*q ? -1 : *p>*q ? 1 : 0);
}
int
PL_get_attr__LD(term_t t, term_t a ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isAttVar(*p) )
{ Word ap = valPAttVar(*p);
*valTermRef(a) = makeRef(ap); /* reference, so we can assign */
succeed;
}
fail;
}
static int
dict_ordered(Word data, int count, int ex ARG_LD)
{ int ordered = TRUE;
Word n1, n2;
if ( count > 0 )
{ data++; /* skip to key */
deRef2(data, n1);
if ( !is_key(*n1) )
return -1;
}
for(; count > 1; count--, data += 2, n1=n2)
{ deRef2(data+2, n2);
if ( !is_key(*n2) )
return -1;
if ( *n1 < *n2 )
continue;
if ( *n1 > *n2 )
ordered = FALSE;
if ( *n1 == *n2 )
{ if ( ex )
{ term_t t = PL_new_term_ref();
*valTermRef(t) = linkVal(n1);
PL_error(NULL, 0, NULL, ERR_DUPLICATE_KEY, t);
}
return -2;
}
}
return ordered;
}
int
dict_order_term_refs(term_t *av, int *indexes, int count ARG_LD)
{ order_term_refs ctx;
ctx.ld = LD;
ctx.av = av;
sort_r(indexes, count, sizeof(int), compare_term_refs, &ctx);
if ( count > 1 )
{ word k = *valTermRef(av[indexes[0]*2]);
int i;
for(i=1; i<count; i++)
{ word k2 = *valTermRef(av[indexes[i]*2]);
if ( k == k2 )
return i;
k = k2;
}
}
return 0;
}
static int
get_create_dict_ex(term_t t, term_t dt ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isTerm(*p) )
{ Functor f = valueTerm(*p);
FunctorDef fd = valueFunctor(f->definition);
if ( fd->name == ATOM_dict &&
fd->arity%2 == 1 ) /* does *not* validate ordering */
{ *valTermRef(dt) = *p;
return TRUE;
}
}
if ( PL_get_dict_ex(t, 0, dt, DICT_GET_ALL) )
{ assert(isTerm(*valTermRef(dt)));
return TRUE;
}
return PL_type_error("dict", t);
}
static int
get_dict_ex(term_t t, Word dp, int ex ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isTerm(*p) )
{ Functor f = valueTerm(*p);
FunctorDef fd = valueFunctor(f->definition);
if ( fd->name == ATOM_dict &&
fd->arity%2 == 1 ) /* does *not* validate ordering */
{ *dp = *p;
return TRUE;
}
}
if ( !ex )
return FALSE;
PL_type_error("dict", t);
return FALSE;
}
Assuming Tree is a term x(Key, Left, Right, ...), find a (sub) node for
operating on Value. If a node with Key == Value is found Arg is unified
to 1. If such a node is not found Arg is 2 if the tree must get a new
left-node and 3 if it must get a new right-node.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static
PRED_IMPL("$btree_find_node", 4, btree_find_node, 0)
{ PRED_LD
Word t, k;
Functor f;
functor_t fd;
int arity;
k = valTermRef(A1);
t = valTermRef(A2);
deRef(k);
deRef(t);
if ( !isTerm(*t) )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_btree, A2);
f = valueTerm(*t);
fd = f->definition;
arity = arityFunctor(fd);
if ( arity < 3 )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_btree, A2);
for(;;)
{ Word a = &f->arguments[0];
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;
}
int
outOfStack(void *stack, stack_overflow_action how)
{ GET_LD
Stack s = stack;
const char *msg = "out-of-stack";
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);
if ( s->spare != s->def_spare )
{ Sdprintf("[Thread %d]: %s-overflow: spare=%ld\n"
"Last resource exception:\n",
PL_thread_self(), s->name, (long)s->spare);
print_backtrace_named("exception");
}
LD->trim_stack_requested = TRUE;
LD->exception.processing = TRUE;
LD->outofstack = stack;
switch(how)
{ case STACK_OVERFLOW_THROW:
case STACK_OVERFLOW_RAISE:
{ if ( gTop+5 < gMax )
{ Word p = gTop;
p[0] = FUNCTOR_error2; /* see (*) above */
p[1] = consPtr(&p[3], TAG_COMPOUND|STG_GLOBAL);
p[2] = PL_new_atom(s->name);
p[3] = FUNCTOR_resource_error1;
p[4] = ATOM_stack;
gTop += 5;
PL_unregister_atom(p[2]);
*valTermRef(LD->exception.bin) = consPtr(p, TAG_COMPOUND|STG_GLOBAL);
freezeGlobal(PASS_LD1);
} else
{ Sdprintf("Out of %s-stack. No room for exception term. Aborting.\n", s->name);
*valTermRef(LD->exception.bin) = ATOM_aborted;
}
exception_term = exception_bin;
if ( how == STACK_OVERFLOW_THROW &&
LD->exception.throw_environment )
{ /* see PL_throw() */
longjmp(LD->exception.throw_environment->exception_jmp_env, 1);
}
return FALSE;
}
default:
assert(0);
fail;
}
}
