// (kill 'pid ['cnt]) -> flg
any doKill(any ex) {
pid_t pid;
pid = (pid_t)evCnt(ex,cdr(ex));
return kill(pid, isCell(cddr(ex))? (int)evCnt(ex,cddr(ex)) : SIGTERM)? Nil : T;
}
void isLastOperand(Register result, Register ops)
{
cdr(result, ops);
makeBoolean(result, isNull(result));
}
void procedureBody(Register result, Register procedure)
{
cdr(result, procedure);
cdr(result, result);
car(result, result);
}
void isLastExp(Register result, Register exp)
{
cdr(result, exp);
makeBoolean(result, isNull(result));
}
void operands(Register result, Register exp)
{
cdr(result, exp);
}
void lambdaBody(Register result, Register exp)
{
cdr(result, exp);
cdr(result, result);
}
void ifConsequent(Register result, Register exp)
{
cdr(result, exp);
cdr(result, result);
car(result, result);
}
// (xor 'any 'any) -> flg
any doXor(any x) {
bool f;
x = cdr(x), f = isNil(EVAL(car(x))), x = cdr(x);
return f ^ isNil(EVAL(car(x)))? T : Nil;
}
// (nil . prg) -> NIL
any doNil(any x) {
while (isCell(x = cdr(x)))
if (isCell(car(x)))
evList(car(x));
return Nil;
}
// (as 'any1 . any2) -> any2 | NIL
any doAs(any x) {
x = cdr(x);
if (isNil(EVAL(car(x))))
return Nil;
return cdr(x);
}
// (eval 'any ['cnt ['lst]]) -> any
any doEval(any x) {
any y;
cell c1;
bindFrame *p;
x = cdr(x), Push(c1, EVAL(car(x))), x = cdr(x);
if (!isNum(y = EVAL(car(x))) || !(p = Env.bind))
data(c1) = EVAL(data(c1));
else {
int cnt, n, i, j;
struct { // bindFrame
struct bindFrame *link;
int i, cnt;
struct {any sym; any val;} bnd[length(x)];
} f;
x = cdr(x), x = EVAL(car(x));
j = cnt = (int)unBox(y);
n = f.i = f.cnt = 0;
do {
++n;
if ((i = p->i) <= 0 && (p->i -= cnt, i == 0)) {
for (i = 0; i < p->cnt; ++i) {
y = val(p->bnd[i].sym);
val(p->bnd[i].sym) = p->bnd[i].val;
p->bnd[i].val = y;
}
if (p->cnt && p->bnd[0].sym == At && !--j)
break;
}
} while (p = p->link);
while (isCell(x)) {
for (p = Env.bind, j = n; ; p = p->link) {
if (p->i < 0)
for (i = 0; i < p->cnt; ++i) {
if (p->bnd[i].sym == car(x)) {
f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
val(car(x)) = p->bnd[i].val;
++f.cnt;
goto next;
}
}
if (!--j)
break;
}
next: x = cdr(x);
}
f.link = Env.bind, Env.bind = (bindFrame*)&f;
data(c1) = EVAL(data(c1));
while (--f.cnt >= 0)
val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
Env.bind = f.link;
do {
for (p = Env.bind, i = n; --i; p = p->link);
if (p->i < 0 && (p->i += cnt) == 0)
for (i = p->cnt; --i >= 0;) {
y = val(p->bnd[i].sym);
val(p->bnd[i].sym) = p->bnd[i].val;
p->bnd[i].val = y;
}
} while (--n);
}
return Pop(c1);
}
// (quote . any) -> any
any doQuote(any x) {return cdr(x);}
// (box 'any) -> sym
any doBox(any x) {
x = cdr(x);
return consSym(EVAL(car(x)), Nil);
}
/* Evaluate method invocation */
static any evMethod(any o, any expr, any x) {
any y = car(expr);
any cls = TheCls, key = TheKey;
struct { // bindFrame
struct bindFrame *link;
int i, cnt;
struct {any sym; any val;} bnd[length(y)+3];
} f;
f.link = Env.bind, Env.bind = (bindFrame*)&f;
f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2;
f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
while (isCell(y)) {
f.bnd[f.cnt].sym = car(y);
f.bnd[f.cnt].val = EVAL(car(x));
++f.cnt, x = cdr(x), y = cdr(y);
}
if (isNil(y)) {
while (--f.i > 0) {
x = val(f.bnd[f.i].sym);
val(f.bnd[f.i].sym) = f.bnd[f.i].val;
f.bnd[f.i].val = x;
}
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
y = cls, cls = Env.cls; Env.cls = y;
y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
}
else if (y != At) {
f.bnd[f.cnt].sym = y, f.bnd[f.cnt++].val = val(y), val(y) = x;
while (--f.i > 0) {
x = val(f.bnd[f.i].sym);
val(f.bnd[f.i].sym) = f.bnd[f.i].val;
f.bnd[f.i].val = x;
}
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
y = cls, cls = Env.cls; Env.cls = y;
y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
}
else {
int n, cnt;
cell *arg;
cell c[n = cnt = length(x)];
while (--n >= 0)
Push(c[n], EVAL(car(x))), x = cdr(x);
while (--f.i > 0) {
x = val(f.bnd[f.i].sym);
val(f.bnd[f.i].sym) = f.bnd[f.i].val;
f.bnd[f.i].val = x;
}
n = Env.next, Env.next = cnt;
arg = Env.arg, Env.arg = c;
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
y = cls, cls = Env.cls; Env.cls = y;
y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
if (cnt)
drop(c[cnt-1]);
Env.arg = arg, Env.next = n;
}
while (--f.cnt >= 0)
val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
Env.bind = f.link;
Env.cls = cls, Env.key = key;
return x;
}
void
symeListSetExtension(SymeList symes, Syme syme)
{
for (; symes; symes = cdr(symes))
symeSetExtension(car(symes), syme);
}
// (t . prg) -> T
any doT(any x) {
while (isCell(x = cdr(x)))
if (isCell(car(x)))
evList(car(x));
return T;
}
void lambdaParameters(Register result, Register exp)
{
cdr(result, exp);
car(result, result);
}
// (prog . prg) -> any
any doProg(any x) {return prog(cdr(x));}
void ifPredicate(Register result, Register exp)
{
cdr(result, exp);
car(result, result);
}
int
cmp_expr(U *p1, U *p2)
{
int n;
if (p1 == p2)
return 0;
if (p1 == symbol(NIL))
return -1;
if (p2 == symbol(NIL))
return 1;
if (isnum(p1) && isnum(p2))
return sign(compare_numbers(p1, p2));
if (isnum(p1))
return -1;
if (isnum(p2))
return 1;
if (isstr(p1) && isstr(p2))
return sign(strcmp(p1->u.str, p2->u.str));
if (isstr(p1))
return -1;
if (isstr(p2))
return 1;
if (issymbol(p1) && issymbol(p2))
return sign(strcmp(get_printname(p1), get_printname(p2)));
if (issymbol(p1))
return -1;
if (issymbol(p2))
return 1;
if (istensor(p1) && istensor(p2))
return compare_tensors(p1, p2);
if (istensor(p1))
return -1;
if (istensor(p2))
return 1;
while (iscons(p1) && iscons(p2)) {
n = cmp_expr(car(p1), car(p2));
if (n != 0)
return n;
p1 = cdr(p1);
p2 = cdr(p2);
}
if (iscons(p2))
return -1;
if (iscons(p1))
return 1;
return 0;
}
void beginActions(Register result, Register exp)
{
cdr(result, exp);
}
static char *strfield(char *name,LISP alist)
{LISP value,key = rintern(name);
if NULLP(value = assq(key,alist))
return("");
return(get_c_string(cdr(value)));}
void restExps(Register result, Register exp)
{
cdr(result, exp);
}
static long longfield(char *name,LISP alist)
{LISP value,key = rintern(name);
if NULLP(value = assq(key,alist))
return(0);
return(get_c_long(cdr(value)));}
void restOperands(Register result, Register ops)
{
cdr(result, ops);
}
atom *fn_cdr(env *e, atom *args) {
if (car(args)->typ != A_PAIR)
return atom_make(A_ERROR, "first arg must be arg list");
return cdr(car(args));
}
void procedureParameters(Register result, Register procedure)
{
cdr(result, procedure);
car(result, result);
}
void set_state_constants(void)
{
cellpoint sc = state_constants;
STATE_INIT = car(sc);
sc = cdr(sc);
STATE_SHARP = car(sc);
sc = cdr(sc);
STATE_DOT = car(sc);
sc = cdr(sc);
STATE_ADD = car(sc);
sc = cdr(sc);
STATE_SUB = car(sc);
sc = cdr(sc);
STATE_NUM = car(sc);
sc = cdr(sc);
STATE_CHAR = car(sc);
sc = cdr(sc);
STATE_STR = car(sc);
sc = cdr(sc);
STATE_SYM = car(sc);
sc = cdr(sc);
STATE_LIST = car(sc);
sc = cdr(sc);
STATE_VEC = car(sc);
sc = cdr(sc);
STATE_QUOTE = car(sc);
}
void textOfQuotation(Register result, Register exp)
{
cdr(result, exp);
car(result, result);
}
// (! . exe) -> any
any doBreak(any x) {
x = cdr(x);
if (!isNil(val(Dbg)))
x = brkLoad(x);
return EVAL(x);
}