altos/lisp: re-use small frames

This saves a pile more use of the allocator by noting when frames have
not been referenced from another frame and freeing them when they go
out of scope. Frames with references are left to the allocator to deal
with.

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

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 2db4914fb6ebc507859fc1e51b9e9c1bcb96027f..bcb0a17fa7dfd8ba102d52f295b0e79abe5a97fc 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -156,13 +156,33 @@ struct ao_lisp_val {
 
 struct ao_lisp_frame {
        uint8_t                 type;
-       uint8_t                 num;
-       ao_poly                 next;
+       uint8_t                 _num;
+       ao_poly                 prev;
        struct ao_lisp_val      vals[];
 };
 
+#define AO_LISP_FRAME_NUM_MASK 0x7f
+
+/* Set when the frame escapes the lambda */
+#define AO_LISP_FRAME_MARK     0x80
+
+static inline int ao_lisp_frame_num(struct ao_lisp_frame *f) {
+       if (f->_num == 0xff)
+               ao_lisp_abort();
+       return f->_num & AO_LISP_FRAME_NUM_MASK;
+}
+
+static inline int ao_lisp_frame_marked(struct ao_lisp_frame *f) {
+       if (f->_num == 0xff)
+               ao_lisp_abort();
+       return f->_num & AO_LISP_FRAME_MARK;
+}
+
 static inline struct ao_lisp_frame *
 ao_lisp_poly_frame(ao_poly poly) {
+       struct ao_lisp_frame *frame = ao_lisp_ref(poly);
+       if (frame && frame->_num == 0xff)
+               ao_lisp_abort();
        return ao_lisp_ref(poly);
 }
 
@@ -500,6 +520,9 @@ ao_lisp_atom_print(ao_poly a);
 struct ao_lisp_atom *
 ao_lisp_atom_intern(char *name);
 
+ao_poly *
+ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom);
+
 ao_poly
 ao_lisp_atom_get(ao_poly atom);
 
@@ -574,12 +597,22 @@ ao_lisp_read_eval_print(void);
 /* frame */
 extern const struct ao_lisp_type ao_lisp_frame_type;
 
+#define AO_LISP_FRAME_FREE     4
+
+extern struct ao_lisp_frame    *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
+
+ao_poly
+ao_lisp_frame_mark(struct ao_lisp_frame *frame);
+
 ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom);
 
 struct ao_lisp_frame *
 ao_lisp_frame_new(int num);
 
+void
+ao_lisp_frame_free(struct ao_lisp_frame *frame);
+
 int
 ao_lisp_frame_add(struct ao_lisp_frame **frame, ao_poly atom, ao_poly val);
 

diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c
index 6705f14036c07748a9b3a9004936c67b8bac3cdc..8c9e8ed11346ae5062c3f601ba38b6406f91233d 100644 (file)
--- a/src/lisp/ao_lisp_atom.c
+++ b/src/lisp/ao_lisp_atom.c
@@ -108,7 +108,7 @@ ao_lisp_atom_init(void)
                ao_lisp_frame_global = ao_lisp_frame_new(0);
 }
 
