altos/lisp: Separate out values from atoms

This enables changing values of atoms declared as constants, should
enable lets, and with some work, even lexical scoping.

this required changing the constant computation to run
ao_lisp_collect() before dumping the block of constant data, and that
uncovered some minor memory manager bugs.

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

1 files changed, 143 insertions, 25 deletions

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 7295d150..27f5b666 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -17,11 +17,32 @@
 #include "ao_lisp.h"
 #include <stdio.h>
 
-uint8_t	ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
-
 #ifdef AO_LISP_MAKE_CONST
 #include <stdlib.h>
 uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));
+#define ao_lisp_pool ao_lisp_const
+#undef AO_LISP_POOL
+#define AO_LISP_POOL AO_LISP_POOL_CONST
+#else
+uint8_t	ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
+#endif
+
+#if 0
+#define DBG_DUMP
+#define DBG_OFFSET(a)	((int) ((uint8_t *) (a) - ao_lisp_pool))
+#define DBG(...) printf(__VA_ARGS__)
+static int move_dump;
+static int move_depth;
+#define DBG_RESET() (move_depth = 0)
+#define DBG_MOVE(...) do { if(move_dump) { int d; for (d = 0; d < move_depth; d++) printf ("  "); printf(__VA_ARGS__); } } while (0)
+#define DBG_MOVE_IN()	(move_depth++)
+#define DBG_MOVE_OUT()	(move_depth--)
+#else
+#define DBG(...)
+#define DBG_RESET()
+#define DBG_MOVE(...)
+#define DBG_MOVE_IN()
+#define DBG_MOVE_OUT()
 #endif
 
 uint8_t	ao_lisp_exception;
@@ -112,6 +133,23 @@ clear_object(uint8_t *tag, void *addr, int size) {
 	return 0;
 }
 
+static int
+busy_object(uint8_t *tag, void *addr) {
+	int	base;
+
+	if (!addr)
+		return 1;
+
+	if ((uint8_t *) addr < ao_lisp_pool || ao_lisp_pool + AO_LISP_POOL <= (uint8_t*) addr)
+		return 1;
+
+	base = (uint8_t *) addr - ao_lisp_pool;
+	base = limit(base);
+	if (busy(tag, base))
+		return 1;
+	return 0;
+}
+
 static void	*move_old, *move_new;
 static int	move_size;
 
