altos/lisp: more GC issues. add patom

Use global ao_lisp_stack instead of local stack so that gc
moves of that item work.

Signed-off-by: Keith Packard <keithp@keithp.com>

diff --git a/src/lambdakey-v1.0/ao_lambdakey.c b/src/lambdakey-v1.0/ao_lambdakey.c
index 6ac78717c4b0c18b8610ee02e953f46f08bb6a30..8353d81113288e70131edda1b3c53d8b0339d753 100644 (file)
--- a/src/lambdakey-v1.0/ao_lambdakey.c
+++ b/src/lambdakey-v1.0/ao_lambdakey.c
@@ -15,39 +15,11 @@
 #include <ao.h>
 #include <ao_lisp.h>
 
-static uint16_t        blink_delay, blink_running;
-
-static void blink(void) {
-       blink_running = 1;
-       while (blink_delay) {
-               ao_led_on(AO_LED_RED);
-               ao_delay(blink_delay);
-               ao_led_off(AO_LED_RED);
-               ao_delay(blink_delay);
-       }
-       blink_running = 0;
-       ao_wakeup(&blink_running);
-       ao_exit();
-}
-
-struct ao_task blink_task;
-
-static void blink_cmd() {
-       ao_cmd_decimal();
-       blink_delay = ao_cmd_lex_i;
-       if (blink_delay && !blink_running)
-               ao_add_task(&blink_task, blink, "blink");
-       if (!blink_delay)
-               while (blink_running)
-                       ao_sleep(&blink_running);
-}
-
 static void lisp_cmd() {
        ao_lisp_read_eval_print();
 }
 
 static const struct ao_cmds blink_cmds[] = {
-       { blink_cmd,    "b <delay, 0 off>\0Blink the green LED" },
        { lisp_cmd,     "l\0Run lisp interpreter" },
        { 0, 0 }
 };

diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h
index e379ed12e58862b2cf66b8665ddb7f60e15ffa01..4da638b9f0222dc489b81286286eda1f36673f56 100644 (file)
--- a/src/lambdakey-v1.0/ao_pins.h
+++ b/src/lambdakey-v1.0/ao_pins.h
@@ -25,7 +25,8 @@
 #define AO_LED_RED     (1 << LED_PIN_RED)
 #define AO_LED_PANIC   AO_LED_RED
 #define AO_CMD_LEN     128
-#define AO_LISP_POOL   2048
+#define AO_LISP_POOL   1536
+#define AO_STACK_SIZE  2048
 
 #define LEDS_AVAILABLE (AO_LED_RED)
 

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 27174e131997e06286eaab71ba6d13824a37827c..0d17994282cafc803743bb0ffda36b45b05def7f 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -173,6 +173,7 @@ enum ao_lisp_builtin_id {
        builtin_setq,
        builtin_cond,
        builtin_print,
+       builtin_patom,
        builtin_plus,
        builtin_minus,
        builtin_times,
@@ -331,6 +332,9 @@ ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
 void
 ao_lisp_cons_print(ao_poly);
 
+void
+ao_lisp_cons_patom(ao_poly);
+
 /* string */
 extern const struct ao_lisp_type ao_lisp_string_type;
 
@@ -346,6 +350,9 @@ ao_lisp_string_cat(char *a, char *b);
 void
 ao_lisp_string_print(ao_poly s);
 
+void
+ao_lisp_string_patom(ao_poly s);
+
 /* atom */
 extern const struct ao_lisp_type ao_lisp_atom_type;
 
@@ -370,9 +377,12 @@ void
 ao_lisp_int_print(ao_poly i);
 
 /* prim */
-ao_poly
+void
 ao_lisp_poly_print(ao_poly p);
 
+void
+ao_lisp_poly_patom(ao_poly p);
+
 int
 ao_lisp_poly_mark(ao_poly p);
 

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 0ad1f4645a9d510b26220a9af5e2a5ce93849aef..49b6c37dd47bf0ca837df2b93994053bea617695 100644 (file)
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -179,6 +179,18 @@ ao_lisp_print(struct ao_lisp_cons *cons)
        return val;
 }
 
