r0 = cl;
r2 = a;
r3 = aa;
- g_target = BEGIN;
- return eval_apply ();
+ return cell_unspecified;
}
SCM
evlis:
if (r1 == cell_nil) return cell_nil;
- if (TYPE (r1) != PAIR) goto eval; // (r1, r0);
+ if (TYPE (r1) != PAIR) goto eval;
r2 = eval_env (car (r1), r0);
r1 = evlis_env (cdr (r1), r0);
return cons (r2, r1);
{
if (TYPE (r1) == FUNCTION) return call (r1, r2);
if (r1 == cell_symbol_call_with_values)
- return call_with_values_env (car (r2), cadr (r2), r0);
+ {
+ r1 = car (r2);
+ r2 = cadr (r2);
+ goto call_with_values;
+ }
if (r1 == cell_symbol_current_module) return r0;
}
else
SCM args = cadr (r1);
SCM body = cddr (r1);
SCM p = pairlis (args, r2, r0);
- return call_lambda (body, p, p, r0);
+ call_lambda (body, p, p, r0);
+ goto begin;
}
case cell_closure:
{
SCM aa = cdadr (r1);
aa = cdr (aa);
SCM p = pairlis (args, r2, aa);
- return call_lambda (body, p, aa, r0);
+ call_lambda (body, p, aa, r0);
+ goto begin;
}
#if BOOT
case cell_symbol_label:
- return apply_env (caddr (r1), r2, cons (cons (cadr (r1), caddr (r1)), r0));
+ {
+ r0 = cons (cons (cadr (r1), caddr (r1)), r0);
+ r1 = caddr (r1);
+ goto apply;
+ }
#endif
}
SCM e = eval_env (r1, r0);
fprintf (stderr, "]\n");
assert (!"cannot apply");
}
- return apply_env (e, r2, r0);
+ r1 = e;
+ goto apply;
eval:
switch (TYPE (r1))
case cell_symbol_null_p: return null_p (eval_env (CADR (r1), r0));
#endif // FIXED_PRIMITIVES
case cell_symbol_quote: return cadr (r1);
-#if QUASISYNTAX
- case cell_symbol_syntax: return cadr (r1);
-#endif
- case cell_symbol_begin: return begin_env (r1, r0);
+ case cell_symbol_begin: goto begin;
case cell_symbol_lambda:
return make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
case cell_closure: return r1;
- case cell_symbol_if: return if_env (cdr (r1), r0);
-#if 1 //!BOOT
+ case cell_symbol_if: {r1=cdr (r1); goto label_if;}
case cell_symbol_set_x: {
SCM x = eval_env (caddr (r1), r0); return set_env_x (cadr (r1), x, r0);
}
-#endif
default: {
SCM x = macro_expand_env (r1, r0);
if (x != r1)
set_cdr_x (r1, cdr (x));
set_car_x (r1, car (x));
}
- else
- r1 = x;
- return eval_env (x, r0);
+ r1 = x;
+ goto eval;
}
SCM m = evlis_env (CDR (r1), r0);
- return apply_env (car (r1), m, r0);
+ r1 = car (r1);
+ r2 = m;
+ goto apply;
}
}
}
SCM expanders;
if (TYPE (r1) == PAIR
&& (macro = lookup_macro (car (r1), r0)) != cell_f)
- return apply_env (macro, CDR (r1), r0);
+ {
+ r2 = CDR (r1);
+ r1 = macro;
+ goto apply;
+ }
else if (TYPE (r1) == PAIR
&& TYPE (CAR (r1)) == SYMBOL
&& ((expanders = assq_ref_cache (cell_symbol_sc_expander_alist, r0)) != cell_undefined)
{
SCM sc_expand = assq_ref_cache (cell_symbol_macro_expand, r0);
if (sc_expand != cell_undefined && sc_expand != cell_f)
- r1 = apply_env (sc_expand, cons (r1, cell_nil), r0);
+ {
+ r2 = cons (r1, cell_nil);
+ r1 = sc_expand;
+ goto apply;
+ }
}
return r1;
r1 = append2 (f, cdr (r1));
}
}
+ if (CDR (r1) == cell_nil)
+ {
+ r1 = car (r1);
+ goto eval;
+ }
r = eval_env (car (r1), r0);
r1 = CDR (r1);
}
label_if:
x = eval_env (car (r1), r0);
if (x != cell_f)
- return eval_env (cadr (r1), r0);
+ {
+ r1 = cadr (r1);
+ goto eval;
+ }
if (cddr (r1) != cell_nil)
- return eval_env (caddr (r1), r0);
+ {
+ r1 = caddr (r1);
+ goto eval;
+ }
return cell_unspecified;
SCM v;
v = apply_env (r1, cell_nil, r0);
if (TYPE (v) == VALUES)
v = CDR (v);
- return apply_env (r2, v, r0);
+ r1 = r2;
+ r2 = v;
+ goto apply;
}
SCM