summaryrefslogtreecommitdiff
path: root/src/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/lisp')
-rw-r--r--src/lisp/ao_lisp.h37
-rw-r--r--src/lisp/ao_lisp_atom.c4
-rw-r--r--src/lisp/ao_lisp_error.c6
-rw-r--r--src/lisp/ao_lisp_eval.c6
-rw-r--r--src/lisp/ao_lisp_frame.c91
-rw-r--r--src/lisp/ao_lisp_lambda.c4
-rw-r--r--src/lisp/ao_lisp_mem.c8
7 files changed, 116 insertions, 40 deletions
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 2db4914f..bcb0a17f 100644
--- 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 6705f140..8c9e8ed1 100644
--- 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 cfa78d22..2b15c418 100644
--- 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 3af56796..6f56a120 100644
--- 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 e23a6413..052d27d7 100644
--- 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 0dd8c698..8b761714 100644
--- 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 e7ece960..7e7464c4 100644
--- 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)
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-16 18:38:54 +0000