+ao_poly
+ao_lisp_patom(struct ao_lisp_cons *cons)
+{
+       ao_poly val = AO_LISP_NIL;
+       while (cons) {
+               val = cons->car;
+               ao_lisp_poly_patom(val);
+               cons = ao_lisp_poly_cons(cons->cdr);
+       }
+       return val;
+}
+
 ao_poly
 ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 {
@@ -376,6 +388,7 @@ ao_lisp_func_t ao_lisp_builtins[] = {
        [builtin_setq] = ao_lisp_setq,
        [builtin_cond] = ao_lisp_cond,
        [builtin_print] = ao_lisp_print,
+       [builtin_patom] = ao_lisp_patom,
        [builtin_plus] = ao_lisp_plus,
        [builtin_minus] = ao_lisp_minus,
        [builtin_times] = ao_lisp_times,

diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c
index 4929b91cf73dfcaeb0964d46928c6b53d22c13fb..7d3ca68d6a7134914459791faaf283359264345a 100644 (file)
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -83,3 +83,14 @@ ao_lisp_cons_print(ao_poly c)
        }
        printf(")");
 }
+
+void
+ao_lisp_cons_patom(ao_poly c)
+{
+       struct ao_lisp_cons *cons = ao_lisp_poly_cons(c);
+
+       while (cons) {
+               ao_lisp_poly_patom(cons->car);
+               cons = ao_lisp_poly_cons(cons->cdr);
+       }
+}

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 0de3f1905bf1b81c05e1ca67c9d9a1c7844626b8..e3d653b99e1635e078967db28d84cf3a8ee26475 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -15,12 +15,13 @@
 #include "ao_lisp.h"
 
 #if 0
+#define DBG_CODE       1
 static int stack_depth;
 #define DBG_INDENT()   do { int _s; for(_s = 0; _s < stack_depth; _s++) printf("  "); } while(0)
 #define DBG_IN()       (++stack_depth)
 #define DBG_OUT()      (--stack_depth)
 #define DBG(...)       printf(__VA_ARGS__)
-#define DBGI(...)      do { DBG_INDENT(); DBG(__VA_ARGS__); } while (0)
+#define DBGI(...)      do { DBG_INDENT(); DBG("%4d: ", __LINE__); DBG(__VA_ARGS__); } while (0)
 #define DBG_CONS(a)    ao_lisp_cons_print(ao_lisp_cons_poly(a))
 #define DBG_POLY(a)    ao_lisp_poly_print(a)
 #define OFFSET(a)      ((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1)
@@ -90,6 +91,29 @@ stack_mark(void *addr)
 
 static const struct ao_lisp_type ao_lisp_stack_type;
 
+#if DBG_CODE
+static void
+stack_validate_tail(struct ao_lisp_stack *stack)
+{
+       struct ao_lisp_cons *head = ao_lisp_poly_cons(stack->formals);
+       struct ao_lisp_cons *tail = ao_lisp_poly_cons(stack->formals_tail);
+       struct ao_lisp_cons *cons;
+       for (cons = head; cons && cons->cdr && cons != tail; cons = ao_lisp_poly_cons(cons->cdr))
+               ;
+       if (cons != tail || (tail && tail->cdr)) {
+               if (!tail) {
+                       printf("tail null\n");
+               } else {
+                       printf("tail validate fail head %d actual %d recorded %d\n",
+                              OFFSET(head), OFFSET(cons), OFFSET(tail));
+                       abort();
+               }
+       }
+}
+#else
+#define stack_validate_tail(s)
+#endif
+
 static void
 stack_move(void *addr)
 {
@@ -106,7 +130,8 @@ stack_move(void *addr)
                ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
                if (prev != ao_lisp_poly_stack(stack->prev))
                        stack->prev = ao_lisp_stack_poly(prev);
-               if (ret);
+               stack_validate_tail(stack);
+               if (ret)
                        break;
                stack = ao_lisp_poly_stack(stack->prev);
        }
@@ -122,6 +147,19 @@ static struct ao_lisp_stack        *ao_lisp_stack;
 static ao_poly                 ao_lisp_v;
 static uint8_t been_here;
 
+#if DBG_CODE
+static void
+stack_validate_tails(void)
+{
+       struct ao_lisp_stack    *stack;
+
+       for (stack = ao_lisp_stack; stack; stack = ao_lisp_poly_stack(stack->prev))
+               stack_validate_tail(stack);
+}
+#else
+#define stack_validate_tails(s)
+#endif
+
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
@@ -139,27 +177,35 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack)
        stack->formals = AO_LISP_NIL;
        stack->formals_tail = AO_LISP_NIL;
        stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