-static ao_poly *
+ao_poly *
 ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom)
 {
        ao_poly *ref;
@@ -117,7 +117,7 @@ ao_lisp_atom_ref(struct ao_lisp_frame *frame, ao_poly atom)
                ref = ao_lisp_frame_ref(frame, atom);
                if (ref)
                        return ref;
-               frame = ao_lisp_poly_frame(frame->next);
+               frame = ao_lisp_poly_frame(frame->prev);
        }
        if (ao_lisp_frame_global) {
                ref = ao_lisp_frame_ref(ao_lisp_frame_global, atom);

diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c
index cfa78d2272e73c473f2196464333cd497ec6c6ab..2b15c4184c99f4ef24565366fcc2cde93166e90b 100644 (file)
--- a/src/lisp/ao_lisp_error.c
+++ b/src/lisp/ao_lisp_error.c
@@ -49,7 +49,7 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame)
        tabs(indent);
        printf ("%s{", name);
        if (frame) {
-               for (f = 0; f < frame->num; f++) {
+               for (f = 0; f < ao_lisp_frame_num(frame); f++) {
                        if (f != 0) {
                                tabs(indent);
                                printf("         ");
@@ -59,8 +59,8 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame)
                        ao_lisp_poly_print(frame->vals[f].val);
                        printf("\n");
                }
-               if (frame->next)
-                       ao_lisp_error_frame(indent + 1, "next:   ", ao_lisp_poly_frame(frame->next));
+               if (frame->prev)
+                       ao_lisp_error_frame(indent + 1, "prev:   ", ao_lisp_poly_frame(frame->prev));
        }
        tabs(indent);
        printf("        }\n");

diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 3af567964deab8a4f87d13a26d13425e3508e901..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();

diff --git a/src/lisp/ao_lisp_frame.c b/src/lisp/ao_lisp_frame.c
index e23a641384b74781349f4dae712bb2bb21b1f910..052d27d7246f83228de8c9a9d5785cc39eced6de 100644 (file)
--- a/src/lisp/ao_lisp_frame.c
+++ b/src/lisp/ao_lisp_frame.c
@@ -24,7 +24,7 @@ static int
 frame_size(void *addr)
 {
        struct ao_lisp_frame    *frame = addr;
-       return frame_num_size(frame->num);
+       return frame_num_size(ao_lisp_frame_num(frame));
 }
 
 static void
@@ -37,7 +37,7 @@ frame_mark(void *addr)
                MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
                if (!AO_LISP_IS_POOL(frame))
                        break;
-               for (f = 0; f < frame->num; f++) {
+               for (f = 0; f < ao_lisp_frame_num(frame); f++) {
                        struct ao_lisp_val      *v = &frame->vals[f];
 
                        ao_lisp_poly_mark(v->val, 0);
@@ -46,7 +46,7 @@ frame_mark(void *addr)
                                  MDBG_OFFSET(ao_lisp_ref(v->atom)),
                                  MDBG_OFFSET(ao_lisp_ref(v->val)), f);
                }
-               frame = ao_lisp_poly_frame(frame->next);
+               frame = ao_lisp_poly_frame(frame->prev);
                MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
                if (!frame)
                        break;
@@ -62,13 +62,13 @@ frame_move(void *addr)
        int                     f;
 
        for (;;) {
-               struct ao_lisp_frame    *next;
+               struct ao_lisp_frame    *prev;
                int                     ret;
 
                MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
                if (!AO_LISP_IS_POOL(frame))
                        break;
-               for (f = 0; f < frame->num; f++) {
+               for (f = 0; f < ao_lisp_frame_num(frame); f++) {
                        struct ao_lisp_val      *v = &frame->vals[f];
 
                        ao_lisp_poly_move(&v->atom, 0);
@@ -78,19 +78,19 @@ frame_move(void *addr)
                                  MDBG_OFFSET(ao_lisp_ref(v->atom)),
                                  MDBG_OFFSET(ao_lisp_ref(v->val)), f);
                }
-               next = ao_lisp_poly_frame(frame->next);
-               if (!next)
+               prev = ao_lisp_poly_frame(frame->prev);
+               if (!prev)
                        break;
-               ret = ao_lisp_move_memory(&ao_lisp_frame_type, (void **) &next);
-               if (next != ao_lisp_poly_frame(frame->next)) {
-                       MDBG_MOVE("frame next moved from %d to %d\n",
-                                 MDBG_OFFSET(ao_lisp_poly_frame(frame->next)),
-                                 MDBG_OFFSET(next));
-                       frame->next = ao_lisp_frame_poly(next);
+               ret = ao_lisp_move_memory(&ao_lisp_frame_type, (void **) &prev);
+               if (prev != ao_lisp_poly_frame(frame->prev)) {
+                       MDBG_MOVE("frame prev moved from %d to %d\n",
+                                 MDBG_OFFSET(ao_lisp_poly_frame(frame->prev)),
+                                 MDBG_OFFSET(prev));
+                       frame->prev = ao_lisp_frame_poly(prev);
                }
                if (ret)
                        break;
-               frame = next;
+               frame = prev;
        }
 }
 
@@ -109,15 +109,15 @@ ao_lisp_frame_print(ao_poly p)
 
        printf ("{");
        if (frame) {
-               for (f = 0; f < frame->num; f++) {
+               for (f = 0; f < ao_lisp_frame_num(frame); f++) {
                        if (f != 0)
                                printf(", ");
                        ao_lisp_poly_print(frame->vals[f].atom);
                        printf(" = ");
                        ao_lisp_poly_print(frame->vals[f].val);
                }
-               if (frame->next)
-                       ao_lisp_poly_print(frame->next);
+               if (frame->prev)
+                       ao_lisp_poly_print(frame->prev);
        }
        printf("}");
 }
@@ -126,7 +126,7 @@ ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom)
 {
        int f;
-       for (f = 0; f < frame->num; f++)
+       for (f = 0; f < ao_lisp_frame_num(frame); f++)
                if (frame->vals[f].atom == atom)
                        return &frame->vals[f].val;
        return NULL;
@@ -143,7 +143,7 @@ ao_lisp_frame_set(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val)
                                return 1;
                        }
                }
