altos/lisp: Cache freed cons and stack items

Track freed cons cells and stack items from the eval process where
possible so that they can be re-used without needing to collect.

This dramatically reduces the number of collect calls.

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

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index e90d791ad8dc83576f24a281a337a481105c328a..efd13cf570042868d0347b3486a8b761b06f00bb 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -206,6 +206,7 @@ ao_lisp_stack_poly(struct ao_lisp_stack *stack)
 }
 
 extern struct ao_lisp_stack    *ao_lisp_stack;
+extern struct ao_lisp_stack    *ao_lisp_stack_free_list;
 extern ao_poly                 ao_lisp_v;
 
 #define AO_LISP_FUNC_LAMBDA    0
@@ -213,6 +214,14 @@ extern ao_poly                     ao_lisp_v;
 #define AO_LISP_FUNC_MACRO     2
 #define AO_LISP_FUNC_LEXPR     3
 
+#define AO_LISP_FUNC_FREE_ARGS 0x80
+#define AO_LISP_FUNC_MASK      0x7f
+
+#define AO_LISP_FUNC_F_LAMBDA  (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LAMBDA)
+#define AO_LISP_FUNC_F_NLAMBDA (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_NLAMBDA)
+#define AO_LISP_FUNC_F_MACRO   (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_MACRO)
+#define AO_LISP_FUNC_F_LEXPR   (AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LEXPR)
+
 struct ao_lisp_builtin {
        uint8_t         type;
        uint8_t         args;
@@ -390,6 +399,9 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 }
 
 /* memory functions */
+
+extern int ao_lisp_collects;
+
 /* returns 1 if the object was already marked */
 int
 ao_lisp_mark(const struct ao_lisp_type *type, void *addr);
@@ -439,6 +451,11 @@ extern const struct ao_lisp_type ao_lisp_cons_type;
 struct ao_lisp_cons *
 ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
 
+extern struct ao_lisp_cons *ao_lisp_cons_free_list;
+
+void
+ao_lisp_cons_free(struct ao_lisp_cons *cons);
+
 void
 ao_lisp_cons_print(ao_poly);
 

diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c
index 311d63ab8dc3dd0497f1edb3385d219eeda42e14..d2b60c9a6561b06f1ec926d864d0c9934de951af 100644 (file)
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -69,23 +69,41 @@ const struct ao_lisp_type ao_lisp_cons_type = {
        .name = "cons",
 };
 
+struct ao_lisp_cons *ao_lisp_cons_free_list;
+
 struct ao_lisp_cons *
 ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
 {
        struct ao_lisp_cons     *cons;
 
-       ao_lisp_poly_stash(0, car);
-       ao_lisp_cons_stash(0, cdr);
-       cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
-       car = ao_lisp_poly_fetch(0);
-       cdr = ao_lisp_cons_fetch(0);
-       if (!cons)
-               return NULL;
+       if (ao_lisp_cons_free_list) {
+               cons = ao_lisp_cons_free_list;
+               ao_lisp_cons_free_list = ao_lisp_poly_cons(cons->cdr);
+       } else {
+               ao_lisp_poly_stash(0, car);
+               ao_lisp_cons_stash(0, cdr);
+               cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
+               car = ao_lisp_poly_fetch(0);
+               cdr = ao_lisp_cons_fetch(0);
+               if (!cons)
+                       return NULL;
+       }
        cons->car = car;
        cons->cdr = ao_lisp_cons_poly(cdr);
        return cons;
 }
 