+       stack_validate_tails();
 }
 
-struct ao_lisp_stack *
+int
 ao_lisp_stack_push(void)
 {
+       stack_validate_tails();
+       if (ao_lisp_stack) {
+               DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
+               DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
+       }
+       DBGI("stack push\n");
+       DBG_IN();
        struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
        if (!stack)
-               return NULL;
+               return 0;
        stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
        ao_lisp_stack = stack;
        ao_lisp_stack_reset(stack);
-       DBGI("stack push\n");
-       DBG_IN();
-       return stack;
+       stack_validate_tails();
+       return 1;
 }
 
-struct ao_lisp_stack *
+void
 ao_lisp_stack_pop(void)
 {
        if (!ao_lisp_stack)
-               return NULL;
+               return;
+       stack_validate_tails();
        DBG_OUT();
        DBGI("stack pop\n");
        ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
@@ -167,12 +213,16 @@ ao_lisp_stack_pop(void)
                ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
        else
                ao_lisp_frame_current = NULL;
-       return ao_lisp_stack;
+       if (ao_lisp_stack) {
+               DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
+               DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
+       }
 }
 
 static void
 ao_lisp_stack_clear(void)
 {
+       stack_validate_tails();
        ao_lisp_stack = NULL;
        ao_lisp_frame_current = NULL;
 }
