altos/lisp: re-use small frames

[fw/altos] / src / lisp / ao_lisp_eval.c

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 5cc1b75a6838c6eae1f82541b541e23ba6bc1942..6f56a1205aee9a561e070dc68327175880af17d7 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -122,7 +122,8 @@ ao_lisp_stack_push(void)
 static void
 ao_lisp_stack_pop(void)
 {
-       ao_poly prev;
+       ao_poly                 prev;
+       struct ao_lisp_frame    *prev_frame;
 
        if (!ao_lisp_stack)
                return;
@@ -131,10 +132,13 @@ ao_lisp_stack_pop(void)
        ao_lisp_stack_free_list = ao_lisp_stack;
 
        ao_lisp_stack = ao_lisp_poly_stack(prev);
+       prev_frame = ao_lisp_frame_current;
        if (ao_lisp_stack)
                ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
        else
                ao_lisp_frame_current = NULL;
+       if (ao_lisp_frame_current != prev_frame)
+               ao_lisp_frame_free(prev_frame);
        DBG_OUT();
        DBGI("stack pop\n");
        DBG_FRAMES();
@@ -298,7 +302,7 @@ ao_lisp_eval_formal(void)
                        break;
                case AO_LISP_FUNC_MACRO:
                        /* Evaluate the result once more */
-                       ao_lisp_stack->state = eval_sexpr;
+                       ao_lisp_stack->state = eval_macro;
                        if (!ao_lisp_stack_push())
                                return 0;
 
@@ -308,7 +312,6 @@ ao_lisp_eval_formal(void)
                        prev = ao_lisp_poly_stack(ao_lisp_stack->prev);
                        ao_lisp_stack->state = eval_sexpr;
                        ao_lisp_stack->sexprs = prev->sexprs;
-                       prev->sexprs = AO_LISP_NIL;
 
                        DBGI(".. start macro\n");
                        DBGI(".. sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
@@ -555,6 +558,25 @@ ao_lisp_eval_while_test(void)
        return 1;
 }
 
+/*
+ * Replace the original sexpr with the macro expansion, then
+ * execute that
+ */
+static int
+ao_lisp_eval_macro(void)
+{
+       DBGI("macro: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
+
+       if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_CONS) {
+               *ao_lisp_poly_cons(ao_lisp_stack->sexprs) = *ao_lisp_poly_cons(ao_lisp_v);
+               ao_lisp_v = ao_lisp_stack->sexprs;
+               DBGI("sexprs rewritten to: "); DBG_POLY(ao_lisp_v); DBG("\n");
+       }
+       ao_lisp_stack->sexprs = AO_LISP_NIL;
+       ao_lisp_stack->state = eval_sexpr;
+       return 1;
+}
+
 static int (*const evals[])(void) = {
        [eval_sexpr] = ao_lisp_eval_sexpr,
        [eval_val] = ao_lisp_eval_val,
@@ -565,6 +587,7 @@ static int (*const evals[])(void) = {
        [eval_progn] = ao_lisp_eval_progn,
        [eval_while] = ao_lisp_eval_while,
        [eval_while_test] = ao_lisp_eval_while_test,
+       [eval_macro] = ao_lisp_eval_macro,
 };
 
 /*