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>

7 files changed, 130 insertions, 50 deletions

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index e90d791a..efd13cf5 100644
--- 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 311d63ab..d2b60c9a 100644
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -69,24 +69,42 @@ 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)
 {
 	struct ao_lisp_cons *cons = ao_lisp_poly_cons(c);
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 04d0e70a..5cc1b75a 100644
--- 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 6020a8b8..0dd8c698 100644
--- 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 6a29f402..178b041e 100644
--- 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 08b5bac0..e7ece960 100644
--- 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 030846b7..d5f28e7d 100644
--- 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;