@@ -285,7 +335,6 @@ ao_lisp_lambda(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_eval(ao_poly _v)
 {
-       struct ao_lisp_stack    *stack;
        ao_poly                 formal;
 
        ao_lisp_v = _v;
@@ -295,45 +344,50 @@ ao_lisp_eval(ao_poly _v)
                ao_lisp_root_poly_add(&ao_lisp_v);
        }
 
-       stack = ao_lisp_stack_push();
+       if (!ao_lisp_stack_push())
+               goto bail;
 
        for (;;) {
                if (ao_lisp_exception)
-                       return AO_LISP_NIL;
-               switch (stack->state) {
+                       goto bail;
+               switch (ao_lisp_stack->state) {
                case eval_sexpr:
                        DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
                        switch (ao_lisp_poly_type(ao_lisp_v)) {
                        case AO_LISP_CONS:
                                if (ao_lisp_v == AO_LISP_NIL) {
-                                       stack->state = eval_exec;
+                                       ao_lisp_stack->state = eval_exec;
                                        break;
                                }
-                               stack->actuals = ao_lisp_v;
-                               stack->state = eval_formal;
-                               stack = ao_lisp_stack_push();
+                               ao_lisp_stack->actuals = ao_lisp_v;
+                               DBGI("actuals now "); DBG_POLY(ao_lisp_v); DBG("\n");
+                               ao_lisp_stack->state = eval_formal;
+                               if (!ao_lisp_stack_push())
+                                       goto bail;
                                ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
+                               stack_validate_tails();
                                break;
                        case AO_LISP_ATOM:
                                ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
                                /* fall through */
                        case AO_LISP_INT:
                        case AO_LISP_STRING:
-                               stack->state = eval_val;
+                       case AO_LISP_BUILTIN:
+                               ao_lisp_stack->state = eval_val;
                                break;
                        }
                        break;
                case eval_val:
                        DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
-                       stack = ao_lisp_stack_pop();
-                       if (!stack)
+                       ao_lisp_stack_pop();
+                       if (!ao_lisp_stack)
                                return ao_lisp_v;
-                       DBGI("..state %d\n", stack->state);
+                       DBGI("..state %d\n", ao_lisp_stack->state);
                        break;
 
                case eval_formal:
                        /* Check what kind of function we've got */
-                       if (!stack->formals) {
+                       if (!ao_lisp_stack->formals) {
                                switch (func_type(ao_lisp_v)) {
                                case AO_LISP_LAMBDA:
                                case _ao_lisp_atom_lambda:
@@ -343,99 +397,108 @@ ao_lisp_eval(ao_poly _v)
                                        break;
                                case AO_LISP_MACRO:
                                case _ao_lisp_atom_macro:
-                                       stack->macro = 1;
+                                       ao_lisp_stack->macro = 1;
                                case AO_LISP_NLAMBDA:
                                case _ao_lisp_atom_nlambda:
                                        DBGI(".. nlambda or macro\n");
-                                       stack->formals = stack->actuals;
-                                       stack->state = eval_exec_direct;
+                                       ao_lisp_stack->formals = ao_lisp_stack->actuals;
+                                       ao_lisp_stack->formals_tail = AO_LISP_NIL;
+                                       ao_lisp_stack->state = eval_exec_direct;
+                                       stack_validate_tails();
                                        break;
                                }
-                               if (stack->state == eval_exec_direct)
+                               if (ao_lisp_stack->state == eval_exec_direct)
                                        break;
                        }
 
+                       DBGI("add formal "); DBG_POLY(ao_lisp_v); DBG("\n");
+                       stack_validate_tails();
                        formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
-                       if (!formal) {
-                               ao_lisp_stack_clear();
-                               return AO_LISP_NIL;
-                       }
+                       stack_validate_tails();
+                       if (!formal)
+                               goto bail;
 
-                       if (stack->formals_tail)
-                               ao_lisp_poly_cons(stack->formals_tail)->cdr = formal;
+                       if (ao_lisp_stack->formals_tail)
+                               ao_lisp_poly_cons(ao_lisp_stack->formals_tail)->cdr = formal;
                        else
-                               stack->formals = formal;
-                       stack->formals_tail = formal;
+                               ao_lisp_stack->formals = formal;
+                       ao_lisp_stack->formals_tail = formal;
 
-                       DBGI("formals now "); DBG_POLY(stack->formals); DBG("\n");
+                       DBGI("formals now "); DBG_POLY(ao_lisp_stack->formals); DBG("\n");
 
-                       ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->cdr;
+                       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr;
 
-                       stack->state = eval_sexpr;
+                       stack_validate_tails();
+                       ao_lisp_stack->state = eval_sexpr;
 
                        break;
                case eval_exec:
-                       if (!stack->formals) {
+                       if (!ao_lisp_stack->formals) {
                                ao_lisp_v = AO_LISP_NIL;
-                               stack->state = eval_val;
+                               ao_lisp_stack->state = eval_val;
                                break;
                        }
-                       ao_lisp_v = ao_lisp_poly_cons(stack->formals)->car;
+                       ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->formals)->car;
                case eval_exec_direct:
-                       DBGI("exec: macro %d ", stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(stack->formals); DBG ("\n");
+                       DBGI("exec: macro %d ", ao_lisp_stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(ao_lisp_stack->formals); DBG ("\n");
                        if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_BUILTIN) {
-                               struct ao_lisp_builtin *b = ao_lisp_poly_builtin(ao_lisp_v);
-                               struct ao_lisp_cons     *f = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->formals)->cdr);
+                               stack_validate_tails();
+                               struct ao_lisp_builtin  *b = ao_lisp_poly_builtin(ao_lisp_v);
+                               stack_validate_tails();
+                               struct ao_lisp_cons     *f = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->formals)->cdr);
 
                                DBGI(".. builtin formals "); DBG_CONS(f); DBG("\n");
-                               if (stack->macro)
-                                       stack->state = eval_sexpr;
+                               stack_validate_tails();
+                               if (ao_lisp_stack->macro)
+                                       ao_lisp_stack->state = eval_sexpr;
                                else
-                                       stack->state = eval_val;
-                               stack->macro = 0;
+                                       ao_lisp_stack->state = eval_val;
+                               ao_lisp_stack->macro = 0;
+                               ao_lisp_stack->actuals = ao_lisp_stack->formals = ao_lisp_stack->formals_tail = AO_LISP_NIL;
                                ao_lisp_v = ao_lisp_func(b) (f);
                                DBGI("builtin result:"); DBG_POLY(ao_lisp_v); DBG ("\n");
-                               if (ao_lisp_exception) {
-                                       ao_lisp_stack_clear();
-                                       return AO_LISP_NIL;
-                               }
+                               if (ao_lisp_exception)
+                                       goto bail;
                                break;
                        } else {
-                               ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(stack->formals));
-                               ao_lisp_stack_reset(stack);
+                               ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(ao_lisp_stack->formals));
+                               ao_lisp_stack_reset(ao_lisp_stack);
                        }
                        break;
                case eval_cond:
