max_value self_forward(value x)
{
struct obj *obj;
if (ATOMP(x) || INTEGERP(x) || !x)
return (max_value)x;
obj = x;
if (obj->forwarded)
return obj->size;
save_copy_and_scan(&self_layout, obj, obj->size);
}
static max_value avr_forward(value x)
{
struct obj *obj;
if (ATOMP(x))
return AVR_MAKE_ATOM(ATOM_VALUE(x));
if (INTEGERP(x))
return (avr_value)x; /* Warning: implicit mod operation */
if (!x)
return 0;
obj = x;
if (obj->forwarded)
return obj->size;
save_copy_and_scan(&avr_layout, obj);
return obj->size;
}
cell_t *evaluate(cell_t *exp, environ_t *env) {
++__tl_eval_level;
// push a frame
eval_stack_t s;
s.next = eval_stack;
s.value = env;
eval_stack = &s;
if (DFLAG) {
printf("Eval (%d) got : ", __tl_eval_level);
pretty_print(exp);
}
if (NULL == exp) {
DRETURN(RET_VAL, NULL);
} else if (NILP(exp)) {
DRETURN(RET_VAL, nil_cell);
} else if (ATOMP(exp)) {
if (SYMBOLP(exp)) {
DRETURN(RET_VAL, find_value(env, exp));
} else if (STRINGP(exp) || NUMBERP(exp)) {
DRETURN(RET_VAL, exp);
} else {
DEBUGPRINT_("Expression not valid.\n");
pretty_print(orig_sexpr);
GOTO_TOPLEVEL();
return NULL; /* unreachable */
}
} else { /* list */
handle_t *he = handle_push(exp);
cell_t *first = evaluate(CAR(exp), env); // exp handled
exp = handle_get(he);
handle_pop(he);
cell_t *rest = CDR(exp);
if (DFLAG) {
printf("First is: ");
pretty_print(first);
printf("Rest is: ");
pretty_print(rest);
}
if (NULL == first) {
fast_error(" malformed expression.");
/* This is unreachable */
} else if (PRIMITIVEP(first)) {
cell_t *(*f)(cell_t *, environ_t *) = CELL_PRIMITIVE(first);
DRETURN(RET_PRIM, (*f)(rest, env));
} else if (FUNCTIONP(first)) { /* function call */
cell_t *t;
handle_t *hf;
hf = handle_push(first);
t = evargs(rest, env); // first handled
first = handle_get(hf);
handle_pop(hf);
DRETURN(RET_FUNCALL, invoke(first, t, env)); // no need for handles
}
undefun_error(first, exp); /* Not primitive or funcall, error.*/
return NULL; /* Unreachable, undefun_error() does not return. */
}
}
