LOCAL LVAL datareduce1 P4C(subrfun, f, subrfun, bf, LVAL, nullval, int, count)
{
LVAL fcn, x, result;
switch (xlargc) {
case 0: result = nullval; break;
case 1:
if (compoundp(peekarg(0))) {
xlstkcheck(2);
xlsave(x);
xlsave(fcn);
fcn = cvsubr(bf, SUBR, 0);
x = subr_map_elements(f);
x = compounddataseq(x);
result = reduce(fcn, x, FALSE, NIL);
xlpopn(2);
}
else result = (count) ? cvfixnum((FIXTYPE) 1) : xlgetarg();
break;
default:
xlsave1(x);
x = makearglist(xlargc, xlargv);
result = xlcallsubr1(f, x);
xlpop();
}
return(result);
}
LOCAL VOID set_hardware_address P3C(CPTR, ptr, LVAL, object, int *, type)
{
LVAL t, p, last, result, oblistsym, newoblist;
if (! objectp(object)) xlerror("not an object", object);
oblistsym = s_hardware_objects;
if (! consp(getvalue(oblistsym))) setvalue(oblistsym, NIL);
xlstkcheck(4);
xlsave(t);
xlsave(p);
xlsave(result);
xlsave(newoblist);
t = cvfixnum((FIXTYPE) time_stamp);
p = cvfixnum((FIXTYPE) ptr);
result = last = consa(object);
result = cons(p, result);
result = cons(t, result);
newoblist = cons(result, getvalue(oblistsym));
setvalue(oblistsym, newoblist);
set_slot_value(object, s_hardware_address, result);
for (;*type != NONE; type++, last = cdr(last)) {
t = cvfixnum((FIXTYPE) *type);
t = consa(t);
rplacd(last, t);
}
xlpopn(4);
}
/* xlexpandmacros - expand macros in a form */
LVAL xlexpandmacros(LVAL form)
{
LVAL fun,args;
/* protect some pointers */
xlstkcheck(3);
xlprotect(form);
xlsave(fun);
xlsave(args);
/* expand until the form isn't a macro call */
while (consp(form)) {
fun = car(form); /* get the macro name */
args = cdr(form); /* get the arguments */
if (!symbolp(fun) || !fboundp(fun))
break;
fun = xlgetfunction(fun); /* get the expansion function */
if (!macroexpand(fun,args,&form))
break;
}
/* restore the stack and return the expansion */
xlpopn(3);
return (form);
}
LVAL xssample(V)
{
LVAL x, result, temp, elem;
int n, N, replace, i, j;
x = xlgaseq();
n = getfixnum(xlgafixnum());
N = seqlen(x);
replace = (moreargs()) ? (xlgetarg() != NIL) : FALSE;
xllastarg();
if (! replace && n > N) n = N;
xlstkcheck(4);
xlprotect(x);
xlsave(result);
xlsave(elem);
xlsave(temp);
x = (listp(x)) ? coerce_to_tvec(x, s_true) : copyvector(x);
result = NIL;
if (N > 0 && n > 0) {
for (i = 0; i < n; i++) {
j = (replace) ? osrand(N) : i + osrand(N - i);
elem = gettvecelement(x, j);
result = cons(elem, result);
if (! replace) { /* swap elements i and j */
temp = gettvecelement(x, i);
settvecelement(x, i, elem);
settvecelement(x, j, temp);
}
}
}
xlpopn(4);
return(result);
}
VOID StGWObDoMouse P5C(LVAL, object, int, x, int, y, MouseEventType, type, MouseClickModifier, mods)
{
LVAL Lx, Ly, argv[6], olddenv;
int extend, option;
xlstkcheck(2);
xlsave(Lx);
xlsave(Ly);
argv[0] = object;
argv[2] = Lx = cvfixnum((FIXTYPE) x);
argv[3] = Ly = cvfixnum((FIXTYPE) y);
olddenv = xldenv;
xldbind(s_in_callback, s_true);
if (type == MouseClick) {
extend = ((int) mods) % 2;
option = ((int) mods) / 2;
argv[1] = sk_do_click;
argv[4] = (extend) ? s_true : NIL;
argv[5] = (option) ? s_true : NIL;
xscallsubrvec(xmsend, 6, argv);
}
else {
argv[1] = sk_do_motion;
xscallsubrvec(xmsend, 4, argv);
}
xlpopn(2);
xlunbind(olddenv);
}
/* MAP-ELEMENTS for internal subroutines */
LVAL subr_map_elements P1C(mapfun, f)
{
LVAL arglist, result, fcn, first_compound, type;
int rlen;
first_compound = findcompound(FALSE);
if (first_compound == NIL) result = (*f)();
else {
xlstkcheck(3);
xlsave(arglist);
xlsave(fcn);
xlsave(result);
fcn = cvsubr(f, SUBR, 0);
type = compoundseqtype(first_compound);
arglist = makearglist(xlargc, xlargv);
rlen = findrlen(arglist);
fixuparglist(arglist);
result = map(type, fcn, arglist, rlen);
result = makecompound(first_compound, result);
#ifdef MULVALS
xlnumresults = 1;
xlresults[0] = result;
#endif /* MULVALS */
xlpopn(3);
}
return(result);
}
/* remif - common code for 'remove-if' and 'remove-if-not' */
LOCAL LVAL remif(int tresult)
{
LVAL list,fcn,val,last=NULL,next;
/* protect some pointers */
xlstkcheck(2);
xlsave(fcn);
xlsave(val);
/* get the expression to remove and the list */
fcn = xlgetarg();
list = xlgalist();
xllastarg();
/* remove matches */
for (; consp(list); list = cdr(list))
/* check to see if this element should be deleted */
if (dotest1(car(list),fcn) != tresult) {
next = consa(car(list));
if (val) rplacd(last,next);
else val = next;
last = next;
}
/* restore the stack */
xlpopn(2);
/* return the updated list */
return (val);
}
LVAL xsmake_rotation(V)
{
LVAL x, y, dx, dy, val;
double alpha=0.0;
int n, use_alpha = FALSE;
x = xlgetarg();
y = xlgetarg();
if (moreargs()) {
use_alpha = TRUE;
alpha = makefloat(xlgetarg());
}
xllastarg();
xlstkcheck(3);
xlsave(dx);
xlsave(dy);
xlsave(val);
dx = coerce_to_tvec(x, s_c_double);
dy = coerce_to_tvec(y, s_c_double);
n = gettvecsize(dx);
if (gettvecsize(dy) != n)
xlfail("sequences not the same length");
val = mktvec(n * n, s_c_double);
make_rotation(n, REDAT(val), REDAT(dx), REDAT(dy), use_alpha, alpha);
val = linalg2genmat(val, n, n, FALSE);
xlpopn(3);
return val;
}
/* xsort - built-in function 'sort' */
LVAL xsort(void)
{
LVAL sortlist();
LVAL list,fcn;
/* protect some pointers */
xlstkcheck(2);
xlsave(list);
xlsave(fcn);
/* get the list to sort and the comparison function */
list = xlgalist();
fcn = xlgetarg();
xllastarg();
/* sort the list */
list = sortlist(list,fcn);
if (list && (ntype(list) == FREE_NODE)) {
stdputstr("error in sort 2");
}
/* restore the stack and return the sorted list */
xlpopn(2);
return (list);
}
LVAL xschol_decomp(V)
{
LVAL a, da, val;
int n;
double maxoffl, maxadd;
a = xlgadarray();
maxoffl = moreargs() ? makefloat(xlgetarg()) : 0.0;
xllastarg();
checksquarematrix(a);
n = numrows(a);
xlstkcheck(2);
xlsave(da);
xlsave(val);
da = gen2linalg(a, n, n, s_c_double, FALSE);
choldecomp(REDAT(da), n, maxoffl, &maxadd);
val = consa(cvflonum((FLOTYPE) maxadd));
val = cons(linalg2genmat(da, n, n, FALSE), val);
xlpopn(2);
return val;
}
/* xcomplement - create a complementary function */
LVAL xcomplement(V)
{
LVAL val;
LVAL args, body;
LVAL newxlenv;
/* protect some pointers */
xlstkcheck(3);
xlsave(newxlenv);
xlsave(args);
xlsave(body);
/* get the argument */
val = xlgetarg();
xllastarg();
/* build the argument list (&rest x) */
args = cons(lk_rest, consa(s_x));
/* build body (not (apply s x)) */
body = consa(cons(s_not, consa(cons(s_apply, cons(s_s, consa(s_x))))));
/* create a closure for lambda expressions */
newxlenv = xlframe(newxlenv);
xlpbind(s_s, val, newxlenv);
val = xlclose(NIL,s_lambda,args,body,newxlenv,NIL);
/* unprotect pointers */
xlpopn(3);
/* return the function */
return (val);
}
/* x1macroexpand - expand a macro call */
LVAL x1macroexpand(void)
{
LVAL form,fun,args;
/* protect some pointers */
xlstkcheck(2);
xlsave(fun);
xlsave(args);
/* get the form */
form = xlgetarg();
xllastarg();
/* expand until the form isn't a macro call */
if (consp(form)) {
fun = car(form); /* get the macro name */
args = cdr(form); /* get the arguments */
if (symbolp(fun) && fboundp(fun)) {
fun = xlgetfunction(fun); /* get the expansion function */
macroexpand(fun,args,&form);
}
}
/* restore the stack and return the expansion */
xlpopn(2);
return (form);
}
LVAL xsfft(V)
{
LVAL data, result, x, work;
int n, isign;
data = xlgaseq();
isign = (moreargs() && xlgetarg() != NIL) ? -1.0 : 1.0;
xllastarg();
/* check and convert the data */
n = seqlen(data);
if (n <= 0)
xlfail("not enough data");
xlstkcheck(2);
xlsave(x);
xlsave(work);
x = gen2linalg(data, n, 1, s_c_dcomplex, FALSE);
work = mktvec(4 * n + 15, s_c_double);
cfft(n, REDAT(x), REDAT(work), isign);
result = listp(x) ? coerce_to_list(x) : coerce_to_tvec(x, s_true);
xlpopn(2);
return result;
}
void nyx_set_audio_params(double rate, long len)
{
LVAL flo;
LVAL con;
xlstkcheck(2);
xlsave(flo);
xlsave(con);
/* Bind the sample rate to the "*sound-srate*" global */
flo = cvflonum(rate);
setvalue(xlenter("*SOUND-SRATE*"), flo);
/* Bind selection len to "len" global */
flo = cvflonum(len);
setvalue(xlenter("LEN"), flo);
/* Set the "*warp*" global based on the length of the audio */
con = cons(NULL, NULL);
flo = cvflonum(len > 0 ? (double) len / rate : 1.0);
con = cons(flo, con);
flo = cvflonum(0);
con = cons(flo, con);
setvalue(xlenter("*WARP*"), con);
xlpopn(2);
}
/* plist - parse a list */
LOCAL LVAL plist(LVAL fptr)
{
LVAL val,expr,lastnptr,nptr;
/* protect some pointers */
xlstkcheck(2);
xlsave(val);
xlsave(expr);
/* keep appending nodes until a closing paren is found */
for (lastnptr = NIL; nextch(fptr) != ')'; )
/* get the next expression */
switch (readone(fptr,&expr)) {
case EOF:
badeof(fptr);
case TRUE:
/* check for a dotted tail */
if (expr == s_dot) {
/* make sure there's a node */
if (lastnptr == NIL)
xlfail("invalid dotted pair");
/* parse the expression after the dot */
if (!xlread(fptr,&expr,TRUE))
badeof(fptr);
rplacd(lastnptr,expr);
/* make sure its followed by a close paren */
if (nextch(fptr) != ')')
xlfail("invalid dotted pair");
}
/* otherwise, handle a normal list element */
else {
nptr = consa(expr);
if (lastnptr == NIL)
val = nptr;
else
rplacd(lastnptr,nptr);
lastnptr = nptr;
}
break;
}
/* skip the closing paren */
xlgetc(fptr);
/* restore the stack */
xlpopn(2);
/* return successfully */
return (val);
}
/* pvector - parse a vector */
LOCAL LVAL pvector(LVAL fptr)
{
LVAL list,expr,val,lastnptr,nptr;
int len,ch,i;
/* protect some pointers */
xlstkcheck(2);
xlsave(list);
xlsave(expr);
/* keep appending nodes until a closing paren is found */
for (lastnptr = NIL, len = 0; (ch = nextch(fptr)) != ')'; ) {
/* check for end of file */
if (ch == EOF)
badeof(fptr);
/* get the next expression */
switch (readone(fptr,&expr)) {
case EOF:
badeof(fptr);
case TRUE:
nptr = consa(expr);
if (lastnptr == NIL)
list = nptr;
else
rplacd(lastnptr,nptr);
lastnptr = nptr;
len++;
break;
}
}
/* skip the closing paren */
xlgetc(fptr);
/* make a vector of the appropriate length */
val = newvector(len);
/* copy the list into the vector */
for (i = 0; i < len; ++i, list = cdr(list))
setelement(val,i,car(list));
/* restore the stack */
xlpopn(2);
/* return successfully */
return (val);
}
/* Internal version of Common Lisp MAP function */
LOCAL LVAL map P4C(LVAL, type, LVAL, fcn, LVAL, args, int, rlen)
{
LVAL nextr, result;
int nargs, i;
/* protect some pointers */
xlstkcheck(2);
xlsave(result);
xlprotect(fcn);
if (rlen < 0) rlen = findmaprlen(args);
if (type == a_vector)
result = newvector(rlen);
else
result = mklist(rlen, NIL);
nargs = llength(args);
for (i = 0, nextr = result; i < rlen; i++) {
pushnextargs(fcn, nargs, args, i);
setnextelement(&nextr, i, xlapply(nargs));
}
/* restore the stack frame */
xlpopn(2);
return(result);
}
static LVAL add_contour_point P10C(int, m,
int, i,
int, j,
int, k,
int, l,
double *, x,
double *, y,
double *, z,
double, v,
LVAL, result)
{
LVAL pt;
double p, q;
double zij = z[i * m + j];
double zkl = z[k * m + l];
if ((zij <= v && v < zkl) || (zkl <= v && v < zij)) {
xlsave(pt);
pt = mklist(2, NIL);
p = (v - zij) / (zkl - zij);
q = 1.0 - p;
rplaca(pt, cvflonum((FLOTYPE) (q * x[i] + p * x[k])));
rplaca(cdr(pt), cvflonum((FLOTYPE) (q * y[j] + p * y[l])));
result = cons(pt, result);
xlpop();
}
return(result);
}
/* xevalhook - eval hook function */
LVAL xevalhook(void)
{
LVAL expr,newehook,newahook,newenv,oldenv,oldfenv,olddenv,val;
/* protect some pointers */
xlstkcheck(3);
xlsave(oldenv);
xlsave(oldfenv);
xlsave(newenv);
/* get the expression, the new hook functions and the environment */
expr = xlgetarg();
newehook = xlgetarg();
newahook = xlgetarg();
newenv = (moreargs() ? xlgalist() : NIL);
xllastarg();
/* bind *evalhook* and *applyhook* to the hook functions */
olddenv = xldenv;
xldbind(s_evalhook,newehook);
xldbind(s_applyhook,newahook);
/* establish the environment for the hook function */
if (newenv) {
oldenv = xlenv;
oldfenv = xlfenv;
xlenv = car(newenv);
xlfenv = cdr(newenv);
}
/* evaluate the expression (bypassing *evalhook*) */
val = xlxeval(expr);
/* restore the old environment */
xlunbind(olddenv);
if (newenv) {
xlenv = oldenv;
xlfenv = oldfenv;
}
/* restore the stack */
xlpopn(3);
/* return the result */
return (val);
}
/* evmethod - evaluate a method */
LOCAL LVAL evmethod(LVAL obj, LVAL msgcls, LVAL method)
{
LVAL oldenv,oldfenv,cptr,name,val=NULL;
XLCONTEXT cntxt;
/* protect some pointers */
xlstkcheck(3);
xlsave(oldenv);
xlsave(oldfenv);
xlsave(cptr);
/* create an 'object' stack entry and a new environment frame */
oldenv = xlenv;
oldfenv = xlfenv;
xlenv = cons(cons(obj,msgcls),closure_getenv(method));
xlenv = xlframe(xlenv);
xlfenv = getfenv(method);
/* bind the formal parameters */
xlabind(method,xlargc,xlargv);
/* setup the implicit block */
if ((name = getname(method)))
xlbegin(&cntxt,CF_RETURN,name);
/* execute the block */
if (name && _setjmp(cntxt.c_jmpbuf))
val = xlvalue;
else
for (cptr = getbody(method); consp(cptr); cptr = cdr(cptr))
val = xleval(car(cptr));
/* finish the block context */
if (name)
xlend(&cntxt);
/* restore the environment */
xlenv = oldenv;
xlfenv = oldfenv;
/* restore the stack */
xlpopn(3);
/* return the result value */
return (val);
}
/* evfun - evaluate a function */
LOCAL LVAL evfun(LVAL fun, int argc, LVAL *argv)
{
LVAL oldenv,oldfenv,cptr,name,val;
XLCONTEXT cntxt;
/* protect some pointers */
xlstkcheck(4);
xlsave(oldenv);
xlsave(oldfenv);
xlsave(cptr);
xlprotect(fun); /* (RBD) Otherwise, fun is unprotected */
/* create a new environment frame */
oldenv = xlenv;
oldfenv = xlfenv;
xlenv = xlframe(closure_getenv(fun));
xlfenv = getfenv(fun);
/* bind the formal parameters */
xlabind(fun,argc,argv);
/* setup the implicit block */
if (name = getname(fun))
xlbegin(&cntxt,CF_RETURN,name);
/* execute the block */
if (name && setjmp(cntxt.c_jmpbuf))
val = xlvalue;
else
for (val = NIL, cptr = getbody(fun); consp(cptr); cptr = cdr(cptr))
val = xleval(car(cptr));
/* finish the block context */
if (name)
xlend(&cntxt);
/* restore the environment */
xlenv = oldenv;
xlfenv = oldfenv;
/* restore the stack */
xlpopn(4);
/* return the result value */
return (val);
}
NODE *xlevarg(NODE **pargs)
{
NODE ***oldstk,*val;
oldstk = xlsave(&val,(NODE **)0);
val = xlarg(pargs);
val = xleval(val);
xlstack = oldstk;
return (val);
}
static LVAL newmatrix P2C(unsigned, r, unsigned, c)
{
LVAL rows, cols, dim, result;
xlstkcheck(3);
xlsave(rows);
xlsave(cols);
xlsave(dim);
rows = cvfixnum((FIXTYPE) r);
cols = cvfixnum((FIXTYPE) c);
dim = list2(rows, cols);
result = mkarray(dim, NIL, NIL, s_true);
xlpopn(3);
return(result);
}
/* Common Lisp REDUCE function (internal version) */
LVAL reduce P4C(LVAL, fcn,LVAL, sequence, int, has_init, LVAL, initial_value)
{
LVAL next, result;
int i, n;
/* protect some pointers */
xlstkcheck(3);
xlsave(next);
xlsave(result);
xlprotect(fcn);
switch (ntype(sequence)) {
case CONS:
next = sequence;
if (has_init) result = initial_value;
else {
result = car(next);
next = cdr(next);
}
for (; consp(next); next = cdr(next))
result = xsfuncall2(fcn, result, car(next));
break;
case VECTOR:
case TVEC:
n = gettvecsize(sequence);
i = 0;
if (has_init) result = initial_value;
else {
result = gettvecelement(sequence, 0);
i = 1;
}
for (; i < n; i++)
result = xsfuncall2(fcn, result, gettvecelement(sequence, i));
break;
default:
xlbadtype(sequence);
}
/* restore the stack frame */
xlpopn(3);
return(result);
}
LVAL xssurface_contour(V)
{
LVAL s1, s2, mat, result;
LVAL x, y, z;
double *dx, *dy, *dz;
double v;
int i, j, n, m;
s1 = xlgaseq();
s2 = xlgaseq();
mat = xlgamatrix();
v = makefloat(xlgetarg());
xllastarg();
n = seqlen(s1);
m = seqlen(s2);
if (n != numrows(mat) || m != numcols(mat))
xlfail("dimensions do not match");
xlstkcheck(4);
xlsave(x);
xlsave(y);
xlsave(z);
xlsave(result);
x = gen2linalg(s1, n, 1, s_c_double, FALSE); dx = REDAT(x);
y = gen2linalg(s2, m, 1, s_c_double, FALSE); dy = REDAT(y);
z = gen2linalg(mat, n, m, s_c_double, FALSE); dz = REDAT(z);
result = NIL;
for (i = 0; i < n - 1; i++) {
for (j = 0; j < m - 1; j++) {
result = add_contour_point(m, i, j, i, j+1, dx, dy, dz, v, result);
result = add_contour_point(m, i, j+1, i+1, j+1, dx, dy, dz, v, result);
result = add_contour_point(m, i+1, j+1, i+1, j, dx, dy, dz, v, result);
result = add_contour_point(m, i+1, j, i, j, dx, dy, dz, v, result);
}
}
xlpopn(4);
return(result);
}
xlputprop(NODE *sym, NODE *val, NODE *prp)
{
NODE ***oldstk,*p,*pair;
if ((pair = findprop(sym,prp)) == (NODE *)0) {
oldstk = xlsave(&p,(NODE **)0);
p = consa(prp);
((p)->n_info.n_xlist.xl_cdr = (pair = cons(val,((sym)->n_info.n_xsym.xsy_plist->n_info.n_xlist.xl_cdr))));
((sym)->n_info.n_xsym.xsy_plist->n_info.n_xlist.xl_cdr = (p));
xlstack = oldstk;
}
((pair)->n_info.n_xlist.xl_car = (val));
}
LVAL iview_get_nice_range(V)
{
double low, high;
int ticks;
LVAL temp, result;
low = makefloat(xlgetarg());
high = makefloat(xlgetarg());
ticks = getfixnum(xlgafixnum());
xllastarg();
GetNiceRange(&low, &high, &ticks);
xlstkcheck(2);
xlsave(result);
xlsave(temp);
temp = cvfixnum((FIXTYPE) ticks); result = consa(temp);
temp = cvflonum((FLOTYPE) high); result = cons(temp, result);
temp = cvflonum((FLOTYPE) low); result = cons(temp, result);
xlpopn(2);
return(result);
}
/* sortlist - sort a list using quicksort */
LOCAL LVAL sortlist(LVAL list, LVAL fcn)
{
LVAL gluelists();
LVAL smaller,pivot,larger;
/* protect some pointers */
xlstkcheck(3);
xlsave(smaller);
xlsave(pivot);
xlsave(larger);
/* lists with zero or one element are already sorted */
if (consp(list) && consp(cdr(list))) {
pivot = list; list = cdr(list);
splitlist(pivot,list,&smaller,&larger,fcn);
smaller = sortlist(smaller,fcn);
larger = sortlist(larger,fcn);
list = gluelists(smaller,pivot,larger);
}
/* cleanup the stack and return the sorted list */
xlpopn(3);
return (list);
}
/* Built in MAP-ELEMENTS */
LVAL xsmap_elements(V)
{
LVAL arglist, result, fcn, first_compound, type;
int rlen;
if (xlargc < 2) xltoofew();
first_compound = findcompound(TRUE);
if (first_compound == NIL) result = xfuncall();
else {
xlstkcheck(2)
xlsave(arglist);
xlsave(result);
fcn = xlgetarg();
type = compoundseqtype(first_compound);
arglist = makearglist(xlargc, xlargv);
rlen = findrlen(arglist);
fixuparglist(arglist);
result = map(type, fcn, arglist, rlen);
result = makecompound(first_compound,result);
xlpopn(2);
}
return(result);
}
static int breakloop(char *hdr, char *cmsg, char *emsg, NODE *arg, int cflag)
{
NODE ***oldstk,*expr,*val;
CONTEXT cntxt;
int type;
xlerrprint(hdr,cmsg,emsg,arg);
xlflush();
if (((s_tracenable)->n_info.n_xsym.xsy_value)) {
val = ((s_tlimit)->n_info.n_xsym.xsy_value);
xlbaktrace(((val) && (val)->n_type == 5) ? (int)((val)->n_info.n_xint.xi_int) : -1);
}
oldstk = xlsave(&expr,(NODE **)0);
xldebug++;
xlbegin(&cntxt,8|16|32,true);
for (type = 0; type == 0; ) {
if (type = setjmp(cntxt.c_jmpbuf))
switch (type) {
case 8:
xlflush();
type = 0;
continue;
case 16:
continue;
case 32:
if (cflag) {
stdputstr("[ continue from break loop ]\n");
continue;
}
else xlabort("this error can't be continued");
}
if (!xlread(((s_stdin)->n_info.n_xsym.xsy_value),&expr,0)) {
type = 16;
break;
}
expr = xleval(expr);
xlprint(((s_stdout)->n_info.n_xsym.xsy_value),expr,1);
xlterpri(((s_stdout)->n_info.n_xsym.xsy_value));
}
xlend(&cntxt);
xldebug--;
xlstack = oldstk;
if (type == 16) {
stdputstr("[ abort to previous level ]\n");
xlsignal(0,(NODE *)0);
}
}