-                       DBGI("cond: "); DBG_POLY(stack->actuals); DBG("\n");
-                       if (!stack->actuals) {
+                       DBGI("cond: "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
+                       if (!ao_lisp_stack->actuals) {
                                ao_lisp_v = AO_LISP_NIL;
-                               stack->state = eval_val;
+                               ao_lisp_stack->state = eval_val;
                        } else {
-                               ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->car;
+                               ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->car;
                                if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
                                        ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
                                        goto bail;
                                }
                                ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
-                               stack->state = eval_cond_test;
-                               stack = ao_lisp_stack_push();
-                               stack->state = eval_sexpr;
+                               ao_lisp_stack->state = eval_cond_test;
+                               stack_validate_tails();
+                               ao_lisp_stack_push();
+                               stack_validate_tails();
+                               ao_lisp_stack->state = eval_sexpr;
                        }
                        break;
                case eval_cond_test:
-                       DBGI("cond_test "); DBG_POLY(ao_lisp_v); DBG("\n");
+                       DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
                        if (ao_lisp_v) {
-                               struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->actuals)->car);
+                               struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->actuals)->car);
                                struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
                                if (c) {
                                        ao_lisp_v = c->car;
-                                       stack->state = eval_sexpr;
+                                       ao_lisp_stack->state = eval_sexpr;
                                } else {
-                                       stack->state = eval_val;
+                                       ao_lisp_stack->state = eval_val;
                                }
                        } else {
-                               stack->actuals = ao_lisp_poly_cons(stack->actuals)->cdr;
-                               stack->state = eval_cond;
+                               ao_lisp_stack->actuals = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr;
+                               DBGI("actuals now "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");
+                               ao_lisp_stack->state = eval_cond;
                        }
                        break;
                }

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 9768dc220c7710df07aa233feefa4290dd24348c..f2e3cea162f23baa84c5c10c9502d442b641d97a 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -41,6 +41,7 @@ struct builtin_func funcs[] = {
        "setq",         AO_LISP_MACRO,  builtin_setq,
        "cond",         AO_LISP_NLAMBDA,builtin_cond,
        "print",        AO_LISP_LEXPR,  builtin_print,
+       "patom",        AO_LISP_LEXPR,  builtin_patom,
        "+",            AO_LISP_LEXPR,  builtin_plus,
        "-",            AO_LISP_LEXPR,  builtin_minus,
        "*",            AO_LISP_LEXPR,  builtin_times,

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 9e716da9b2ebfbf82b6ccce6c55b1afc53b3432a..6e656454b1c2fe22edb4857578a75dedb3904eff 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -36,6 +36,7 @@ uint8_t       ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
 #endif
 
 #if 0
+#define DBG_INCLUDE
 #define DBG_DUMP       0
 #define DBG_OFFSET(a)  ((int) ((uint8_t *) (a) - ao_lisp_pool))
 #define DBG(...) printf(__VA_ARGS__)
@@ -179,15 +180,17 @@ move_object(void)
                        DBG_DO(void *addr = *ao_lisp_root[i].addr);
                        DBG_MOVE("root %d\n", DBG_OFFSET(addr));
                        if (!ao_lisp_move(ao_lisp_root[i].type,
-                                         ao_lisp_root[i].addr))
+                                         ao_lisp_root[i].addr)) {
                                DBG_MOVE("root moves from %p to %p\n",
                                         addr,
                                         *ao_lisp_root[i].addr);
+                       }
                } else {
                        DBG_DO(ao_poly p = *(ao_poly *) ao_lisp_root[i].addr);
-                       if (!ao_lisp_poly_move((ao_poly *) ao_lisp_root[i].addr))
+                       if (!ao_lisp_poly_move((ao_poly *) ao_lisp_root[i].addr)) {
                                DBG_MOVE("root poly move from %04x to %04x\n",
                                         p, *(ao_poly *) ao_lisp_root[i].addr);
+                       }
                }
        }
        DBG_MOVE_OUT();
@@ -338,7 +341,7 @@ ao_lisp_move(const struct ao_lisp_type *type, void **ref)
        int             size = type->size(addr);
 
        if (!addr)
-               return NULL;
+               return 1;
 
 #ifndef AO_LISP_MAKE_CONST
        if (AO_LISP_IS_CONST(addr))
