altos/lisp: Split out frame vals from frame struct

This lets the frame be resized without moving the base structure. The
plan is to allow all frames to be resized, not just the global frame.

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

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 858212dd5012fc9659fce01dea1a8ba384a0f4f5..96a7a05f22c760e2255a9cdf79113f16a4c451da 100644 (file)
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -92,12 +92,13 @@ extern uint8_t              ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((a
 #define AO_LISP_ATOM           4
 #define AO_LISP_BUILTIN                5
 #define AO_LISP_FRAME          6
-#define AO_LISP_LAMBDA         7
-#define AO_LISP_STACK          8
-#define AO_LISP_BOOL           9
-#define AO_LISP_BIGINT         10
-#define AO_LISP_FLOAT          11
-#define AO_LISP_NUM_TYPE       12
+#define AO_LISP_FRAME_VALS     7
+#define AO_LISP_LAMBDA         8
+#define AO_LISP_STACK          9
+#define AO_LISP_BOOL           10
+#define AO_LISP_BIGINT         11
+#define AO_LISP_FLOAT          12
+#define AO_LISP_NUM_TYPE       13
 
 /* Leave two bits for types to use as they please */
 #define AO_LISP_OTHER_TYPE_MASK        0x3f
@@ -154,11 +155,17 @@ struct ao_lisp_val {
        ao_poly         val;
 };
 
+struct ao_lisp_frame_vals {
+       uint8_t                 type;
+       uint8_t                 size;
+       struct ao_lisp_val      vals[];
+};
+
 struct ao_lisp_frame {
        uint8_t                 type;
        uint8_t                 num;
        ao_poly                 prev;
-       struct ao_lisp_val      vals[];
+       ao_poly                 vals;
 };
 
 struct ao_lisp_bool {
@@ -221,6 +228,16 @@ ao_lisp_frame_poly(struct ao_lisp_frame *frame) {
        return ao_lisp_poly(frame, AO_LISP_OTHER);
 }
 
+static inline struct ao_lisp_frame_vals *
+ao_lisp_poly_frame_vals(ao_poly poly) {
+       return ao_lisp_ref(poly);
+}
+
+static inline ao_poly
+ao_lisp_frame_vals_poly(struct ao_lisp_frame_vals *vals) {
+       return ao_lisp_poly(vals, AO_LISP_OTHER);
+}
+
 enum eval_state {
        eval_sexpr,             /* Evaluate an sexpr */
        eval_val,               /* Value computed */
@@ -528,6 +545,12 @@ ao_lisp_stack_fetch(int id) {
        return ao_lisp_poly_stack(ao_lisp_poly_fetch(id));
 }
 
+void
+ao_lisp_frame_stash(int id, struct ao_lisp_frame *frame);
+
+struct ao_lisp_frame *
+ao_lisp_frame_fetch(int id);
+
 /* bool */
 
 extern const struct ao_lisp_type ao_lisp_bool_type;
@@ -713,6 +736,7 @@ ao_lisp_read_eval_print(void);
 
 /* frame */
 extern const struct ao_lisp_type ao_lisp_frame_type;
+extern const struct ao_lisp_type ao_lisp_frame_vals_type;
 
 #define AO_LISP_FRAME_FREE     6
 

diff --git a/src/lisp/ao_lisp_error.c b/src/lisp/ao_lisp_error.c
index d1c9b941b945d779f3d2ad87f3f57345cf33db57..ba13583433af303e5321870b42686b534cca8945 100644 (file)
--- a/src/lisp/ao_lisp_error.c
+++ b/src/lisp/ao_lisp_error.c
@@ -57,6 +57,7 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame)
        tabs(indent);
        printf ("%s{", name);
        if (frame) {
+               struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
                if (frame->type & AO_LISP_FRAME_PRINT)
                        printf("recurse...");
                else {
@@ -66,9 +67,9 @@ ao_lisp_error_frame(int indent, char *name, struct ao_lisp_frame *frame)
                                        tabs(indent);
                                        printf("         ");
                                }
-                               ao_lisp_poly_write(frame->vals[f].atom);
+                               ao_lisp_poly_write(vals->vals[f].atom);
                                printf(" = ");
-                               ao_lisp_poly_write(frame->vals[f].val);
+                               ao_lisp_poly_write(vals->vals[f].val);
                                printf("\n");
                        }
                        if (frame->prev)

diff --git a/src/lisp/ao_lisp_frame.c b/src/lisp/ao_lisp_frame.c
index ebdb7757382f145ca798e2fc91d56b6386c3d1c9..dd29e0799d742f520c633c63d955dc78eab1e596 100644 (file)
--- a/src/lisp/ao_lisp_frame.c
+++ b/src/lisp/ao_lisp_frame.c
@@ -15,37 +15,77 @@
 #include "ao_lisp.h"
 
 static inline int
-frame_num_size(int num)
+frame_vals_num_size(int num)
 {
-       return sizeof (struct ao_lisp_frame) + num * sizeof (struct ao_lisp_val);
+       return sizeof (struct ao_lisp_frame_vals) + num * sizeof (struct ao_lisp_val);
 }
 
+static int
+frame_vals_size(void *addr)
+{
+       struct ao_lisp_frame_vals       *vals = addr;
+       return frame_vals_num_size(vals->size);
+}
+
+static void
+frame_vals_mark(void *addr)
+{
+       struct ao_lisp_frame_vals       *vals = addr;
+       int                             f;
+
+       for (f = 0; f < vals->size; f++) {
+               struct ao_lisp_val      *v = &vals->vals[f];
+
+               ao_lisp_poly_mark(v->val, 0);
+               MDBG_MOVE("frame mark atom %s %d val %d at %d\n",
+                         ao_lisp_poly_atom(v->atom)->name,
+                         MDBG_OFFSET(ao_lisp_ref(v->atom)),
+                         MDBG_OFFSET(ao_lisp_ref(v->val)), f);
+       }
+}
+
+static void
+frame_vals_move(void *addr)
+{
+       struct ao_lisp_frame_vals       *vals = addr;
+       int                             f;
+
+       for (f = 0; f < vals->size; f++) {
+               struct ao_lisp_val      *v = &vals->vals[f];
+
+               ao_lisp_poly_move(&v->atom, 0);
+               ao_lisp_poly_move(&v->val, 0);
+               MDBG_MOVE("frame move atom %s %d val %d at %d\n",
+                         ao_lisp_poly_atom(v->atom)->name,
+                         MDBG_OFFSET(ao_lisp_ref(v->atom)),
+                         MDBG_OFFSET(ao_lisp_ref(v->val)), f);
+       }
+}
+
+const struct ao_lisp_type ao_lisp_frame_vals_type = {
+       .mark = frame_vals_mark,
+       .size = frame_vals_size,
+       .move = frame_vals_move,
+       .name = "frame_vals"
+};
+
 static int
 frame_size(void *addr)
 {
-       struct ao_lisp_frame    *frame = addr;
-       return frame_num_size(frame->num);
+       (void) addr;
+       return sizeof (struct ao_lisp_frame);
 }
 
 static void
 frame_mark(void *addr)
 {
        struct ao_lisp_frame    *frame = addr;
-       int                     f;
 
        for (;;) {
                MDBG_MOVE("frame mark %d\n", MDBG_OFFSET(frame));
                if (!AO_LISP_IS_POOL(frame))
                        break;
-               for (f = 0; f < frame->num; f++) {
-                       struct ao_lisp_val      *v = &frame->vals[f];
-
-                       ao_lisp_poly_mark(v->val, 0);
-                       MDBG_MOVE("frame mark atom %s %d val %d at %d\n",
-                                 ao_lisp_poly_atom(v->atom)->name,
-                                 MDBG_OFFSET(ao_lisp_ref(v->atom)),
-                                 MDBG_OFFSET(ao_lisp_ref(v->val)), f);
-               }
+               ao_lisp_poly_mark(frame->vals, 0);
                frame = ao_lisp_poly_frame(frame->prev);
                MDBG_MOVE("frame next %d\n", MDBG_OFFSET(frame));
                if (!frame)
@@ -59,7 +99,6 @@ static void
 frame_move(void *addr)
 {
        struct ao_lisp_frame    *frame = addr;
-       int                     f;
 
        for (;;) {
                struct ao_lisp_frame    *prev;
@@ -68,16 +107,7 @@ frame_move(void *addr)
                MDBG_MOVE("frame move %d\n", MDBG_OFFSET(frame));
                if (!AO_LISP_IS_POOL(frame))
                        break;
-               for (f = 0; f < frame->num; f++) {
-                       struct ao_lisp_val      *v = &frame->vals[f];
-
-                       ao_lisp_poly_move(&v->atom, 0);
-                       ao_lisp_poly_move(&v->val, 0);
-                       MDBG_MOVE("frame move atom %s %d val %d at %d\n",
-                                 ao_lisp_poly_atom(v->atom)->name,
-                                 MDBG_OFFSET(ao_lisp_ref(v->atom)),
-                                 MDBG_OFFSET(ao_lisp_ref(v->val)), f);
-               }
+               ao_lisp_poly_move(&frame->vals, 0);
                prev = ao_lisp_poly_frame(frame->prev);
                if (!prev)
                        break;
@@ -104,8 +134,9 @@ const struct ao_lisp_type ao_lisp_frame_type = {
 void
 ao_lisp_frame_write(ao_poly p)
 {
-       struct ao_lisp_frame    *frame = ao_lisp_poly_frame(p);
-       int                     f;
+       struct ao_lisp_frame            *frame = ao_lisp_poly_frame(p);
+       struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
+       int                             f;
 
        printf ("{");
        if (frame) {
@@ -116,9 +147,9 @@ ao_lisp_frame_write(ao_poly p)
                        for (f = 0; f < frame->num; f++) {
                                if (f != 0)
                                        printf(", ");
-                               ao_lisp_poly_write(frame->vals[f].atom);
+                               ao_lisp_poly_write(vals->vals[f].atom);
                                printf(" = ");
-                               ao_lisp_poly_write(frame->vals[f].val);
+                               ao_lisp_poly_write(vals->vals[f].val);
                        }
                        if (frame->prev)
                                ao_lisp_poly_write(frame->prev);
@@ -131,11 +162,13 @@ ao_lisp_frame_write(ao_poly p)
 static int
 ao_lisp_frame_find(struct ao_lisp_frame *frame, int top, ao_poly atom)
 {
-       int l = 0;
-       int r = top - 1;
+       struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
+       int                             l = 0;
+       int                             r = top - 1;
+
        while (l <= r) {
                int m = (l + r) >> 1;
-               if (frame->vals[m].atom < atom)
+               if (vals->vals[m].atom < atom)
                        l = m + 1;
                else
                        r = m - 1;
@@ -146,62 +179,57 @@ ao_lisp_frame_find(struct ao_lisp_frame *frame, int top, ao_poly atom)
 ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom)
 {
-       int l = ao_lisp_frame_find(frame, frame->num, atom);
+       struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
+       int                             l = ao_lisp_frame_find(frame, frame->num, atom);
 
        if (l >= frame->num)
                return NULL;
 
-       if (frame->vals[l].atom != atom)
+       if (vals->vals[l].atom != atom)
                return NULL;
-       return &frame->vals[l].val;
+       return &vals->vals[l].val;
 }
 
-int
-ao_lisp_frame_set(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val)
-{
-       while (frame) {
-               if (!AO_LISP_IS_CONST(frame)) {
-                       ao_poly *ref = ao_lisp_frame_ref(frame, atom);
-                       if (ref) {
-                               *ref = val;
-                               return 1;
-                       }
-               }
-               frame = ao_lisp_poly_frame(frame->prev);
-       }
-       return 0;
-}
+struct ao_lisp_frame   *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
 
-ao_poly
-ao_lisp_frame_get(struct ao_lisp_frame *frame, ao_poly atom)
+static struct ao_lisp_frame_vals *
+ao_lisp_frame_vals_new(int num)
 {
-       while (frame) {
-               ao_poly *ref = ao_lisp_frame_ref(frame, atom);
-               if (ref)
-                       return *ref;
-               frame = ao_lisp_poly_frame(frame->prev);
-       }
-       return AO_LISP_NIL;
-}
+       struct ao_lisp_frame_vals       *vals;
 
-struct ao_lisp_frame   *ao_lisp_frame_free_list[AO_LISP_FRAME_FREE];
+       vals = ao_lisp_alloc(frame_vals_num_size(num));
+       if (!vals)
+               return NULL;
+       vals->type = AO_LISP_FRAME_VALS;
+       vals->size = num;
+       return vals;
+}
 
 struct ao_lisp_frame *
 ao_lisp_frame_new(int num)
 {
-       struct ao_lisp_frame    *frame;
+       struct ao_lisp_frame            *frame;
+       struct ao_lisp_frame_vals       *vals;
 
-       if (num < AO_LISP_FRAME_FREE && (frame = ao_lisp_frame_free_list[num]))
+       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));
+               vals = ao_lisp_poly_frame_vals(frame->vals);
+       } else {
+               frame = ao_lisp_alloc(sizeof (struct ao_lisp_frame));
                if (!frame)
                        return NULL;
+               frame->type = AO_LISP_FRAME;
+               frame->num = 0;
+               frame->prev = AO_LISP_NIL;
+               frame->vals = AO_LISP_NIL;
+               ao_lisp_poly_stash(0, ao_lisp_frame_poly(frame));
+               vals = ao_lisp_frame_vals_new(num);
+               frame = ao_lisp_poly_frame(ao_lisp_poly_fetch(0));
+               frame->vals = ao_lisp_frame_vals_poly(vals);
        }
-       frame->type = AO_LISP_FRAME;
        frame->num = num;
        frame->prev = AO_LISP_NIL;
-       memset(frame->vals, '\0', num * sizeof (struct ao_lisp_val));
+       memset(vals, '\0', vals->size * sizeof (struct ao_lisp_val));
        return frame;
 }
 
@@ -227,47 +255,46 @@ ao_lisp_frame_free(struct ao_lisp_frame *frame)
 }
 
 static struct ao_lisp_frame *
-ao_lisp_frame_realloc(struct ao_lisp_frame **frame_ref, int new_num)
+ao_lisp_frame_realloc(struct ao_lisp_frame *frame, int new_num)
 {
-       struct ao_lisp_frame    *frame = *frame_ref;
-       struct ao_lisp_frame    *new;
-       int                     copy;
+       struct ao_lisp_frame_vals       *vals;
+       struct ao_lisp_frame_vals       *new_vals;
+       int                             copy;
 
        if (new_num == frame->num)
                return frame;
-       new = ao_lisp_frame_new(new_num);
-       if (!new)
+       ao_lisp_frame_stash(0, frame);
+       new_vals = ao_lisp_frame_vals_new(new_num);
+       if (!new_vals)
                return NULL;
-       /*
-        * Re-fetch the frame as it may have moved
-        * during the allocation
-        */
-       frame = *frame_ref;
+       frame = ao_lisp_frame_fetch(0);
+       vals = ao_lisp_poly_frame_vals(frame->vals);
        copy = new_num;
        if (copy > frame->num)
                copy = frame->num;
-       memcpy(new->vals, frame->vals, copy * sizeof (struct ao_lisp_val));
-       new->prev = frame->prev;
-       ao_lisp_frame_free(frame);
-       return new;
+       memcpy(new_vals->vals, vals->vals, copy * sizeof (struct ao_lisp_val));
+       frame->vals = ao_lisp_frame_vals_poly(new_vals);
+       frame->num = new_num;
+       return frame;
 }
 
 void
 ao_lisp_frame_bind(struct ao_lisp_frame *frame, int num, ao_poly atom, ao_poly val)
 {
-       int l = ao_lisp_frame_find(frame, num, atom);
+       struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(frame->vals);
+       int                             l = ao_lisp_frame_find(frame, num, atom);
 
-       memmove(&frame->vals[l+1],
-               &frame->vals[l],
+       memmove(&vals->vals[l+1],
+               &vals->vals[l],
                (num - l) * sizeof (struct ao_lisp_val));
-       frame->vals[l].atom = atom;
-       frame->vals[l].val = val;
+       vals->vals[l].atom = atom;
+       vals->vals[l].val = val;
 }
 
 int
 ao_lisp_frame_add(struct ao_lisp_frame **frame_ref, ao_poly atom, ao_poly val)
 {
-       struct ao_lisp_frame *frame = *frame_ref;
+       struct ao_lisp_frame    *frame = *frame_ref;
        ao_poly *ref = frame ? ao_lisp_frame_ref(frame, atom) : NULL;
 
        if (!ref) {
@@ -276,14 +303,14 @@ ao_lisp_frame_add(struct ao_lisp_frame **frame_ref, ao_poly atom, ao_poly val)
                ao_lisp_poly_stash(1, val);
                if (frame) {
                        f = frame->num;
-                       frame = ao_lisp_frame_realloc(frame_ref, f + 1);
+                       frame = ao_lisp_frame_realloc(frame, f + 1);
                } else {
                        f = 0;
                        frame = ao_lisp_frame_new(1);
+                       *frame_ref = frame;
                }
                if (!frame)
                        return 0;
-               *frame_ref = frame;
                atom = ao_lisp_poly_fetch(0);
                val = ao_lisp_poly_fetch(1);
                ao_lisp_frame_bind(frame, frame->num - 1, atom, val);

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index f23d34db976e9b67d7708b01b5a42c8d2f356947..f9bb5452af477572a298b0294c4cf9b7fbc6ec86 100644 (file)
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -326,10 +326,11 @@ main(int argc, char **argv)
        ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
        for (f = 0; f < ao_lisp_frame_global->num; f++) {
-               val = ao_has_macro(ao_lisp_frame_global->vals[f].val);
+               struct ao_lisp_frame_vals       *vals = ao_lisp_poly_frame_vals(ao_lisp_frame_global->vals);
+               val = ao_has_macro(vals->vals[f].val);
                if (val != AO_LISP_NIL) {
                        printf("error: function %s contains unresolved macro: ",
-                              ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name);
+                              ao_lisp_poly_atom(vals->vals[f].atom)->name);
                        ao_lisp_poly_write(val);
                        printf("\n");
                        exit(1);

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index dc0008c4fba12a33e20c51a910f60388fa0ad27d..890eba1baf1ac44a19b6e13063fcd9c83f6f317e 100644 (file)
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -148,6 +148,7 @@ struct ao_lisp_root {
 
 static struct ao_lisp_cons     *save_cons[2];
 static char                    *save_string[2];
+static struct ao_lisp_frame    *save_frame[1];
 static ao_poly                 save_poly[3];
 
 static const struct ao_lisp_root       ao_lisp_root[] = {
@@ -167,6 +168,10 @@ static const struct ao_lisp_root   ao_lisp_root[] = {
                .type = &ao_lisp_string_type,
                .addr = (void **) &save_string[1],
        },
+       {
+               .type = &ao_lisp_frame_type,
+               .addr = (void **) &save_frame[0],
+       },
        {
                .type = NULL,
                .addr = (void **) (void *) &save_poly[0]
@@ -455,6 +460,7 @@ static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
        [AO_LISP_ATOM] = &ao_lisp_atom_type,
        [AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
        [AO_LISP_FRAME] = &ao_lisp_frame_type,
+       [AO_LISP_FRAME_VALS] = &ao_lisp_frame_vals_type,
        [AO_LISP_LAMBDA] = &ao_lisp_lambda_type,
        [AO_LISP_STACK] = &ao_lisp_stack_type,
        [AO_LISP_BOOL] = &ao_lisp_bool_type,
@@ -620,6 +626,29 @@ ao_lisp_collect(uint8_t style)
  * Mark interfaces for objects
  */
 
+
+/*
+ * Mark a block of memory with an explicit size
+ */
+
+int
+ao_lisp_mark_block(void *addr, int size)
+{
+       int offset;
+       if (!AO_LISP_IS_POOL(addr))
+               return 1;
+
+       offset = pool_offset(addr);
+       MDBG_MOVE("mark memory %d\n", MDBG_OFFSET(addr));
+       if (busy(ao_lisp_busy, offset)) {
+               MDBG_MOVE("already marked\n");
+               return 1;
+       }
+       mark(ao_lisp_busy, offset);
+       note_chunk(offset, size);
+       return 0;
+}
+
 /*
  * Note a reference to memory and collect information about a few
  * object sizes at a time
@@ -891,3 +920,16 @@ ao_lisp_string_fetch(int id)
        return string;
 }
 
+void
+ao_lisp_frame_stash(int id, struct ao_lisp_frame *frame)
+{
+       save_frame[id] = frame;
+}
+
+struct ao_lisp_frame *
+ao_lisp_frame_fetch(int id)
+{
+       struct ao_lisp_frame *frame = save_frame[id];
+       save_frame[id] = NULL;
+       return frame;
+}

diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c
index e93e1192ed1636a53f5fd67bc65aca1d551101ef..d14f41513c1320837c70813b0c043adf3688996a 100644 (file)
--- a/src/lisp/ao_lisp_poly.c
+++ b/src/lisp/ao_lisp_poly.c
@@ -44,6 +44,10 @@ static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = {
                .write = ao_lisp_frame_write,
                .display = ao_lisp_frame_write,
        },
+       [AO_LISP_FRAME_VALS] = {
+               .write = NULL,
+               .display = NULL,
+       },
        [AO_LISP_LAMBDA] = {
                .write = ao_lisp_lambda_write,
                .display = ao_lisp_lambda_write,