diff --git a/src/mes.c b/src/mes.c index 1e34214b..46020d13 100644 --- a/src/mes.c +++ b/src/mes.c @@ -56,26 +56,49 @@ SCM r3 = 0; SCM g_macros = 1; SCM g_ports = 1; - +#if __M2_PLANET__ +CONSTANT TCHAR 0 +CONSTANT TCLOSURE 1 +CONSTANT TCONTINUATION 2 +CONSTANT TFUNCTION 3 +CONSTANT TKEYWORD 4 +CONSTANT TMACRO 5 +CONSTANT TNUMBER 6 +CONSTANT TPAIR 7 +CONSTANT TPORT 8 +CONSTANT TREF 9 +CONSTANT TSPECIAL 10 +CONSTANT TSTRING 11 +CONSTANT TSYMBOL 12 +CONSTANT TVALUES 13 +CONSTANT TVARIABLE 14 +CONSTANT TVECTOR 15 +CONSTANT TBROKEN_HEART 16 +#else // !__M2_PLANET__ enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART}; +#endif // !__M2_PLANET__ -#if !_POSIX_SOURCE +typedef SCM (*function0_t) (void); +typedef SCM (*function1_t) (SCM); +typedef SCM (*function2_t) (SCM, SCM); +typedef SCM (*function3_t) (SCM, SCM, SCM); +typedef SCM (*functionn_t) (SCM); +#if !POSIX struct scm { enum type_t type; SCM car; SCM cdr; }; struct function { - long (*function) (void); +#if __M2_PLANET__ + FUNCTION function; +#else // !__M2_PLANET__ + SCM (*function) (SCM); +#endif // !__M2_PLANET__ long arity; char *name; }; #else -typedef SCM (*function0_t) (void); -typedef SCM (*function1_t) (SCM); -typedef SCM (*function2_t) (SCM, SCM); -typedef SCM (*function3_t) (SCM, SCM, SCM); -typedef SCM (*functionn_t) (SCM); struct function { union { function0_t function0; @@ -688,30 +711,74 @@ pairlis (SCM x, SCM y, SCM a) SCM call (SCM fn, SCM x) { - if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1) +#if __M2_PLANET__ + struct function *f = FUNCTION (fn); +#else + struct function *f = &FUNCTION (fn); +#endif + int arity = f->arity; + if ((arity > 0 || arity == -1) && x != cell_nil && TYPE (CAR (x)) == TVALUES) x = cons (CADAR (x), CDR (x)); - if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1) + if ((arity > 1 || arity == -1) && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES) x = cons (CAR (x), cons (CDADAR (x), CDR (x))); - switch (FUNCTION (fn).arity) - { -#if __MESC__ || !_POSIX_SOURCE - case 0: return (FUNCTION (fn).function) (); - case 1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x)); - case 2: return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x)); - case 3: return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x), CAR (CDDR (x))); - case -1: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x); - default: return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x); -#else - case 0: return FUNCTION (fn).function0 (); - case 1: return FUNCTION (fn).function1 (CAR (x)); - case 2: return FUNCTION (fn).function2 (CAR (x), CADR (x)); - case 3: return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x))); - case -1: return FUNCTION (fn).functionn (x); -#endif - } +#if __M2_PLANET__ + FUNCTION fp = f->function; + if (arity == 0) + return fp (); + else if (arity == 1) + return fp (CAR (x)); + else if (arity == 2) + return fp (CAR (x), CADR (x)); + else if (arity == 3) + return fp (CAR (x), CADR (x), CAR (CDDR (x))); + else if (arity == -1) + return fp (x); +#elif !POSIX + if (arity == 0) + { + //function0_t fp = f->function; + SCM (*fp) (void) = f->function; + return fp (); + } + else if (arity == 1) + { + //function1_t fp = f->function; + SCM (*fp) (SCM) = f->function; + return fp (CAR (x)); + } + else if (arity == 2) + { + //function2_t fp = f->function; + SCM (*fp) (SCM, SCM) = f->function; + return fp (CAR (x), CADR (x)); + } + else if (arity == 3) + { + //function3_t fp = f->function; + SCM (*fp) (SCM, SCM, SCM) = f->function; + return fp (CAR (x), CADR (x), CAR (CDDR (x))); + } + else if (arity == -1) + { + //functionn_t fp = f->function; + SCM (*fp) (SCM) = f->function; + return fp (x); + } +#else + if (arity == 0) + return FUNCTION (fn).function0 (); + else if (arity == 1) + return FUNCTION (fn).function1 (CAR (x)); + else if (arity == 2) + return FUNCTION (fn).function2 (CAR (x), CADR (x)); + else if (arity == 3) + return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x))); + else if (arity == -1) + return FUNCTION (fn).functionn (x); +#endif //! (__M2_PLANET__ || !POSIX) return cell_unspecified; } @@ -720,29 +787,25 @@ assq (SCM x, SCM a) { if (TYPE (a) != TPAIR) return cell_f; - switch (TYPE (x)) - { - case TCHAR: - case TNUMBER: + int t = TYPE (x); + if (t == TCHAR + || t == TNUMBER) { SCM v = VALUE (x); while (a != cell_nil && v != VALUE (CAAR (a))) a = CDR (a); - break; } - case TKEYWORD: + else if (t == TKEYWORD) { SCM v = STRING (x); while (a != cell_nil && v != STRING (CAAR (a))) a = CDR (a); - break; } - // case TSYMBOL: - // case TSPECIAL: - default: - while (a != cell_nil && x != CAAR (a)) - a = CDR (a); - } + // else if (t == TSYMBOL) + // else if (t == TSPECIAL) + else + while (a != cell_nil && x != CAAR (a)) + a = CDR (a); return a != cell_nil ? CAR (a) : cell_f; } @@ -965,47 +1028,47 @@ eval_apply () SCM x; int global_p; int macro_p; + int t; + int c; eval_apply: - switch (r3) - { - case cell_vm_evlis: goto evlis; - case cell_vm_evlis2: goto evlis2; - case cell_vm_evlis3: goto evlis3; - case cell_vm_apply: goto apply; - case cell_vm_apply2: goto apply2; - case cell_vm_eval: goto eval; - case cell_vm_eval_pmatch_car: goto eval_pmatch_car; - case cell_vm_eval_pmatch_cdr: goto eval_pmatch_cdr; - case cell_vm_eval_define: goto eval_define; - case cell_vm_eval_set_x: goto eval_set_x; - case cell_vm_eval_macro_expand_eval: goto eval_macro_expand_eval; - case cell_vm_eval_macro_expand_expand: goto eval_macro_expand_expand; - case cell_vm_eval_check_func: goto eval_check_func; - case cell_vm_eval2: goto eval2; - case cell_vm_macro_expand: goto macro_expand; - case cell_vm_macro_expand_define: goto macro_expand_define; - case cell_vm_macro_expand_define_macro: goto macro_expand_define_macro; - case cell_vm_macro_expand_lambda: goto macro_expand_lambda; - case cell_vm_macro_expand_set_x: goto macro_expand_set_x; - case cell_vm_macro_expand_car: goto macro_expand_car; - case cell_vm_macro_expand_cdr: goto macro_expand_cdr; - case cell_vm_begin: goto begin; - case cell_vm_begin_eval: goto begin_eval; - case cell_vm_begin_primitive_load: goto begin_primitive_load; - case cell_vm_begin_expand: goto begin_expand; - case cell_vm_begin_expand_eval: goto begin_expand_eval; - case cell_vm_begin_expand_macro: goto begin_expand_macro; - case cell_vm_begin_expand_primitive_load: goto begin_expand_primitive_load; - case cell_vm_if: goto vm_if; - case cell_vm_if_expr: goto if_expr; - case cell_vm_call_with_current_continuation2: goto call_with_current_continuation2; - case cell_vm_call_with_values2: goto call_with_values2; - case cell_vm_return: goto vm_return; - case cell_unspecified: return r1; - default: - assert (0); - } + if (r3 == cell_vm_evlis) goto evlis; + else if (r3 == cell_vm_evlis2) goto evlis2; + else if (r3 == cell_vm_evlis3) goto evlis3; + else if (r3 == cell_vm_apply) goto apply; + else if (r3 == cell_vm_apply2) goto apply2; + else if (r3 == cell_vm_eval) goto eval; + else if (r3 == cell_vm_eval_pmatch_car) goto eval_pmatch_car; + else if (r3 == cell_vm_eval_pmatch_cdr) goto eval_pmatch_cdr; + else if (r3 == cell_vm_eval_define) goto eval_define; + else if (r3 == cell_vm_eval_set_x) goto eval_set_x; + else if (r3 == cell_vm_eval_macro_expand_eval) goto eval_macro_expand_eval; + else if (r3 == cell_vm_eval_macro_expand_expand) goto eval_macro_expand_expand; + else if (r3 == cell_vm_eval_check_func) goto eval_check_func; + else if (r3 == cell_vm_eval2) goto eval2; + else if (r3 == cell_vm_macro_expand) goto macro_expand; + else if (r3 == cell_vm_macro_expand_define) goto macro_expand_define; + else if (r3 == cell_vm_macro_expand_define_macro) goto macro_expand_define_macro; + else if (r3 == cell_vm_macro_expand_lambda) goto macro_expand_lambda; + else if (r3 == cell_vm_macro_expand_set_x) goto macro_expand_set_x; + else if (r3 == cell_vm_macro_expand_car) goto macro_expand_car; + else if (r3 == cell_vm_macro_expand_cdr) goto macro_expand_cdr; + else if (r3 == cell_vm_begin) goto begin; + else if (r3 == cell_vm_begin_eval) goto begin_eval; + else if (r3 == cell_vm_begin_primitive_load) goto begin_primitive_load; + else if (r3 == cell_vm_begin_expand) goto begin_expand; + else if (r3 == cell_vm_begin_expand_eval) goto begin_expand_eval; + else if (r3 == cell_vm_begin_expand_macro) goto begin_expand_macro; + else if (r3 == cell_vm_begin_expand_primitive_load) goto begin_expand_primitive_load; + else if (r3 == cell_vm_if) goto vm_if; + else if (r3 == cell_vm_if_expr) goto if_expr; + else if (r3 == cell_vm_call_with_current_continuation2) goto call_with_current_continuation2; + else if (r3 == cell_vm_call_with_values2) goto call_with_values2; + else if (r3 == cell_vm_return) goto vm_return; + else if (r3 == cell_unspecified) return r1; + else + error (cell_symbol_system_error, + MAKE_STRING (cstring_to_list ("eval/apply unknown continuation"))); evlis: if (r1 == cell_nil) @@ -1022,92 +1085,85 @@ eval_apply () goto vm_return; apply: - switch (TYPE (CAR (r1))) + t = TYPE (CAR (r1)); + if (t == TFUNCTION) { - case TFUNCTION: - { - check_formals (CAR (r1), MAKE_NUMBER (FUNCTION (CAR (r1)).arity), CDR (r1)); - r1 = call (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply - goto vm_return; - } - case TCLOSURE: - { - cl = CLOSURE (CAR (r1)); - body = CDDR (cl); - formals = CADR (cl); - args = CDR (r1); - aa = CDAR (cl); - aa = CDR (aa); - check_formals (CAR (r1), formals, CDR (r1)); - p = pairlis (formals, args, aa); - call_lambda (body, p, aa, r0); - goto begin; - } - case TCONTINUATION: - { - x = r1; - g_stack = CONTINUATION (CAR (r1)); - gc_pop_frame (); - r1 = CADR (x); - goto eval_apply; - } - case TSPECIAL: - { - switch (CAR (r1)) - { - case cell_vm_apply: - { - push_cc (cons (CADR (r1), CADDR (r1)), r1, r0, cell_vm_return); - goto apply; - } - case cell_vm_eval: - { - push_cc (CADR (r1), r1, CADDR (r1), cell_vm_return); - goto eval; - } - case cell_vm_begin_expand: - { - push_cc (cons (CADR (r1), cell_nil), r1, CADDR (r1), cell_vm_return); - goto begin_expand; - } - case cell_call_with_current_continuation: - { - r1 = CDR (r1); - goto call_with_current_continuation; - } - default: check_apply (cell_f, CAR (r1)); - } - } - case TSYMBOL: - { - if (CAR (r1) == cell_symbol_call_with_values) - { - r1 = CDR (r1); - goto call_with_values; - } - if (CAR (r1) == cell_symbol_current_module) - { - r1 = r0; - goto vm_return; - } - break; - } - case TPAIR: - { - switch (CAAR (r1)) - { - case cell_symbol_lambda: - { - formals = CADR (CAR (r1)); - args = CDR (r1); - body = CDDR (CAR (r1)); - p = pairlis (formals, CDR (r1), r0); - check_formals (r1, formals, args); - call_lambda (body, p, p, r0); - goto begin; - } - } - } + check_formals (CAR (r1), MAKE_NUMBER (FUNCTION (CAR (r1)).arity), CDR (r1)); + r1 = call (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply + goto vm_return; + } + else if (t == TCLOSURE) + { + cl = CLOSURE (CAR (r1)); + body = CDDR (cl); + formals = CADR (cl); + args = CDR (r1); + aa = CDAR (cl); + aa = CDR (aa); + check_formals (CAR (r1), formals, CDR (r1)); + p = pairlis (formals, args, aa); + call_lambda (body, p, aa, r0); + goto begin; + } + else if (t == TCONTINUATION) + { + x = r1; + g_stack = CONTINUATION (CAR (r1)); + gc_pop_frame (); + r1 = CADR (x); + goto eval_apply; + } + else if (t == TSPECIAL) + { + c = CAR (r1); + if (c == cell_vm_apply) + { + push_cc (cons (CADR (r1), CADDR (r1)), r1, r0, cell_vm_return); + goto apply; + } + else if (c == cell_vm_eval) + { + push_cc (CADR (r1), r1, CADDR (r1), cell_vm_return); + goto eval; + } + else if (c == cell_vm_begin_expand) + { + push_cc (cons (CADR (r1), cell_nil), r1, CADDR (r1), cell_vm_return); + goto begin_expand; + } + else if (c == cell_call_with_current_continuation) + { + r1 = CDR (r1); + goto call_with_current_continuation; + } + else + check_apply (cell_f, CAR (r1)); + } + else if (t == TSYMBOL) + { + if (CAR (r1) == cell_symbol_call_with_values) + { + r1 = CDR (r1); + goto call_with_values; + } + if (CAR (r1) == cell_symbol_current_module) + { + r1 = r0; + goto vm_return; + } + } + else if (t == TPAIR) + { + if (CAAR (r1) == cell_symbol_lambda) + { + formals = CADR (CAR (r1)); + args = CDR (r1); + body = CDDR (CAR (r1)); + p = pairlis (formals, CDR (r1), r0); + check_formals (r1, formals, args); + call_lambda (body, p, p, r0); + goto begin; + } } push_cc (CAR (r1), r1, r0, cell_vm_apply2); goto eval; @@ -1117,183 +1173,178 @@ eval_apply () goto apply; eval: - switch (TYPE (r1)) + t = TYPE (r1); + if (t == TPAIR) { - case TPAIR: - { - switch (CAR (r1)) - { - case cell_symbol_pmatch_car: + c = CAR (r1); + if (c == cell_symbol_pmatch_car) + { + push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_car); + goto eval; + eval_pmatch_car: + x = r1; + gc_pop_frame (); + r1 = CAR (x); + goto eval_apply; + } + else if (c == cell_symbol_pmatch_cdr) + { + push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_cdr); + goto eval; + eval_pmatch_cdr: + x = r1; + gc_pop_frame (); + r1 = CDR (x); + goto eval_apply; + } + else if (c == cell_symbol_quote) + { + x = r1; + gc_pop_frame (); + r1 = CADR (x); + goto eval_apply; + } + else if (c == cell_symbol_begin) + goto begin; + else if (c == cell_symbol_lambda) + { + r1 = make_closure_ (CADR (r1), CDDR (r1), r0); + goto vm_return; + } + else if (c == cell_symbol_if) + { + r1=CDR (r1); + goto vm_if; + } + else if (c == cell_symbol_set_x) + { + push_cc (CAR (CDDR (r1)), r1, r0, cell_vm_eval_set_x); + goto eval; + eval_set_x: + r1 = set_env_x (CADR (r2), r1, r0); + goto vm_return; + } + else if (c == cell_vm_macro_expand) + { + push_cc (CADR (r1), r1, r0, cell_vm_eval_macro_expand_eval); + goto eval; + eval_macro_expand_eval: + push_cc (r1, r2, r0, cell_vm_eval_macro_expand_expand); + goto macro_expand; + eval_macro_expand_expand: + goto vm_return; + } + else + { + if (TYPE (r1) == TPAIR + && (CAR (r1) == cell_symbol_define + || CAR (r1) == cell_symbol_define_macro)) { - push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_car); - goto eval; - eval_pmatch_car: - x = r1; - gc_pop_frame (); - r1 = CAR (x); - goto eval_apply; - } - case cell_symbol_pmatch_cdr: - { - push_cc (CADR (r1), r1, r0, cell_vm_eval_pmatch_cdr); - goto eval; - eval_pmatch_cdr: - x = r1; - gc_pop_frame (); - r1 = CDR (x); - goto eval_apply; - } - case cell_symbol_quote: - { - x = r1; - gc_pop_frame (); - r1 = CADR (x); - goto eval_apply; - } - case cell_symbol_begin: - goto begin; - case cell_symbol_lambda: - { - r1 = make_closure_ (CADR (r1), CDDR (r1), r0); - goto vm_return; - } - case cell_symbol_if: - { - r1=CDR (r1); - goto vm_if; - } - case cell_symbol_set_x: - { - push_cc (CAR (CDDR (r1)), r1, r0, cell_vm_eval_set_x); - goto eval; - eval_set_x: - r1 = set_env_x (CADR (r2), r1, r0); - goto vm_return; - } - case cell_vm_macro_expand: - { - push_cc (CADR (r1), r1, r0, cell_vm_eval_macro_expand_eval); - goto eval; - eval_macro_expand_eval: - push_cc (r1, r2, r0, cell_vm_eval_macro_expand_expand); - goto macro_expand; - eval_macro_expand_expand: - goto vm_return; - } - default: - { - if (TYPE (r1) == TPAIR - && (CAR (r1) == cell_symbol_define - || CAR (r1) == cell_symbol_define_macro)) + global_p = CAAR (r0) != cell_closure; + macro_p = CAR (r1) == cell_symbol_define_macro; + if (global_p) { - global_p = CAAR (r0) != cell_closure; - macro_p = CAR (r1) == cell_symbol_define_macro; - if (global_p) - { - name = CADR (r1); - if (TYPE (CADR (r1)) == TPAIR) - name = CAR (name); - if (macro_p) - { - entry = assq (name, g_macros); - if (entry == cell_f) - { - entry = cons (name, cell_f); - g_macros = cons (entry, g_macros); - } - } - else - { - entry = assq (name, r0); - if (entry == cell_f) - { - entry = cons (name, cell_f); - aa = cons (entry, cell_nil); - set_cdr_x (aa, cdr (r0)); - set_cdr_x (r0, aa); - } - } - } - r2 = r1; - if (TYPE (CADR (r1)) != TPAIR) - { - push_cc (CAR (CDDR (r1)), r2, cons (cons (CADR (r1), CADR (r1)), r0), cell_vm_eval_define); - goto eval; - } - else - { - p = pairlis (CADR (r1), CADR (r1), r0); - formals = CDR (CADR (r1)); - body = CDDR (r1); - - if (macro_p || global_p) - expand_variable (body, formals); - r1 = cons (cell_symbol_lambda, cons (formals, body)); - push_cc (r1, r2, p, cell_vm_eval_define); - goto eval; - } - eval_define:; - name = CADR (r2); - if (TYPE (CADR (r2)) == TPAIR) + name = CADR (r1); + if (TYPE (CADR (r1)) == TPAIR) name = CAR (name); if (macro_p) { entry = assq (name, g_macros); - r1 = MAKE_MACRO (name, r1); - set_cdr_x (entry, r1); - } - else if (global_p) - { - entry = assq (name, r0); - set_cdr_x (entry, r1); + if (entry == cell_f) + { + entry = cons (name, cell_f); + g_macros = cons (entry, g_macros); + } } else { - entry = cons (name, r1); - aa = cons (entry, cell_nil); - set_cdr_x (aa, cdr (r0)); - set_cdr_x (r0, aa); - cl = assq (cell_closure, r0); - set_cdr_x (cl, aa); + entry = assq (name, r0); + if (entry == cell_f) + { + entry = cons (name, cell_f); + aa = cons (entry, cell_nil); + set_cdr_x (aa, cdr (r0)); + set_cdr_x (r0, aa); + } } - r1 = cell_unspecified; - goto vm_return; } - push_cc (CAR (r1), r1, r0, cell_vm_eval_check_func); - gc_check (); - goto eval; - eval_check_func: - push_cc (CDR (r2), r2, r0, cell_vm_eval2); - goto evlis; - eval2: - r1 = cons (CAR (r2), r1); - goto apply; + r2 = r1; + if (TYPE (CADR (r1)) != TPAIR) + { + push_cc (CAR (CDDR (r1)), r2, cons (cons (CADR (r1), CADR (r1)), r0), cell_vm_eval_define); + goto eval; + } + else + { + p = pairlis (CADR (r1), CADR (r1), r0); + formals = CDR (CADR (r1)); + body = CDDR (r1); + + if (macro_p || global_p) + expand_variable (body, formals); + r1 = cons (cell_symbol_lambda, cons (formals, body)); + push_cc (r1, r2, p, cell_vm_eval_define); + goto eval; + } + eval_define:; + name = CADR (r2); + if (TYPE (CADR (r2)) == TPAIR) + name = CAR (name); + if (macro_p) + { + entry = assq (name, g_macros); + r1 = MAKE_MACRO (name, r1); + set_cdr_x (entry, r1); + } + else if (global_p) + { + entry = assq (name, r0); + set_cdr_x (entry, r1); + } + else + { + entry = cons (name, r1); + aa = cons (entry, cell_nil); + set_cdr_x (aa, cdr (r0)); + set_cdr_x (r0, aa); + cl = assq (cell_closure, r0); + set_cdr_x (cl, aa); + } + r1 = cell_unspecified; + goto vm_return; } - } - } - case TSYMBOL: - { - if (r1 == cell_symbol_current_module) - goto vm_return; - if (r1 == cell_symbol_begin) // FIXME - { - r1 = cell_begin; - goto vm_return; - } - r1 = assert_defined (r1, assq_ref_env (r1, r0)); - goto vm_return; - } - case TVARIABLE: - { - r1 = CDR (VARIABLE (r1)); - goto vm_return; - } - case TBROKEN_HEART: - { - error (cell_symbol_system_error, r1); - } - default: goto vm_return; + push_cc (CAR (r1), r1, r0, cell_vm_eval_check_func); + gc_check (); + goto eval; + eval_check_func: + push_cc (CDR (r2), r2, r0, cell_vm_eval2); + goto evlis; + eval2: + r1 = cons (CAR (r2), r1); + goto apply; + } } + else if (t == TSYMBOL) + { + if (r1 == cell_symbol_current_module) + goto vm_return; + if (r1 == cell_symbol_begin) // FIXME + { + r1 = cell_begin; + goto vm_return; + } + r1 = assert_defined (r1, assq_ref_env (r1, r0)); + goto vm_return; + } + else if (t == TVARIABLE) + { + r1 = CDR (VARIABLE (r1)); + goto vm_return; + } + else if (t == TBROKEN_HEART) + error (cell_symbol_system_error, r1); + else + goto vm_return; macro_expand: {