@@ -120,53 +158,96 @@ move_object(void)
 {
 	int	i;
 
+	DBG_RESET();
+	DBG_MOVE("move %d -> %d\n", DBG_OFFSET(move_old), DBG_OFFSET(move_new));
+	DBG_MOVE_IN();
 	memset(ao_lisp_moving, '\0', sizeof (ao_lisp_moving));
 	for (i = 0; i < AO_LISP_ROOT; i++)
-		if (ao_lisp_root[i].addr) {
+		if (ao_lisp_root[i].addr && *ao_lisp_root[i].addr) {
 			void *new;
+			DBG_MOVE("root %d\n", DBG_OFFSET(*ao_lisp_root[i].addr));
 			new = ao_lisp_move(ao_lisp_root[i].type, *ao_lisp_root[i].addr);
 			if (new)
 				*ao_lisp_root[i].addr = new;
 		}
+	DBG_MOVE_OUT();
+	DBG_MOVE("move done\n");
 }
 
+#ifdef DBG_DUMP
 static void
-collect(void)
+dump_busy(void)
+{
+	int	i;
+	printf("busy:");
+	for (i = 0; i < ao_lisp_top; i += 4) {
+		if ((i & 0xff) == 0)
+			printf("\n");
+		else if ((i & 0x1f) == 0)
+			printf(" ");
+		if (busy(ao_lisp_busy, i))
+			putchar('*');
+		else
+			putchar('-');
+	}
+	printf ("\n");
+}
+#define DUMP_BUSY()	dump_busy()
+#else
+#define DUMP_BUSY()
+#endif
+
+void
+ao_lisp_collect(void)
 {
 	int	i;
+	int	top;
 
 	/* Mark */
 	memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
+	DBG("mark\n");
 	for (i = 0; i < AO_LISP_ROOT; i++)
-		if (ao_lisp_root[i].addr)
+		if (ao_lisp_root[i].addr && *ao_lisp_root[i].addr) {
+			DBG("root %p\n", *ao_lisp_root[i].addr);
 			ao_lisp_mark(ao_lisp_root[i].type, *ao_lisp_root[i].addr);
+		}
 
+	DUMP_BUSY();
 	/* Compact */
-	ao_lisp_top = 0;
-	for (i = 0; i < AO_LISP_POOL; i += 4) {
+	DBG("find first busy\n");
+	for (i = 0; i < ao_lisp_top; i += 4) {
 		if (!busy(ao_lisp_busy, i))
 			break;
 	}
-	ao_lisp_top = i;
-	while(i < AO_LISP_POOL) {
+	top = i;
+	while(i < ao_lisp_top) {
 		if (busy(ao_lisp_busy, i)) {
+			DBG("busy %d -> %d\n", i, top);
 			move_old = &ao_lisp_pool[i];
-			move_new = &ao_lisp_pool[ao_lisp_top];
+			move_new = &ao_lisp_pool[top];
 			move_size = 0;
 			move_object();
+			DBG("\tbusy size %d\n", move_size);
+			if (move_size == 0)
+				abort();
 			clear_object(ao_lisp_busy, move_old, move_size);
+			mark_object(ao_lisp_busy, move_new, move_size);
 			i += move_size;
-			ao_lisp_top += move_size;
+			top += move_size;
+			DUMP_BUSY();
 		} else {
 			i += 4;
 		}
 	}
+	ao_lisp_top = top;
 }
 
 
 void
 ao_lisp_mark(const struct ao_lisp_type *type, void *addr)
 {
+	if (!addr)
+		return;
 	if (mark_object(ao_lisp_busy, addr, type->size(addr)))
 		return;
 	type->mark(addr);
@@ -178,12 +259,32 @@ ao_lisp_mark_memory(void *addr, int size)
 	return mark_object(ao_lisp_busy, addr, size);
 }
 
+/*
+ * After the object has been moved, we have to reference it
+ * in the new location. This is only relevant for ao_lisp_poly_move
+ * as it needs to fetch the type byte from the object, which
+ * may have been overwritten by the copy
+ */
+void *
+ao_lisp_move_map(void *addr)
+{
+	if (addr == move_old) {
+		if (busy_object(ao_lisp_moving, addr))
+			return move_new;
+	}
+	return addr;
+}
+
 static void *
 check_move(void *addr, int size)
 {
 	if (addr == move_old) {
-		memmove(move_new, move_old, size);
-		move_size = (size + 3) & ~3;
+		DBG_MOVE("mapping %d -> %d\n", DBG_OFFSET(addr), DBG_OFFSET(move_new));
+		if (!busy_object(ao_lisp_moving, addr)) {
+			DBG_MOVE("  copy %d\n", size);
+			memmove(move_new, move_old, size);
+			move_size = (size + 3) & ~3;
+		}
 		addr = move_new;
 	}
 	return addr;
@@ -192,15 +293,32 @@ check_move(void *addr, int size)
 void *
 ao_lisp_move(const struct ao_lisp_type *type, void *addr)
 {
+	uint8_t *a = addr;
 	int	size = type->size(addr);
 
 	if (!addr)
 		return NULL;
 
+#ifndef AO_LISP_MAKE_CONST
+	if (AO_LISP_IS_CONST(addr))
+		return addr;
+#endif
+	DBG_MOVE("object %d\n", DBG_OFFSET(addr));
+	if (a < ao_lisp_pool || ao_lisp_pool + AO_LISP_POOL <= a)
+		abort();
+	DBG_MOVE_IN();
 	addr = check_move(addr, size);
-	if (mark_object(ao_lisp_moving, addr, size))
+	if (mark_object(ao_lisp_moving, addr, size)) {
+		DBG_MOVE("already moved\n");
+		DBG_MOVE_OUT();
 		return addr;
+	}
+	DBG_MOVE_OUT();
+	DBG_MOVE("recursing...\n");
+	DBG_MOVE_IN();
 	type->move(addr);
+	DBG_MOVE_OUT();
+	DBG_MOVE("done %d\n", DBG_OFFSET(addr));
 	return addr;
 }
 
@@ -210,9 +328,15 @@ ao_lisp_move_memory(void *addr, int size)
 	if (!addr)
 		return NULL;
 
+	DBG_MOVE("memory %d\n", DBG_OFFSET(addr));
+	DBG_MOVE_IN();
 	addr = check_move(addr, size);
-	if (mark_object(ao_lisp_moving, addr, size))
-		return NULL;
+	if (mark_object(ao_lisp_moving, addr, size)) {
+		DBG_MOVE("already moved\n");
+		DBG_MOVE_OUT();
+		return addr;
+	}
+	DBG_MOVE_OUT();
 	return addr;
 }
 
@@ -222,22 +346,14 @@ ao_lisp_alloc(int size)
 	void	*addr;
 
 	size = ao_lisp_mem_round(size);
-#ifdef AO_LISP_MAKE_CONST
-	if (ao_lisp_top + size > AO_LISP_POOL_CONST) {
-		fprintf(stderr, "Too much constant data, increase AO_LISP_POOL_CONST\n");
-		exit(1);
-	}
-	addr = ao_lisp_const + ao_lisp_top;
-#else
 	if (ao_lisp_top + size > AO_LISP_POOL) {
-		collect();
+		ao_lisp_collect();
 		if (ao_lisp_top + size > AO_LISP_POOL) {
 			ao_lisp_exception |= AO_LISP_OOM;
 			return NULL;
 		}
 	}
 	addr = ao_lisp_pool + ao_lisp_top;
-#endif
 	ao_lisp_top += size;
 	return addr;
 }
@@ -246,6 +362,7 @@ int
 ao_lisp_root_add(const struct ao_lisp_type *type, void *addr)
 {
 	int	i;
+	DBG("add root type %p addr %p\n", type, addr);
 	for (i = 0; i < AO_LISP_ROOT; i++) {
 		if (!ao_lisp_root[i].addr) {
 			ao_lisp_root[i].addr = addr;
@@ -253,6 +370,7 @@ ao_lisp_root_add(const struct ao_lisp_type *type, void *addr)
 			return 1;
 		}
 	}
+	abort();
 	return 0;
 }