@@ -370,7 +373,7 @@ ao_lisp_move_memory(void **ref, int size)
 {
        void *addr = *ref;
        if (!addr)
-               return NULL;
+               return 1;
 
        DBG_MOVE("memory %d\n", DBG_OFFSET(addr));
        DBG_MOVE_IN();

diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c
index 7f02505df7d3c7b2f95b5a780c2a2df1824fa8ce..82386a83ca2e05b5e82762bf12060b863989c660 100644 (file)
--- a/src/lisp/ao_lisp_prim.c
+++ b/src/lisp/ao_lisp_prim.c
@@ -20,21 +20,60 @@
 #define DBG(...)
 #endif
 
-static void (*const ao_lisp_print_funcs[AO_LISP_NUM_TYPE])(ao_poly) = {
-       [AO_LISP_CONS] = ao_lisp_cons_print,
-       [AO_LISP_STRING] = ao_lisp_string_print,
-       [AO_LISP_INT] = ao_lisp_int_print,
-       [AO_LISP_ATOM] = ao_lisp_atom_print,
-       [AO_LISP_BUILTIN] = ao_lisp_builtin_print
+struct ao_lisp_funcs {
+       void (*print)(ao_poly);
+       void (*patom)(ao_poly);
 };
 
-ao_poly
+static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = {
+       [AO_LISP_CONS] = {
+               .print = ao_lisp_cons_print,
+               .patom = ao_lisp_cons_patom,
+       },
+       [AO_LISP_STRING] = {
+               .print = ao_lisp_string_print,
+               .patom = ao_lisp_string_patom,
+       },
+       [AO_LISP_INT] = {
+               .print = ao_lisp_int_print,
+               .patom = ao_lisp_int_print,
+       },
+       [AO_LISP_ATOM] = {
+               .print = ao_lisp_atom_print,
+               .patom = ao_lisp_atom_print,
+       },
+       [AO_LISP_BUILTIN] = {
+               .print = ao_lisp_builtin_print,
+               .patom = ao_lisp_builtin_print,
+       }
+};
+
+static const struct ao_lisp_funcs *
+funcs(ao_poly p)
+{
+       uint8_t type = ao_lisp_poly_type(p);
+
+       if (type < AO_LISP_NUM_TYPE)
+               return &ao_lisp_funcs[type];
+       return NULL;
+}
+
+void
 ao_lisp_poly_print(ao_poly p)
 {
-       void (*print)(ao_poly) = ao_lisp_print_funcs[ao_lisp_poly_type(p)];
-       if (print)
-               print(p);
-       return p;
+       const struct ao_lisp_funcs *f = funcs(p);
+
+       if (f && f->print)
+               f->print(p);
+}
+
+void
+ao_lisp_poly_patom(ao_poly p)
+{
+       const struct ao_lisp_funcs *f = funcs(p);
+
+       if (f && f->patom)
+               f->patom(p);
 }
 
 static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {

diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c
index 39c3dc816ddd45dae08a6d6a83d3e876ec6bdd76..0064064cfe07cfc22730b7ac1f369b5240a23633 100644 (file)
--- a/src/lisp/ao_lisp_string.c
+++ b/src/lisp/ao_lisp_string.c
@@ -99,3 +99,13 @@ ao_lisp_string_print(ao_poly p)
        }
        putchar('"');
 }
+
+void
+ao_lisp_string_patom(ao_poly p)
+{
+       char    *s = ao_lisp_poly_string(p);
+       char    c;
+
+       while ((c = *s++))
+               putchar(c);
+}

diff --git a/src/nucleao-32/ao_pins.h b/src/nucleao-32/ao_pins.h
index 65de89edd014cfa0e2c18a79fa267793ff8d08da..092d347cc7c42a582ea42b11ddf89bafa4e69446 100644 (file)
--- a/src/nucleao-32/ao_pins.h
+++ b/src/nucleao-32/ao_pins.h
@@ -25,7 +25,8 @@
 #define AO_LED_GREEN   (1 << LED_PIN_GREEN)
 #define AO_LED_PANIC   AO_LED_GREEN
 #define AO_CMD_LEN     128
-#define AO_LISP_POOL   2048
+#define AO_LISP_POOL   1024
+#define AO_STACK_SIZE  1536
 
 #define LEDS_AVAILABLE (AO_LED_GREEN)