From: Keith Packard <keithp@keithp.com>
Date: Wed, 16 Nov 2016 04:18:59 +0000 (-0800)
Subject: altos/lisp: re-use small frames
X-Git-Tag: 1.7~159
X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=commitdiff_plain;h=881161fe1c5fb0e2b1220c30572eb2c45bedbafe

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 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)