+void
+ao_lisp_cons_free(struct ao_lisp_cons *cons)
+{
+       while (cons) {
+               ao_poly cdr = cons->cdr;
+               cons->cdr = ao_lisp_cons_poly(ao_lisp_cons_free_list);
+               ao_lisp_cons_free_list = cons;
+               cons = ao_lisp_poly_cons(cdr);
+       }
+}
+
 void
 ao_lisp_cons_print(ao_poly c)
 {

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 04d0e70a2f79eeeee957ee01df3ced52575478db..5cc1b75a6838c6eae1f82541b541e23ba6bc1942 100644 (file)
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -76,6 +76,8 @@ const struct ao_lisp_type ao_lisp_stack_type = {
 struct ao_lisp_stack           *ao_lisp_stack;
 ao_poly                                ao_lisp_v;
 
+struct ao_lisp_stack           *ao_lisp_stack_free_list;
+
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
@@ -97,9 +99,15 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 static int
 ao_lisp_stack_push(void)
 {
-       struct ao_lisp_stack    *stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
-       if (!stack)
-               return 0;
+       struct ao_lisp_stack    *stack;
+       if (ao_lisp_stack_free_list) {
+               stack = ao_lisp_stack_free_list;
+               ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev);
+       } else {
+               stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
+               if (!stack)
+                       return 0;
+       }
        stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
        stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
        stack->list = AO_LISP_NIL;
@@ -114,9 +122,15 @@ ao_lisp_stack_push(void)
 static void
 ao_lisp_stack_pop(void)
 {
+       ao_poly prev;
+
        if (!ao_lisp_stack)
                return;
-       ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev);
+       prev = ao_lisp_stack->prev;
+       ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list);
+       ao_lisp_stack_free_list = ao_lisp_stack;
+
+       ao_lisp_stack = ao_lisp_poly_stack(prev);
        if (ao_lisp_stack)
                ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
        else
@@ -141,7 +155,7 @@ func_type(ao_poly func)
                return ao_lisp_error(AO_LISP_INVALID, "func is nil");
        switch (ao_lisp_poly_type(func)) {
        case AO_LISP_BUILTIN:
-               return ao_lisp_poly_builtin(func)->args;
+               return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK;
        case AO_LISP_LAMBDA:
                return ao_lisp_poly_lambda(func)->args;
        default:
@@ -359,12 +373,15 @@ static int
 ao_lisp_eval_exec(void)
 {
        ao_poly v;
+       struct ao_lisp_builtin  *builtin;
+
        DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
        ao_lisp_stack->sexprs = AO_LISP_NIL;
        switch (ao_lisp_poly_type(ao_lisp_v)) {
        case AO_LISP_BUILTIN:
                ao_lisp_stack->state = eval_val;
-               v = ao_lisp_func(ao_lisp_poly_builtin(ao_lisp_v)) (
+               builtin = ao_lisp_poly_builtin(ao_lisp_v);
+               v = ao_lisp_func(builtin) (
                        ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
                DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
                                struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
@@ -372,6 +389,10 @@ ao_lisp_eval_exec(void)
                                ao_poly val = ao_lisp_arg(cons, 2);
                                DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
                        });
+               builtin = ao_lisp_poly_builtin(ao_lisp_v);
+               if (builtin->args & AO_LISP_FUNC_FREE_ARGS)
+                       ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values));
+
                ao_lisp_v = v;
                DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
                DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");

diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c
index 6020a8b8b1a8482e970d891c49306171d7e593b5..0dd8c698646703ea5f0a0057de4d7b9faee937d6 100644 (file)
--- a/src/lisp/ao_lisp_lambda.c
+++ b/src/lisp/ao_lisp_lambda.c
@@ -168,6 +168,7 @@ ao_lisp_lambda_eval(void)
                        args = ao_lisp_poly_cons(args->cdr);
                        vals = ao_lisp_poly_cons(vals->cdr);
                }
+               ao_lisp_cons_free(cons);
                break;
        }
        case AO_LISP_FUNC_LEXPR:

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 6a29f402d263cfbe5e11ae478089cb8440c1b9ce..178b041efbc5773d3457f81724ac842ba55b7966 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -33,42 +33,42 @@ struct builtin_func {
 };
 
 struct builtin_func funcs[] = {
-       "eval",         AO_LISP_FUNC_LAMBDA,    builtin_eval,
-       "read",         AO_LISP_FUNC_LAMBDA,    builtin_read,
+       "eval",         AO_LISP_FUNC_F_LAMBDA,  builtin_eval,
+       "read",         AO_LISP_FUNC_F_LAMBDA,  builtin_read,
        "lambda",       AO_LISP_FUNC_NLAMBDA,   builtin_lambda,
        "lexpr",        AO_LISP_FUNC_NLAMBDA,   builtin_lexpr,
        "nlambda",      AO_LISP_FUNC_NLAMBDA,   builtin_nlambda,
        "macro",        AO_LISP_FUNC_NLAMBDA,   builtin_macro,
-       "car",          AO_LISP_FUNC_LAMBDA,    builtin_car,
-       "cdr",          AO_LISP_FUNC_LAMBDA,    builtin_cdr,
-       "cons",         AO_LISP_FUNC_LAMBDA,    builtin_cons,
-       "last",         AO_LISP_FUNC_LAMBDA,    builtin_last,
-       "length",       AO_LISP_FUNC_LAMBDA,    builtin_length,
+       "car",          AO_LISP_FUNC_F_LAMBDA,  builtin_car,
+       "cdr",          AO_LISP_FUNC_F_LAMBDA,  builtin_cdr,
+       "cons",         AO_LISP_FUNC_F_LAMBDA,  builtin_cons,
+       "last",         AO_LISP_FUNC_F_LAMBDA,  builtin_last,
+       "length",       AO_LISP_FUNC_F_LAMBDA,  builtin_length,
        "quote",        AO_LISP_FUNC_NLAMBDA,   builtin_quote,
-       "set",          AO_LISP_FUNC_LAMBDA,    builtin_set,
+       "set",          AO_LISP_FUNC_F_LAMBDA,  builtin_set,
        "setq",         AO_LISP_FUNC_MACRO,     builtin_setq,
        "cond",         AO_LISP_FUNC_NLAMBDA,   builtin_cond,
        "progn",        AO_LISP_FUNC_NLAMBDA,   builtin_progn,
        "while",        AO_LISP_FUNC_NLAMBDA,   builtin_while,
-       "print",        AO_LISP_FUNC_LEXPR,     builtin_print,
-       "patom",        AO_LISP_FUNC_LEXPR,     builtin_patom,
-       "+",            AO_LISP_FUNC_LEXPR,     builtin_plus,
-       "-",            AO_LISP_FUNC_LEXPR,     builtin_minus,
-       "*",            AO_LISP_FUNC_LEXPR,     builtin_times,
-       "/",            AO_LISP_FUNC_LEXPR,     builtin_divide,
-       "%",            AO_LISP_FUNC_LEXPR,     builtin_mod,
-       "=",            AO_LISP_FUNC_LEXPR,     builtin_equal,
-       "<",            AO_LISP_FUNC_LEXPR,     builtin_less,
-       ">",            AO_LISP_FUNC_LEXPR,     builtin_greater,
-       "<=",           AO_LISP_FUNC_LEXPR,     builtin_less_equal,
-       ">=",           AO_LISP_FUNC_LEXPR,     builtin_greater_equal,
-       "pack",         AO_LISP_FUNC_LAMBDA,    builtin_pack,
-       "unpack",       AO_LISP_FUNC_LAMBDA,    builtin_unpack,
-       "flush",        AO_LISP_FUNC_LAMBDA,    builtin_flush,
-       "delay",        AO_LISP_FUNC_LAMBDA,    builtin_delay,
-       "led",          AO_LISP_FUNC_LEXPR,     builtin_led,
-       "save",         AO_LISP_FUNC_LAMBDA,    builtin_save,
-       "restore",      AO_LISP_FUNC_LAMBDA,    builtin_restore,
+       "print",        AO_LISP_FUNC_F_LEXPR,   builtin_print,
+       "patom",        AO_LISP_FUNC_F_LEXPR,   builtin_patom,
+       "+",            AO_LISP_FUNC_F_LEXPR,   builtin_plus,
+       "-",            AO_LISP_FUNC_F_LEXPR,   builtin_minus,
+       "*",            AO_LISP_FUNC_F_LEXPR,   builtin_times,
+       "/",            AO_LISP_FUNC_F_LEXPR,   builtin_divide,
+       "%",            AO_LISP_FUNC_F_LEXPR,   builtin_mod,
+       "=",            AO_LISP_FUNC_F_LEXPR,   builtin_equal,
+       "<",            AO_LISP_FUNC_F_LEXPR,   builtin_less,
+       ">",            AO_LISP_FUNC_F_LEXPR,   builtin_greater,
+       "<=",           AO_LISP_FUNC_F_LEXPR,   builtin_less_equal,
+       ">=",           AO_LISP_FUNC_F_LEXPR,   builtin_greater_equal,
+       "pack",         AO_LISP_FUNC_F_LAMBDA,  builtin_pack,
+       "unpack",       AO_LISP_FUNC_F_LAMBDA,  builtin_unpack,
+       "flush",        AO_LISP_FUNC_F_LAMBDA,  builtin_flush,
+       "delay",        AO_LISP_FUNC_F_LAMBDA,  builtin_delay,
+       "led",          AO_LISP_FUNC_F_LEXPR,   builtin_led,
+       "save",         AO_LISP_FUNC_F_LAMBDA,  builtin_save,
+       "restore",      AO_LISP_FUNC_F_LAMBDA,  builtin_restore,
 };
 
 #define N_FUNC (sizeof funcs / sizeof funcs[0])

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 08b5bac03250fc262e7caae27b3424c13d94c03e..e7ece96036ae1d31ce17f5d1a4a463385d3453f3 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -43,7 +43,6 @@ uint8_t       ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
-int dbg_collects = 0;
 int dbg_validate = 0;
 
 struct ao_lisp_record {
@@ -212,6 +211,13 @@ static const struct ao_lisp_root   ao_lisp_root[] = {
 
 #define AO_LISP_ROOT   (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
 
+static const void ** const ao_lisp_cache[] = {
+       (const void **) &ao_lisp_cons_free_list,
+       (const void **) &ao_lisp_stack_free_list,
+};
+
+#define AO_LISP_CACHE  (sizeof (ao_lisp_cache) / sizeof (ao_lisp_cache[0]))
+
 #define AO_LISP_BUSY_SIZE      ((AO_LISP_POOL + 31) / 32)
 
 static uint8_t ao_lisp_busy[AO_LISP_BUSY_SIZE];
@@ -229,14 +235,16 @@ struct ao_lisp_chunk {
        };
 };
 
-#define AO_LISP_NCHUNK 32
+#define AO_LISP_NCHUNK 64
 
 static struct ao_lisp_chunk ao_lisp_chunk[AO_LISP_NCHUNK];
 
 /* Offset of an address within the pool. */
 static inline uint16_t pool_offset(void *addr) {
+#if DBG_MEM
        if (!AO_LISP_IS_POOL(addr))
                ao_lisp_abort();
+#endif
        return ((uint8_t *) addr) - ao_lisp_pool;
 }
 
@@ -246,8 +254,10 @@ static inline uint16_t pool_offset(void *addr) {
  * These are used in the chunk code.
  */
 static inline ao_poly pool_poly(void *addr) {
+#if DBG_MEM
        if (!AO_LISP_IS_POOL(addr))
                ao_lisp_abort();
+#endif
        return ((uint8_t *) addr) - AO_LISP_POOL_BASE;
 }
 
@@ -306,8 +316,10 @@ note_chunk(uint16_t addr, uint16_t size)
 
        for (i = 0; i < AO_LISP_NCHUNK; i++) {
                if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) {
+#if DBG_MEM
                        if (ao_lisp_chunk[i].size != size)
                                ao_lisp_abort();
+#endif
                        return;
                }
                if (ao_lisp_chunk[i].old_addr > addr) {
@@ -339,7 +351,7 @@ walk(int (*visit_addr)(const struct ao_lisp_type *type, void **addr),
        memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
        memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
        ao_lisp_cons_noted = 0;
-       for (i = 0; i < AO_LISP_ROOT; i++) {
+       for (i = 0; i < (int) AO_LISP_ROOT; i++) {
                if (ao_lisp_root[i].type) {
                        void **a = ao_lisp_root[i].addr, *v;
                        if (a && (v = *a)) {
@@ -416,6 +428,8 @@ ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons)
        return ao_lisp_poly_mark(*p, do_note_cons);
 }
 
+int ao_lisp_collects;
+
 void
 ao_lisp_collect(void)
 {
@@ -427,10 +441,15 @@ ao_lisp_collect(void)
        int     moved;
        struct ao_lisp_record   *mark_record = NULL, *move_record = NULL;
 
-       ++dbg_collects;
-       MDBG_MOVE("collect %d\n", dbg_collects);
+       MDBG_MOVE("collect %d\n", ao_lisp_collects);
        marked = moved = 0;
 #endif
+
+       ++ao_lisp_collects;
+
+       /* Clear references to all caches */
+       for (i = 0; i < (int) AO_LISP_CACHE; i++)
+               *ao_lisp_cache[i] = NULL;
        chunk_low = 0;
        top = 0;
        for (;;) {
@@ -462,8 +481,10 @@ ao_lisp_collect(void)
 
                        if (ao_lisp_chunk[i].old_addr > top)
                                break;
+#if DBG_MEM
                        if (ao_lisp_chunk[i].old_addr != top)
                                ao_lisp_abort();
+#endif
 
                        top += size;
                        MDBG_MOVE("chunk %d %d not moving\n",
@@ -585,8 +606,10 @@ ao_lisp_poly_mark(ao_poly p, uint8_t do_note_cons)
 
                if (type == AO_LISP_OTHER) {
                        type = ao_lisp_other_type(ao_lisp_poly_other(p));
+#if DBG_MEM
                        if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
                                ao_lisp_abort();
+#endif
                }
 
                lisp_type = ao_lisp_types[ao_lisp_poly_type(p)];
@@ -622,6 +645,8 @@ ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref)
        if (!AO_LISP_IS_POOL(addr))
                return 1;
 
+       (void) type;
+
        MDBG_MOVE("move memory %d\n", MDBG_OFFSET(addr));
        addr = move_map(addr);
        if (addr != *ref) {
@@ -682,8 +707,10 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
 
                if (type == AO_LISP_OTHER) {
                        type = ao_lisp_other_type(move_map(ao_lisp_poly_other(p)));
+#if DBG_MEM
                        if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
                                ao_lisp_abort();
+#endif
                }
 
                lisp_type = ao_lisp_types[type];
@@ -795,8 +822,6 @@ ao_lisp_alloc(int size)
 void
 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons)
 {
-       if (save_cons[id] != NULL)
-               ao_lisp_abort();
        save_cons[id] = cons;
 }
 
@@ -811,8 +836,6 @@ ao_lisp_cons_fetch(int id)
 void
 ao_lisp_string_stash(int id, char *string)
 {
-       if (save_cons[id] != NULL)
-               ao_lisp_abort();
        save_string[id] = string;
 }
 

diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index 030846b7234b22197d0340512690cbede9282996..d5f28e7daf45c283d6ec6c776c887b402bd479f2 100644 (file)
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -27,7 +27,7 @@ ao_lisp_save(struct ao_lisp_cons *cons)
        os->atoms = ao_lisp_atom_poly(ao_lisp_atoms);
        os->globals = ao_lisp_frame_poly(ao_lisp_frame_global);
        os->const_checksum = ao_lisp_const_checksum;
-       os->const_checksum_inv = ~ao_lisp_const_checksum;
+       os->const_checksum_inv = (uint16_t) ~ao_lisp_const_checksum;
 
        if (ao_lisp_os_save())
                return _ao_lisp_atom_t;