-               frame = ao_lisp_poly_frame(frame->next);
+               frame = ao_lisp_poly_frame(frame->prev);
        }
        return 0;
 }
@@ -155,25 +155,55 @@ ao_lisp_frame_get(struct ao_lisp_frame *frame, ao_poly atom)
                ao_poly *ref = ao_lisp_frame_ref(frame, atom);
                if (ref)
                        return *ref;
-               frame = ao_lisp_poly_frame(frame->next);
+               frame = ao_lisp_poly_frame(frame->prev);
        }
        return AO_LISP_NIL;
 }
 
+struct ao_lisp_frame   *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
+
 struct ao_lisp_frame *
 ao_lisp_frame_new(int num)
 {
-       struct ao_lisp_frame *frame = ao_lisp_alloc(frame_num_size(num));
+       struct ao_lisp_frame    *frame;
 
-       if (!frame)
-               return NULL;
+       if (num < AO_LISP_FRAME_FREE && (frame = ao_lisp_frame_free_list[num]))
+               ao_lisp_frame_free_list[num] = ao_lisp_poly_frame(frame->prev);
+       else {
+               frame = ao_lisp_alloc(frame_num_size(num));
+               if (!frame)
+                       return NULL;
+       }
        frame->type = AO_LISP_FRAME;
-       frame->num = num;
-       frame->next = AO_LISP_NIL;
+       frame->_num = num;
+       frame->prev = AO_LISP_NIL;
        memset(frame->vals, '\0', num * sizeof (struct ao_lisp_val));
        return frame;
 }
 
