/* xget - get the value of a property */
LVAL xget(void)
{
LVAL sym,prp;
/* get the symbol and property */
sym = xlgasymbol();
prp = xlgasymbol();
xllastarg();
/* retrieve the property value */
return (xlgetprop(sym,prp));
}
/* xremprop - remove a property value from a property list */
LVAL xremprop(void)
{
LVAL sym,prp;
/* get the symbol and property */
sym = xlgasymbol();
prp = xlgasymbol();
xllastarg();
/* remove the property */
xlremprop(sym,prp);
/* return nil */
return (NIL);
}
/* xputprop - set the value of a property */
LVAL xputprop(void)
{
LVAL sym,val,prp;
/* get the symbol and property */
sym = xlgasymbol();
val = xlgetarg();
prp = xlgasymbol();
xllastarg();
/* set the property value */
xlputprop(sym,val,prp);
/* return the value */
return (val);
}
/* xfboundp - is this a functional value bound to this symbol? */
LVAL xfboundp(void)
{
LVAL sym;
sym = xlgasymbol();
xllastarg();
return (fboundp(sym) ? s_true : NIL);
}
LVAL xsbasekernelsmooth(V)
{
LVAL x, y, xs, ys, targ;
int n, ns, error, ktype;
double *dx, *dy, *dxs, *dys, width;
n = getfixnum(xlgafixnum());
x = xlgetarg();
y = xlgetarg();
ns = getfixnum(xlgafixnum());
xs = xlgetarg();
ys = xlgetarg();
width = makefloat(xlgetarg());
targ = xlgasymbol();
xllastarg();
dx = getlinalgdvec(0, n, x);
dy = null(y) ? NULL : getlinalgdvec(0, n, y);
dxs = getlinalgdvec(0, ns, xs);
dys = getlinalgdvec(0, ns, ys);
switch (getstring(getpname(targ))[0]) {
case 'U': ktype = 'U'; break;
case 'T': ktype = 'T'; break;
case 'G': ktype = 'G'; break;
default: ktype = 'B'; break;
}
error = kernel_smooth(dx, dy, n, width, NULL, NULL, dxs, dys, ns, ktype);
return error ? s_true : NIL;
}
/* xsendsuper - send a message to the superclass of an object */
LVAL xsendsuper(void)
{
LVAL env,p;
for (env = xlenv; env; env = cdr(env))
if ((p = car(env)) && objectp(car(p)))
return (xsendmsg(car(p),
getivar(cdr(p),SUPERCLASS),
xlgasymbol()));
xlfail("not in a method");
return NULL; /* never called */
}
/* xsymplist - get the property list of a symbol */
LVAL xsymplist(void)
{
LVAL sym;
/* get the symbol */
sym = xlgasymbol();
xllastarg();
/* return the property list */
return (getplist(sym));
}
/* xsymname - get the print name of a symbol */
LVAL xsymname(void)
{
LVAL sym;
/* get the symbol */
sym = xlgasymbol();
xllastarg();
/* return the print name */
return (getpname(sym));
}
/* xsymfunction - get the functional value of a symbol */
LVAL xsymfunction(void)
{
LVAL sym,val;
/* get the symbol */
sym = xlgasymbol();
xllastarg();
/* get the global value */
while ((val = getfunction(sym)) == s_unbound)
xlfunbound(sym);
/* return its value */
return (val);
}
/* xset - built-in function set */
LVAL xset(void)
{
LVAL sym,val;
/* get the symbol and new value */
sym = xlgasymbol();
val = xlgetarg();
xllastarg();
/* assign the symbol the value of argument 2 and the return value */
setvalue(sym,val);
/* return the result value */
return (val);
}
/* clanswer - define a method for answering a message */
LVAL clanswer(void)
{
LVAL self,msg,fargs,code,mptr;
/* message symbol, formal argument list and code */
self = xlgaobject();
msg = xlgasymbol();
fargs = xlgalist();
code = xlgalist();
xllastarg();
/* make a new message list entry */
mptr = entermsg(self,msg);
/* setup the message node */
xlprot1(fargs);
fargs = cons(s_self,fargs); /* add 'self' as the first argument */
rplacd(mptr,xlclose(msg,s_lambda,fargs,code,NIL,NIL));
xlpop();
/* return the object */
return (self);
}
/* xsend - send a message to an object */
LVAL xsend(void)
{
LVAL obj;
obj = xlgaobject();
return (xsendmsg(obj,getclass(obj),xlgasymbol()));
}