+ao_poly
+ao_lisp_frame_mark(struct ao_lisp_frame *frame)
+{
+       if (!frame)
+               return AO_LISP_NIL;
+       if (frame->_num == 0xff)
+               ao_lisp_abort();
+       frame->_num |= AO_LISP_FRAME_MARK;
+       return ao_lisp_frame_poly(frame);
+}
+
+void
+ao_lisp_frame_free(struct ao_lisp_frame *frame)
+{
+       if (!ao_lisp_frame_marked(frame)) {
+               int     num = ao_lisp_frame_num(frame);
+               if (num < AO_LISP_FRAME_FREE) {
+                       frame->prev = ao_lisp_frame_poly(ao_lisp_frame_free_list[num]);
+                       ao_lisp_frame_free_list[num] = frame;
+               }
+       }
+}
+
 static struct ao_lisp_frame *
 ao_lisp_frame_realloc(struct ao_lisp_frame **frame_ref, int new_num)
 {
@@ -181,7 +211,7 @@ ao_lisp_frame_realloc(struct ao_lisp_frame **frame_ref, int new_num)
        struct ao_lisp_frame    *new;
        int                     copy;
 
-       if (new_num == frame->num)
+       if (new_num == ao_lisp_frame_num(frame))
                return frame;
        new = ao_lisp_frame_new(new_num);
        if (!new)
@@ -192,10 +222,11 @@ ao_lisp_frame_realloc(struct ao_lisp_frame **frame_ref, int new_num)
         */
        frame = *frame_ref;
        copy = new_num;
-       if (copy > frame->num)
-               copy = frame->num;
+       if (copy > ao_lisp_frame_num(frame))
+               copy = ao_lisp_frame_num(frame);
        memcpy(new->vals, frame->vals, copy * sizeof (struct ao_lisp_val));
-       new->next = frame->next;
+       new->prev = frame->prev;
+       ao_lisp_frame_free(frame);
        return new;
 }
 
@@ -210,7 +241,7 @@ ao_lisp_frame_add(struct ao_lisp_frame **frame_ref, ao_poly atom, ao_poly val)
                ao_lisp_poly_stash(0, atom);
                ao_lisp_poly_stash(1, val);
                if (frame) {
-                       f = frame->num;
+                       f = ao_lisp_frame_num(frame);
                        frame = ao_lisp_frame_realloc(frame_ref, f + 1);
                } else {
                        f = 0;

diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c
index 0dd8c698646703ea5f0a0057de4d7b9faee937d6..8b7617144b61d4625ab56d0719f46fcc2b92826b 100644 (file)
--- a/src/lisp/ao_lisp_lambda.c
+++ b/src/lisp/ao_lisp_lambda.c
@@ -94,7 +94,7 @@ ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args)
        lambda->type = AO_LISP_LAMBDA;
        lambda->args = args;
        lambda->code = ao_lisp_cons_poly(code);
-       lambda->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
+       lambda->frame = ao_lisp_frame_mark(ao_lisp_frame_current);
        DBGI("build frame: "); DBG_POLY(lambda->frame); DBG("\n");
        DBG_STACK();
        return ao_lisp_lambda_poly(lambda);
@@ -179,7 +179,7 @@ ao_lisp_lambda_eval(void)
                next_frame->vals[0].val = cons->cdr;
                break;
        }
-       next_frame->next = lambda->frame;
+       next_frame->prev = lambda->frame;
        DBGI("eval frame: "); DBG_POLY(ao_lisp_frame_poly(next_frame)); DBG("\n");
        ao_lisp_frame_current = next_frame;
        ao_lisp_stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index e7ece96036ae1d31ce17f5d1a4a463385d3453f3..7e7464c4a59495f78752fb89464f48a4a29796a9 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -214,8 +214,16 @@ static const struct ao_lisp_root   ao_lisp_root[] = {
 static const void ** const ao_lisp_cache[] = {
        (const void **) &ao_lisp_cons_free_list,
        (const void **) &ao_lisp_stack_free_list,
+       (const void **) &ao_lisp_frame_free_list[0],
+       (const void **) &ao_lisp_frame_free_list[1],
+       (const void **) &ao_lisp_frame_free_list[2],
+       (const void **) &ao_lisp_frame_free_list[3],
 };
 
+#if AO_LISP_FRAME_FREE != 4
+#error Unexpected AO_LISP_FRAME_FREE value
+#endif
+
 #define AO_LISP_CACHE  (sizeof (ao_lisp_cache) / sizeof (ao_lisp_cache[0]))
 
 #define AO_LISP_BUSY_SIZE      ((AO_LISP_POOL + 31) / 32)