altos/lisp: Change GC move API

Pass reference to move API so it can change the values in-place, then
let it return '1' when the underlying object has already been moved to
shorten GC times.

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

10 files changed, 464 insertions, 403 deletions

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 9a5cc63e..27174e13 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -46,7 +46,7 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
 #else
 #include "ao_lisp_const.h"
 #ifndef AO_LISP_POOL
-#define AO_LISP_POOL	1024
+#define AO_LISP_POOL	16384
 #endif
 extern uint8_t		ao_lisp_pool[AO_LISP_POOL];
 #endif
@@ -94,6 +94,8 @@ ao_lisp_is_const(ao_poly poly) {
 
 static inline void *
 ao_lisp_ref(ao_poly poly) {
+	if (poly == 0xBEEF)
+		abort();
 	if (poly == AO_LISP_NIL)
 		return NULL;
 	if (poly & AO_LISP_CONST)
@@ -135,8 +137,8 @@ struct ao_lisp_val {
 };
 
 struct ao_lisp_frame {
+	uint8_t			type;
 	uint8_t			num;
-	uint8_t			readonly;
 	ao_poly			next;
 	struct ao_lisp_val	vals[];
 };
@@ -176,6 +178,11 @@ enum ao_lisp_builtin_id {
 	builtin_times,
 	builtin_divide,
 	builtin_mod,
+	builtin_equal,
+	builtin_less,
+	builtin_greater,
+	builtin_less_equal,
+	builtin_greater_equal,
 	builtin_last
 };
 
@@ -281,7 +288,8 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 }
 
 /* memory functions */
-void
+/* returns 1 if the object was already marked */
+int
 ao_lisp_mark(const struct ao_lisp_type *type, void *addr);
 
 /* returns 1 if the object was already marked */
@@ -291,12 +299,13 @@ ao_lisp_mark_memory(void *addr, int size);
 void *
 ao_lisp_move_map(void *addr);
 
-void *
-ao_lisp_move(const struct ao_lisp_type *type, void *addr);
+/* returns 1 if the object was already moved */
+int
+ao_lisp_move(const struct ao_lisp_type *type, void **ref);
 
-/* returns NULL if the object was already moved */
-void *
-ao_lisp_move_memory(void *addr, int size);
+/* returns 1 if the object was already moved */
+int
+ao_lisp_move_memory(void **ref, int size);
 
 void *
 ao_lisp_alloc(int size);
@@ -307,6 +316,9 @@ ao_lisp_collect(void);
 int
 ao_lisp_root_add(const struct ao_lisp_type *type, void *addr);
 
+int
+ao_lisp_root_poly_add(ao_poly *p);
+
 void
 ao_lisp_root_clear(void *addr);
 
@@ -361,13 +373,15 @@ ao_lisp_int_print(ao_poly i);
 ao_poly
 ao_lisp_poly_print(ao_poly p);
 
-void
+int
 ao_lisp_poly_mark(ao_poly p);
 
-ao_poly
-ao_lisp_poly_move(ao_poly p);
+/* returns 1 if the object has already been moved */
+int
+ao_lisp_poly_move(ao_poly *p);
 
 /* eval */
+
 ao_poly
 ao_lisp_eval(ao_poly p);
 
@@ -407,7 +421,7 @@ ao_poly *
 ao_lisp_frame_ref(struct ao_lisp_frame *frame, ao_poly atom);
 
 struct ao_lisp_frame *
-ao_lisp_frame_new(int num, int readonly);
+ao_lisp_frame_new(int num);
 
 struct ao_lisp_frame *
 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 ea04741e..5f1bcda0 100644
--- a/src/lisp/ao_lisp_atom.c
+++ b/src/lisp/ao_lisp_atom.c
@@ -17,12 +17,6 @@
 
 #include "ao_lisp.h"
 
-#if 0
-#define DBG(...)	printf(__VA_ARGS__)
-#else
-#define DBG(...)
-#endif
-
 static int name_size(char *name)
 {
 	return sizeof(struct ao_lisp_atom) + strlen(name) + 1;
@@ -40,38 +34,24 @@ static void atom_mark(void *addr)
 {
 	struct ao_lisp_atom	*atom = addr;
 
-	DBG ("\tatom start %s\n", atom->name);
 	for (;;) {
 		atom = ao_lisp_poly_atom(atom->next);
 		if (!atom)
 			break;
-		DBG("\t\tatom mark %s %d\n", atom->name, (uint8_t *) atom - ao_lisp_const);
 		if (ao_lisp_mark_memory(atom, atom_size(atom)))
 			break;
 	}
-	DBG ("\tatom done\n");
 }
 
 static void atom_move(void *addr)
 {
 	struct ao_lisp_atom	*atom = addr;
 
-	DBG("\tatom move start %s %d next %s %d\n",
-	    atom->name, ((uint8_t *) atom - ao_lisp_const),
-	    atom->next ? ao_lisp_poly_atom(atom->next)->name : "(none)",
-	    atom->next ? ((uint8_t *) ao_lisp_poly_atom(atom->next) - ao_lisp_const) : 0);
 	for (;;) {
-		struct ao_lisp_atom	*next;
-
-		next = ao_lisp_poly_atom(atom->next);
-		next = ao_lisp_move_memory(next, atom_size(next));
-		if (!next)
+		if (ao_lisp_poly_move(&atom->next))
 			break;
-		DBG("\t\tatom move %s %d->%d\n", next->name, ((uint8_t *) ao_lisp_poly_atom(atom->next) - ao_lisp_const), ((uint8_t *) next - ao_lisp_const));
-		atom->next = ao_lisp_atom_poly(next);
-		atom = next;
+		atom = ao_lisp_poly_atom(atom->next);
 	}
-	DBG("\tatom move end\n");
 }
 
 const struct ao_lisp_type ao_lisp_atom_type = {
@@ -116,7 +96,7 @@ static void
 ao_lisp_atom_init(void)
 {
 	if (!ao_lisp_frame_global) {
-		ao_lisp_frame_global = ao_lisp_frame_new(0, 0);
+		ao_lisp_frame_global = ao_lisp_frame_new(0);
 		ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_global);
 		ao_lisp_root_add(&ao_lisp_frame_type, &ao_lisp_frame_current);
 	}
diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index fe729f20..0ad1f464 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -63,6 +63,8 @@ ao_lisp_check_argc(ao_poly name, struct ao_lisp_cons *cons, int min, int max)
 ao_poly
 ao_lisp_arg(struct ao_lisp_cons *cons, int argc)
 {
+	if (!cons)
+		return AO_LISP_NIL;
 	while (argc--) {
 		if (!cons)
 			return AO_LISP_NIL;
@@ -81,8 +83,6 @@ ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type,
 	return _ao_lisp_atom_t;
 }
 
-enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
-
 ao_poly
 ao_lisp_car(struct ao_lisp_cons *cons)
 {
@@ -175,11 +175,12 @@ ao_lisp_print(struct ao_lisp_cons *cons)
 		if (cons)
 			printf(" ");
 	}
+	printf("\n");
 	return val;
 }
 
 ao_poly
-ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
+ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 {
 	ao_poly	ret = AO_LISP_NIL;
 
@@ -198,30 +199,32 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
 			int	c = ao_lisp_poly_int(car);
 
 			switch(op) {
-			case math_plus:
+			case builtin_plus:
 				r += c;
 				break;
-			case math_minus:
+			case builtin_minus:
 				r -= c;
 				break;
-			case math_times:
+			case builtin_times:
 				r *= c;
 				break;
-			case math_divide:
+			case builtin_divide:
 				if (c == 0)
 					return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero");
 				r /= c;
 				break;
-			case math_mod:
+			case builtin_mod:
 				if (c == 0)
 					return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "mod by zero");
 				r %= c;
 				break;
+			default:
+				break;
 			}
 			ret = ao_lisp_int_poly(r);
 		}
 
-		else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == math_plus)
+		else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == builtin_plus)
 			ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
 								     ao_lisp_poly_string(car)));
 		else
@@ -233,31 +236,135 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
 ao_poly
 ao_lisp_plus(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_math(cons, math_plus);
+	return ao_lisp_math(cons, builtin_plus);
 }
 
 ao_poly
 ao_lisp_minus(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_math(cons, math_minus);
+	return ao_lisp_math(cons, builtin_minus);
 }
 
 ao_poly
 ao_lisp_times(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_math(cons, math_times);
+	return ao_lisp_math(cons, builtin_times);
 }
 
 ao_poly
 ao_lisp_divide(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_math(cons, math_divide);
+	return ao_lisp_math(cons, builtin_divide);
 }
 
 ao_poly
 ao_lisp_mod(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_math(cons, math_mod);
+	return ao_lisp_math(cons, builtin_mod);
+}
+
+ao_poly
+ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
+{
+	ao_poly	left;
+
+	if (!cons)
+		return _ao_lisp_atom_t;
+
+	left = cons->car;
+	cons = ao_lisp_poly_cons(cons->cdr);
+	while (cons) {
+		ao_poly	right = cons->car;
+
+		if (op == builtin_equal) {
+			if (left != right)
+				return AO_LISP_NIL;
+		} else {
+			uint8_t	lt = ao_lisp_poly_type(left);
+			uint8_t	rt = ao_lisp_poly_type(right);
+			if (lt == AO_LISP_INT && rt == AO_LISP_INT) {
+				int l = ao_lisp_poly_int(left);
+				int r = ao_lisp_poly_int(right);
+
+				switch (op) {
+				case builtin_less:
+					if (!(l < r))
+						return AO_LISP_NIL;
+					break;
+				case builtin_greater:
+					if (!(l > r))
+						return AO_LISP_NIL;
+					break;
+				case builtin_less_equal:
+					if (!(l <= r))
+						return AO_LISP_NIL;
+					break;
+				case builtin_greater_equal:
+					if (!(l >= r))
+						return AO_LISP_NIL;
+					break;
+				default:
+					break;
+				}
+			} else if (lt == AO_LISP_STRING && rt == AO_LISP_STRING) {
+				int c = strcmp(ao_lisp_poly_string(left),
+					       ao_lisp_poly_string(right));
+				switch (op) {
+				case builtin_less:
+					if (!(c < 0))
+						return AO_LISP_NIL;
+					break;
+				case builtin_greater:
+					if (!(c > 0))
+						return AO_LISP_NIL;
+					break;
+				case builtin_less_equal:
+					if (!(c <= 0))
+						return AO_LISP_NIL;
+					break;
+				case builtin_greater_equal:
+					if (!(c >= 0))
+						return AO_LISP_NIL;
+					break;
+				default:
+					break;
+				}
+			}
+		}
+		left = right;
+		cons = ao_lisp_poly_cons(cons->cdr);
+	}
+	return _ao_lisp_atom_t;
+}
+
+ao_poly
+ao_lisp_equal(struct ao_lisp_cons *cons)
+{
+	return ao_lisp_compare(cons, builtin_equal);
+}
+
+ao_poly
+ao_lisp_less(struct ao_lisp_cons *cons)
+{
+	return ao_lisp_compare(cons, builtin_less);
+}
+
+ao_poly
+ao_lisp_greater(struct ao_lisp_cons *cons)
+{
+	return ao_lisp_compare(cons, builtin_greater);
+}
+
+ao_poly
+ao_lisp_less_equal(struct ao_lisp_cons *cons)
+{
+	return ao_lisp_compare(cons, builtin_less_equal);
+}
+
+ao_poly
+ao_lisp_greater_equal(struct ao_lisp_cons *cons)
+{
+	return ao_lisp_compare(cons, builtin_greater_equal);
 }
 
 ao_lisp_func_t ao_lisp_builtins[] = {
@@ -273,6 +380,11 @@ ao_lisp_func_t ao_lisp_builtins[] = {
 	[builtin_minus] = ao_lisp_minus,
 	[builtin_times] = ao_lisp_times,
 	[builtin_divide] = ao_lisp_divide,
-	[builtin_mod] = ao_lisp_mod
+	[builtin_mod] = ao_lisp_mod,
+	[builtin_equal] = ao_lisp_equal,
+	[builtin_less] = ao_lisp_less,
+	[builtin_greater] = ao_lisp_greater,
+	[builtin_less_equal] = ao_lisp_less_equal,
+	[builtin_greater_equal] = ao_lisp_greater_equal
 };
 
diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c
index f8a34ed4..4929b91c 100644
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -16,21 +16,6 @@
 
 #define OFFSET(a)	((int) ((uint8_t *) (a) - ao_lisp_const))
 
-#if 0
-static int cons_depth;
-#define DBG(...)	do { int d; for (d = 0; d < cons_depth; d++) printf ("  "); printf(__VA_ARGS__); } while(0)
-#define DBG_IN()	(cons_depth++)
-#define DBG_OUT()	(cons_depth--)
-#define DBG_PR(c)	ao_lisp_cons_print(ao_lisp_cons_poly(c))
-#define DBG_PRP(p)	ao_lisp_poly_print(p)
-#else
-#define DBG(...)
-#define DBG_IN()
-#define DBG_OUT()
-#define DBG_PR(c)
-#define DBG_PRP(p)
-#endif
-
 static void cons_mark(void *addr)
 {
 	struct ao_lisp_cons	*cons = addr;
@@ -55,25 +40,15 @@ static void cons_move(void *addr)
 {
 	struct ao_lisp_cons	*cons = addr;
 
-	DBG_IN();
-	DBG("move cons start %d\n", OFFSET(cons));
-	for (;;) {
-		struct ao_lisp_cons	*cdr;
-		ao_poly			car;
+	if (!cons)
+		return;
 
-		car = ao_lisp_poly_move(cons->car);
-		DBG(" moved car %d -> %d\n", OFFSET(ao_lisp_ref(cons->car)), OFFSET(ao_lisp_ref(car)));
-		cons->car = car;
-		cdr = ao_lisp_poly_cons(cons->cdr);
-		cdr = ao_lisp_move_memory(cdr, sizeof (struct ao_lisp_cons));
-		if (!cdr)
+	for (;;) {
+		(void) ao_lisp_poly_move(&cons->car);
+		if (ao_lisp_poly_move(&cons->cdr))
 			break;
-		DBG(" moved cdr %d -> %d\n", OFFSET(ao_lisp_poly_cons(cons->cdr)), OFFSET(cdr));
-		cons->cdr = ao_lisp_cons_poly(cdr);
-		cons = cdr;
+		cons = ao_lisp_poly_cons(cons->cdr);
 	}
-	DBG("move cons end\n");
-	DBG_OUT();
 }
 
 const struct ao_lisp_type ao_lisp_cons_type = {
diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
index 5ee15899..5ca89bd4 100644
--- a/src/lisp/ao_lisp_const.lisp
+++ b/src/lisp/ao_lisp_const.lisp
@@ -1,4 +1,7 @@
 cadr (lambda (l) (car (cdr l)))
+caddr (lambda (l) (car (cdr (cdr l))))
 list (lexpr (l) l)
 1+ (lambda (x) (+ x 1))
 1- (lambda (x) (- x 1))
+last (lambda (x) (cond ((cdr x) (last (cdr x))) ((car x))))
+prog* (lexpr (l) (last l))
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 2b2cfee7..b7e7b972 100644
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -37,8 +37,11 @@ static int stack_depth;
 enum eval_state {
 	eval_sexpr,
 	eval_val,
+	eval_formal,
 	eval_exec,
-	eval_exec_direct
+	eval_exec_direct,
+	eval_cond,
+	eval_cond_test
 };
 
 struct ao_lisp_stack {
@@ -84,20 +87,26 @@ stack_mark(void *addr)
 	}
 }
 
+static const struct ao_lisp_type ao_lisp_stack_type;
+
 static void
 stack_move(void *addr)
 {
 	struct ao_lisp_stack	*stack = addr;
 
-	for (;;) {
-		struct ao_lisp_stack *prev;
-		stack->actuals = ao_lisp_poly_move(stack->actuals);
-		stack->formals = ao_lisp_poly_move(stack->formals);
-		stack->frame = ao_lisp_poly_move(stack->frame);
-		prev = ao_lisp_ref(stack->prev);
-		prev = ao_lisp_move_memory(prev, sizeof (struct ao_lisp_stack));
-		stack->prev = ao_lisp_stack_poly(prev);
-		stack = prev;
+	while (stack) {
+		void	*prev;
+		int	ret;
+		(void) ao_lisp_poly_move(&stack->actuals);
+		(void) ao_lisp_poly_move(&stack->formals);
+		(void) ao_lisp_poly_move(&stack->frame);
+		prev = ao_lisp_poly_stack(stack->prev);
+		ret = ao_lisp_move(&ao_lisp_stack_type, &prev);
+		if (prev != ao_lisp_poly_stack(stack->prev))
+			stack->prev = ao_lisp_stack_poly(prev);
+		if (ret);
+			break;
+		stack = ao_lisp_poly_stack(stack->prev);
 	}
 }
 
@@ -107,17 +116,19 @@ static const struct ao_lisp_type ao_lisp_stack_type = {
 	.move = stack_move
 };
 
-
 static struct ao_lisp_stack	*ao_lisp_stack;
+static ao_poly			ao_lisp_v;
 static uint8_t been_here;
 
 ao_poly
 ao_lisp_set_cond(struct ao_lisp_cons *c)
 {
+	ao_lisp_stack->state = eval_cond;
+	ao_lisp_stack->actuals = ao_lisp_cons_poly(c);
 	return AO_LISP_NIL;
 }
 
-static void
+void
 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 {
 	stack->state = eval_sexpr;
@@ -128,21 +139,21 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack)
 	stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
 }
 
-static struct ao_lisp_stack *
+struct ao_lisp_stack *
 ao_lisp_stack_push(void)
 {
 	struct ao_lisp_stack	*stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
 	if (!stack)
 		return NULL;
 	stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
-	ao_lisp_stack_reset(stack);
 	ao_lisp_stack = stack;
+	ao_lisp_stack_reset(stack);
 	DBGI("stack push\n");
 	DBG_IN();
 	return stack;
 }
 
-static struct ao_lisp_stack *
+struct ao_lisp_stack *
 ao_lisp_stack_pop(void)
 {
 	if (!ao_lisp_stack)
@@ -164,7 +175,6 @@ ao_lisp_stack_clear(void)
 	ao_lisp_frame_current = NULL;
 }
 
-
 static ao_poly
 func_type(ao_poly func)
 {
@@ -196,8 +206,11 @@ func_type(ao_poly func)
 			f++;
 		}
 		return ao_lisp_arg(cons, 0);
-	} else
-		return ao_lisp_error(AO_LISP_INVALID, "not a func");
+	} else {
+		ao_lisp_error(AO_LISP_INVALID, "not a func");
+		abort();
+		return AO_LISP_NIL;
+	}
 }
 
 static int
@@ -236,7 +249,7 @@ ao_lisp_lambda(struct ao_lisp_cons *cons)
 		args_provided = 1;
 	if (args_wanted != args_provided)
 		return ao_lisp_error(AO_LISP_INVALID, "need %d args, not %d", args_wanted, args_provided);
-	next_frame = ao_lisp_frame_new(args_wanted, 0);
+	next_frame = ao_lisp_frame_new(args_wanted);
 	DBGI("new frame %d\n", OFFSET(next_frame));
 	switch (type) {
 	case _ao_lisp_atom_lambda: {
@@ -268,14 +281,16 @@ ao_lisp_lambda(struct ao_lisp_cons *cons)
 }
 
 ao_poly
-ao_lisp_eval(ao_poly v)
+ao_lisp_eval(ao_poly _v)
 {
 	struct ao_lisp_stack	*stack;
 	ao_poly			formal;
 
+	ao_lisp_v = _v;
 	if (!been_here) {
 		been_here = 1;
-		ao_lisp_root_add(&ao_lisp_stack_type, &stack);
+		ao_lisp_root_add(&ao_lisp_stack_type, &ao_lisp_stack);
+		ao_lisp_root_poly_add(&ao_lisp_v);
 	}
 
 	stack = ao_lisp_stack_push();
@@ -285,19 +300,20 @@ ao_lisp_eval(ao_poly v)
 			return AO_LISP_NIL;
 		switch (stack->state) {
 		case eval_sexpr:
-			DBGI("sexpr: "); DBG_POLY(v); DBG("\n");
-			switch (ao_lisp_poly_type(v)) {
+			DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
+			switch (ao_lisp_poly_type(ao_lisp_v)) {
 			case AO_LISP_CONS:
-				if (v == AO_LISP_NIL) {
+				if (ao_lisp_v == AO_LISP_NIL) {
 					stack->state = eval_exec;
 					break;
 				}
-				stack->actuals = v;
+				stack->actuals = ao_lisp_v;
+				stack->state = eval_formal;
 				stack = ao_lisp_stack_push();
-				v = ao_lisp_poly_cons(v)->car;
+				ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
 				break;
 			case AO_LISP_ATOM:
-				v = ao_lisp_atom_get(v);
+				ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
 				/* fall through */
 			case AO_LISP_INT:
 			case AO_LISP_STRING:
@@ -306,15 +322,17 @@ ao_lisp_eval(ao_poly v)
 			}
 			break;
 		case eval_val:
-			DBGI("val: "); DBG_POLY(v); DBG("\n");
+			DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
 			stack = ao_lisp_stack_pop();
 			if (!stack)
-				return v;
+				return ao_lisp_v;
+			DBGI("..state %d\n", stack->state);
+			break;
 
-			stack->state = eval_sexpr;
+		case eval_formal:
 			/* Check what kind of function we've got */
 			if (!stack->formals) {
-				switch (func_type(v)) {
+				switch (func_type(ao_lisp_v)) {
 				case AO_LISP_LAMBDA:
 				case _ao_lisp_atom_lambda:
 				case AO_LISP_LEXPR:
@@ -335,7 +353,7 @@ ao_lisp_eval(ao_poly v)
 					break;
 			}
 
-			formal = ao_lisp_cons_poly(ao_lisp_cons_cons(v, NULL));
+			formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
 			if (!formal) {
 				ao_lisp_stack_clear();
 				return AO_LISP_NIL;
@@ -349,257 +367,78 @@ ao_lisp_eval(ao_poly v)
 
 			DBGI("formals now "); DBG_POLY(stack->formals); DBG("\n");
 
-			v = ao_lisp_poly_cons(stack->actuals)->cdr;
+			ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->cdr;
+
+			stack->state = eval_sexpr;
 
 			break;
 		case eval_exec:
-			v = ao_lisp_poly_cons(stack->formals)->car;
+			if (!stack->formals) {
+				ao_lisp_v = AO_LISP_NIL;
+				stack->state = eval_val;
+				break;
+			}
+			ao_lisp_v = ao_lisp_poly_cons(stack->formals)->car;
 		case eval_exec_direct:
-			DBGI("exec: macro %d ", stack->macro); DBG_POLY(v); DBG(" formals "); DBG_POLY(stack->formals); DBG ("\n");
-			if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
-				struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
+			DBGI("exec: macro %d ", stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(stack->formals); DBG ("\n");
+			if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_BUILTIN) {
+				struct ao_lisp_builtin *b = ao_lisp_poly_builtin(ao_lisp_v);
 				struct ao_lisp_cons	*f = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->formals)->cdr);
 
 				DBGI(".. builtin formals "); DBG_CONS(f); DBG("\n");
-				v = ao_lisp_func(b) (f);
-				DBGI("builtin result:"); DBG_POLY(v); DBG ("\n");
-				if (ao_lisp_exception) {
-					ao_lisp_stack_clear();
-					return AO_LISP_NIL;
-				}
 				if (stack->macro)
 					stack->state = eval_sexpr;
 				else
 					stack->state = eval_val;
 				stack->macro = 0;
+				ao_lisp_v = ao_lisp_func(b) (f);
+				DBGI("builtin result:"); DBG_POLY(ao_lisp_v); DBG ("\n");
+				if (ao_lisp_exception) {
+					ao_lisp_stack_clear();
+					return AO_LISP_NIL;
+				}
 				break;
 			} else {
-				v = ao_lisp_lambda(ao_lisp_poly_cons(stack->formals));
+				ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(stack->formals));
 				ao_lisp_stack_reset(stack);
 			}
 			break;
-		}
-	}
-}
-#if 0
-
-
-	restart:
-		if (cond) {
-			DBGI("cond is now "); DBG_CONS(cond); DBG("\n");
-			if (cond->car == AO_LISP_NIL) {
-				cond = AO_LISP_NIL;
-				v = AO_LISP_NIL;
+		case eval_cond:
+			DBGI("cond: "); DBG_POLY(stack->actuals); DBG("\n");
+			if (!stack->actuals) {
+				ao_lisp_v = AO_LISP_NIL;
+				stack->state = eval_val;
 			} else {
-				if (ao_lisp_poly_type(cond->car) != AO_LISP_CONS) {
-					ao_lisp_error(AO_LISP_INVALID, "malformed cond");
+				ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->car;
+				if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
+					ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
 					goto bail;
 				}
-				v = ao_lisp_poly_cons(cond->car)->car;
+				ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
+				stack->state = eval_cond_test;
+				stack = ao_lisp_stack_push();
+				stack->state = eval_sexpr;
 			}
-		}
-
-		/* Build stack frames for each list */
-		while (ao_lisp_poly_type(v) == AO_LISP_CONS) {
-			if (v == AO_LISP_NIL)
-				break;
-
-			/* Push existing bits on the stack */
-			if (cons++)
-				if (!ao_lisp_stack_push())
-					goto bail;
-
-			actuals = ao_lisp_poly_cons(v);
-			formals = NULL;
-			formals_tail = NULL;
-			save_cond = cond;
-			cond = NULL;
-
-			v = actuals->car;
-
-//			DBG("start: stack"); DBG_CONS(stack); DBG("\n");
-//			DBG("start: actuals"); DBG_CONS(actuals); DBG("\n");
-//			DBG("start: formals"); DBG_CONS(formals); DBG("\n");
-		}
-
-			if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
-				struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
-				switch (b->args) {
-				case AO_LISP_NLAMBDA:
-					formals = actuals;
-					goto eval;
-
-				case AO_LISP_MACRO:
-					v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
-					DBG("macro "); DBG_POLY(ao_lisp_cons_poly(actuals));
-					DBG(" -> "); DBG_POLY(v);
-					DBG("\n");
-					if (ao_lisp_poly_type(v) != AO_LISP_CONS) {
-						ao_lisp_error(AO_LISP_INVALID, "macro didn't return list");
-						goto bail;
-					}
-					/* Reset frame to the new list */
-					actuals = ao_lisp_poly_cons(v);
-					v = actuals->car;
-					goto restart;
-				}
-		/* Evaluate primitive types */
-
-		DBG ("actual: "); DBG_POLY(v); DBG("\n");
-
-		switch (ao_lisp_poly_type(v)) {
-		case AO_LISP_INT:
-		case AO_LISP_STRING:
 			break;
-		case AO_LISP_ATOM:
-			v = ao_lisp_atom_get(v);
-			break;
-		}
-
-		while (cons) {
-			DBG("add formal: "); DBG_POLY(v); DBG("\n");
-
-			/* We've processed the first element of the list, go check
-			 * what kind of function we've got
-			 */
-			if (formals == NULL) {
-				if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
-					struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
-					switch (b->args) {
-					case AO_LISP_NLAMBDA:
-						formals = actuals;
-						goto eval;
-
-					case AO_LISP_MACRO:
-						v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
-						DBG("macro "); DBG_POLY(ao_lisp_cons_poly(actuals));
-						DBG(" -> "); DBG_POLY(v);
-						DBG("\n");
-						if (ao_lisp_poly_type(v) != AO_LISP_CONS) {
-							ao_lisp_error(AO_LISP_INVALID, "macro didn't return list");
-							goto bail;
-						}
-						/* Reset frame to the new list */
-						actuals = ao_lisp_poly_cons(v);
-						v = actuals->car;
-						goto restart;
-					}
+		case eval_cond_test:
+			DBGI("cond_test "); DBG_POLY(ao_lisp_v); DBG("\n");
+			if (ao_lisp_v) {
+				struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->actuals)->car);
+				struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);
+				if (c) {
+					ao_lisp_v = c->car;
+					stack->state = eval_sexpr;
 				} else {
-					switch (func_type(v)) {
-					case _ao_lisp_atom_lambda:
-					case _ao_lisp_atom_lexpr:
-						break;
-					case _ao_lisp_atom_nlambda:
-						formals = actuals;
-						goto eval;
-					case _ao_lisp_atom_macro:
-						break;
-					default:
-						ao_lisp_error(AO_LISP_INVALID, "operator is not a function");
-						goto bail;
-					}
-				}
-			}
-
-			formal = ao_lisp_cons_cons(v, NULL);
-			if (formals_tail)
-				formals_tail->cdr = ao_lisp_cons_poly(formal);
-			else
-				formals = formal;
-			formals_tail = formal;
-			actuals = ao_lisp_poly_cons(actuals->cdr);
-
-			DBG("formals: ");
-			DBG_CONS(formals);
-			DBG("\n");
-			DBG("actuals: ");
-			DBG_CONS(actuals);
-			DBG("\n");
-
-			/* Process all of the arguments */
-			if (actuals) {
-				v = actuals->car;
-				break;
-			}
-
-			v = formals->car;
-
-		eval:
-
-			/* Evaluate the resulting list */
-			if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
-				struct ao_lisp_cons *old_cond = cond;
-				struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
-
-				v = ao_lisp_func(b) (ao_lisp_poly_cons(formals->cdr));
-
-				DBG ("eval: ");
-				DBG_CONS(formals);
-				DBG(" -> ");
-				DBG_POLY(v);
-				DBG ("\n");
-				if (ao_lisp_exception)
-					goto bail;
-
-				if (cond != old_cond) {
-					DBG("cond changed from "); DBG_CONS(old_cond); DBG(" to "); DBG_CONS(cond); DBG("\n");
-					actuals = NULL;
-					formals = 0;
-					formals_tail = 0;
-					save_cons = cons;
-					cons = 0;
-					goto restart;
-				}
-			} else {
-				v = ao_lisp_lambda(formals);
-				if (ao_lisp_exception)
-					goto bail;
-			}
-
-		cond_done:
-			--cons;
-			if (cons) {
-				ao_lisp_stack_pop();
-//				DBG("stack pop: stack"); DBG_CONS(stack); DBG("\n");
-//				DBG("stack pop: actuals"); DBG_CONS(actuals); DBG("\n");
-//				DBG("stack pop: formals"); DBG_CONS(formals); DBG("\n");
-			} else {
-				actuals = 0;
-				formals = 0;
-				formals_tail = 0;
-				ao_lisp_frame_current = 0;
-			}
-			if (next_frame) {
-				ao_lisp_frame_current = next_frame;
-				DBG("next frame %d\n", OFFSET(next_frame));
-				next_frame = 0;
-				goto restart;
-			}
-		}
-		if (cond) {
-			DBG("next cond cons is %d\n", cons);
-			if (v) {
-				v = ao_lisp_poly_cons(cond->car)->cdr;
-				cond = 0;
-				cons = save_cons;
-				if (v != AO_LISP_NIL) {
-					v = ao_lisp_poly_cons(v)->car;
-					DBG("cond complete, sexpr is "); DBG_POLY(v); DBG("\n");
+					stack->state = eval_val;
 				}
-				goto cond_done;
 			} else {
-				cond = ao_lisp_poly_cons(cond->cdr);
-				DBG("next cond is "); DBG_CONS(cond); DBG("\n");
-				goto restart;
+				stack->actuals = ao_lisp_poly_cons(stack->actuals)->cdr;
+				stack->state = eval_cond;
 			}
-		}
-		if (!cons)
 			break;
+		}
 	}
-	DBG("leaving frame at %d\n", OFFSET(ao_lisp_frame_current));
-	return v;
 bail:
 	ao_lisp_stack_clear();
 	return AO_LISP_NIL;
-#endif
-
+}
diff --git a/src/lisp/ao_lisp_frame.c b/src/lisp/ao_lisp_frame.c
index 1853f6d7..8bf98571 100644
--- a/src/lisp/ao_lisp_frame.c
+++ b/src/lisp/ao_lisp_frame.c
@@ -33,7 +33,7 @@ frame_size(void *addr)
 	return frame_num_size(frame->num);
 }
 
-#define OFFSET(a)	((uint8_t *) (ao_lisp_ref(a)) - ao_lisp_const)
+#define OFFSET(a)	((int) ((uint8_t *) (ao_lisp_ref(a)) - ao_lisp_const))
 
 static void
 frame_mark(void *addr)
@@ -42,16 +42,19 @@ frame_mark(void *addr)
 	int			f;
 
 	for (;;) {
-		if (frame->readonly)
+		DBG("frame mark %p\n", 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->atom);
 			ao_lisp_poly_mark(v->val);
-			DBG ("\tframe mark atom %s %d val %d at %d\n", ao_lisp_poly_atom(v->atom)->name, OFFSET(v->atom), OFFSET(v->val), f);
+			DBG ("\tframe mark atom %s %d val %d at %d\n",
+			     ao_lisp_poly_atom(v->atom)->name,
+			     OFFSET(v->atom), OFFSET(v->val), f);
 		}
 		frame = ao_lisp_poly_frame(frame->next);
+		DBG("frame next %p\n", frame);
 		if (!frame)
 			break;
 		if (ao_lisp_mark_memory(frame, frame_size(frame)))
@@ -66,26 +69,19 @@ frame_move(void *addr)
 	int			f;
 
 	for (;;) {
-		struct ao_lisp_frame	*next;
-		if (frame->readonly)
+		DBG("frame move %p\n", frame);
+		if (!AO_LISP_IS_POOL(frame))
 			break;
 		for (f = 0; f < frame->num; f++) {
 			struct ao_lisp_val	*v = &frame->vals[f];
-			ao_poly			t;
-
-			t = ao_lisp_poly_move(v->atom);
-			DBG("\t\tatom %s %d -> %d\n", ao_lisp_poly_atom(t)->name, OFFSET(v->atom), OFFSET(t));
-			v->atom = t;
-			t = ao_lisp_poly_move(v->val);
-			DBG("\t\tval %d -> %d\n", OFFSET(v->val), OFFSET(t));
-			v->val = t;
+
+			ao_lisp_poly_move(&v->atom);
+			DBG("moved atom %s\n", ao_lisp_poly_atom(v->atom)->name);
+			ao_lisp_poly_move(&v->val);
 		}
-		next = ao_lisp_poly_frame(frame->next);
-		if (!next)
+		if (ao_lisp_poly_move(&frame->next))
 			break;
-		next = ao_lisp_move_memory(next, frame_size(next));
-		frame->next = ao_lisp_frame_poly(next);
-		frame = next;
+		frame = ao_lisp_poly_frame(frame->next);
 	}
 }
 
@@ -109,7 +105,7 @@ int
 ao_lisp_frame_set(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val)
 {
 	while (frame) {
-		if (!frame->readonly) {
+		if (!AO_LISP_IS_CONST(frame)) {
 			ao_poly *ref = ao_lisp_frame_ref(frame, atom);
 			if (ref) {
 				*ref = val;
@@ -134,28 +130,28 @@ ao_lisp_frame_get(struct ao_lisp_frame *frame, ao_poly atom)
 }
 
 struct ao_lisp_frame *
-ao_lisp_frame_new(int num, int readonly)
+ao_lisp_frame_new(int num)
 {
 	struct ao_lisp_frame *frame = ao_lisp_alloc(frame_num_size(num));
 
 	if (!frame)
 		return NULL;
+	frame->type = AO_LISP_FRAME;
 	frame->num = num;
-	frame->readonly = readonly;
 	frame->next = AO_LISP_NIL;
 	memset(frame->vals, '\0', num * sizeof (struct ao_lisp_val));
 	return frame;
 }
 
 static struct ao_lisp_frame *
-ao_lisp_frame_realloc(struct ao_lisp_frame *frame, int new_num, int readonly)
+ao_lisp_frame_realloc(struct ao_lisp_frame *frame, int new_num)
 {
 	struct ao_lisp_frame	*new;
 	int			copy;
 
 	if (new_num == frame->num)
 		return frame;
-	new = ao_lisp_frame_new(new_num, readonly);
+	new = ao_lisp_frame_new(new_num);
 	if (!new)
 		return NULL;
 	copy = new_num;
@@ -175,10 +171,10 @@ ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val)
 		int f;
 		if (frame) {
 			f = frame->num;
-			frame = ao_lisp_frame_realloc(frame, f + 1, frame->readonly);
+			frame = ao_lisp_frame_realloc(frame, f + 1);
 		} else {
 			f = 0;
-			frame = ao_lisp_frame_new(1, 0);
+			frame = ao_lisp_frame_new(1);
 		}
 		if (!frame)
 			return NULL;
diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 9c2ea74c..9768dc22 100644
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -45,7 +45,12 @@ struct builtin_func funcs[] = {
 	"-",		AO_LISP_LEXPR,	builtin_minus,
 	"*",		AO_LISP_LEXPR,	builtin_times,
 	"/",		AO_LISP_LEXPR,	builtin_divide,
-	"%",		AO_LISP_LEXPR,	builtin_mod
+	"%",		AO_LISP_LEXPR,	builtin_mod,
+	"=",		AO_LISP_LEXPR,	builtin_equal,
+	"<",		AO_LISP_LEXPR,	builtin_less,
+	">",		AO_LISP_LEXPR,	builtin_greater,
+	"<=",		AO_LISP_LEXPR,	builtin_less_equal,
+	">=",		AO_LISP_LEXPR,	builtin_greater_equal,
 };
 
 ao_poly
@@ -92,7 +97,7 @@ main(int argc, char **argv)
 	printf("/*\n");
 	printf(" * Generated file, do not edit\n");
 	ao_lisp_root_add(&ao_lisp_frame_type, &globals);
-	globals = ao_lisp_frame_new(0, 0);
+	globals = ao_lisp_frame_new(0);
 	for (f = 0; f < N_FUNC; f++) {
 		b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
 		a = ao_lisp_atom_intern(funcs[f].name);
@@ -127,8 +132,6 @@ main(int argc, char **argv)
 	ao_lisp_collect();
 	printf(" */\n");
 
-	globals->readonly = 1;
-
 	printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
 	printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
 	printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 27f5b666..29d8dbf4 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -28,9 +28,18 @@ uint8_t	ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
 #endif
 
 #if 0
+#define DBG_COLLECT_ALWAYS
+#endif
+
+#if 0
+#define DBG_POOL
+#endif
+
+#if 1
 #define DBG_DUMP
 #define DBG_OFFSET(a)	((int) ((uint8_t *) (a) - ao_lisp_pool))
 #define DBG(...) printf(__VA_ARGS__)
+#define DBG_DO(a)	a
 static int move_dump;
 static int move_depth;
 #define DBG_RESET() (move_depth = 0)
@@ -39,6 +48,7 @@ static int move_depth;
 #define DBG_MOVE_OUT()	(move_depth--)
 #else
 #define DBG(...)
+#define DBG_DO(a)
 #define DBG_RESET()
 #define DBG_MOVE(...)
 #define DBG_MOVE_IN()
@@ -162,14 +172,24 @@ move_object(void)
 	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 && *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;
+	for (i = 0; i < AO_LISP_ROOT; i++) {
+		if (!ao_lisp_root[i].addr)
+			continue;
+		if (ao_lisp_root[i].type) {
+			DBG_DO(void *addr = *ao_lisp_root[i].addr);
+			DBG_MOVE("root %d\n", DBG_OFFSET(addr));
+			if (!ao_lisp_move(ao_lisp_root[i].type,
+					  ao_lisp_root[i].addr))
+				DBG_MOVE("root moves from %p to %p\n",
+					 addr,
+					 *ao_lisp_root[i].addr);
+		} else {
+			DBG_DO(ao_poly p = *(ao_poly *) ao_lisp_root[i].addr);
+			if (!ao_lisp_poly_move((ao_poly *) ao_lisp_root[i].addr))
+				DBG_MOVE("root poly move from %04x to %04x\n",
+					 p, *(ao_poly *) ao_lisp_root[i].addr);
 		}
+	}
 	DBG_MOVE_OUT();
 	DBG_MOVE("move done\n");
 }
@@ -197,20 +217,39 @@ dump_busy(void)
 #define DUMP_BUSY()
 #endif
 
+static void
+ao_lisp_mark_busy(void)
+{
+	int i;
+
+	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].type) {
+			void **a = ao_lisp_root[i].addr, *v;
+			if (a && (v = *a)) {
+				DBG("root %p\n", v);
+				ao_lisp_mark(ao_lisp_root[i].type, v);
+			}
+		} else {
+			ao_poly *a = (ao_poly *) ao_lisp_root[i].addr, p;
+			if (a && (p = *a)) {
+				DBG("root %04x\n", p);
+				ao_lisp_poly_mark(p);
+			}
+		}
+	}
+}
+
 void
 ao_lisp_collect(void)
 {
 	int	i;
 	int	top;
 
+	DBG("collect\n");
 	/* 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 && *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);
-		}
+	ao_lisp_mark_busy();
 
 	DUMP_BUSY();
 	/* Compact */
@@ -243,14 +282,15 @@ ao_lisp_collect(void)
 }
 
 
-void
+int
 ao_lisp_mark(const struct ao_lisp_type *type, void *addr)
 {
 	if (!addr)
-		return;
+		return 1;
 	if (mark_object(ao_lisp_busy, addr, type->size(addr)))
-		return;
+		return 1;
 	type->mark(addr);
+	return 0;
 }
 
 int
@@ -290,28 +330,31 @@ check_move(void *addr, int size)
 	return addr;
 }
 
-void *
-ao_lisp_move(const struct ao_lisp_type *type, void *addr)
+int
+ao_lisp_move(const struct ao_lisp_type *type, void **ref)
 {
-	uint8_t *a = addr;
-	int	size = type->size(addr);
+	void		*addr = *ref;
+	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;
+		return 1;
 #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 (addr != *ref)
+		*ref = addr;
 	if (mark_object(ao_lisp_moving, addr, size)) {
 		DBG_MOVE("already moved\n");
 		DBG_MOVE_OUT();
-		return addr;
+		return 1;
 	}
 	DBG_MOVE_OUT();
 	DBG_MOVE("recursing...\n");
@@ -319,35 +362,97 @@ ao_lisp_move(const struct ao_lisp_type *type, void *addr)
 	type->move(addr);
 	DBG_MOVE_OUT();
 	DBG_MOVE("done %d\n", DBG_OFFSET(addr));
-	return addr;
+	return 0;
 }
 
-void *
-ao_lisp_move_memory(void *addr, int size)
+int
+ao_lisp_move_memory(void **ref, int size)
 {
+	void *addr = *ref;
 	if (!addr)
 		return NULL;
 
 	DBG_MOVE("memory %d\n", DBG_OFFSET(addr));
 	DBG_MOVE_IN();
 	addr = check_move(addr, size);
+	if (addr != *ref)
+		*ref = addr;
 	if (mark_object(ao_lisp_moving, addr, size)) {
 		DBG_MOVE("already moved\n");
 		DBG_MOVE_OUT();
-		return addr;
+		return 1;
 	}
 	DBG_MOVE_OUT();
-	return addr;
+	return 0;
+}
+
+#ifdef DBG_POOL
+static int AO_LISP_POOL_CUR = AO_LISP_POOL / 8;
+
+static void
+ao_lisp_poison(void)
+{
+	int	i;
+
+	printf("poison\n");
+	ao_lisp_mark_busy();
+	for (i = 0; i < AO_LISP_POOL_CUR; i += 4) {
+		uint32_t	*a = (uint32_t *) &ao_lisp_pool[i];
+		if (!busy_object(ao_lisp_busy, a))
+			*a = 0xBEEFBEEF;
+	}
+	for (i = 0; i < AO_LISP_POOL_CUR; i += 2) {
+		ao_poly		*a = (uint16_t *) &ao_lisp_pool[i];
+		ao_poly		p = *a;
+
+		if (!ao_lisp_is_const(p)) {
+			void	*r = ao_lisp_ref(p);
+
+			if (ao_lisp_pool <= (uint8_t *) r &&
+			    (uint8_t *) r <= ao_lisp_pool + AO_LISP_POOL_CUR)
+			{
+				if (!busy_object(ao_lisp_busy, r)) {
+					printf("missing reference from %d to %d\n",
+					       (int) ((uint8_t *) a - ao_lisp_pool),
+					       (int) ((uint8_t *) r - ao_lisp_pool));
+				}
+			}
+		}
+	}
 }
 
+#else
+#define AO_LISP_POOL_CUR AO_LISP_POOL
+#endif
+
 void *
 ao_lisp_alloc(int size)
 {
 	void	*addr;
 
 	size = ao_lisp_mem_round(size);
-	if (ao_lisp_top + size > AO_LISP_POOL) {
+#ifdef DBG_COLLECT_ALWAYS
+	ao_lisp_collect();
+#endif
+	if (ao_lisp_top + size > AO_LISP_POOL_CUR) {
+#ifdef DBG_POOL
+		if (AO_LISP_POOL_CUR < AO_LISP_POOL) {
+			AO_LISP_POOL_CUR += AO_LISP_POOL / 8;
+			ao_lisp_poison();
+		} else
+#endif
 		ao_lisp_collect();
+#ifdef DBG_POOL
+		{
+			int	i;
+
+			for (i = ao_lisp_top; i < AO_LISP_POOL; i += 4) {
+				uint32_t	*p = (uint32_t *) &ao_lisp_pool[i];
+				*p = 0xbeefbeef;
+			}
+		}
+#endif
+
 		if (ao_lisp_top + size > AO_LISP_POOL) {
 			ao_lisp_exception |= AO_LISP_OOM;
 			return NULL;
@@ -374,6 +479,12 @@ ao_lisp_root_add(const struct ao_lisp_type *type, void *addr)
 	return 0;
 }
 
+int
+ao_lisp_root_poly_add(ao_poly *p)
+{
+	return ao_lisp_root_add(NULL, p);
+}
+
 void
 ao_lisp_root_clear(void *addr)
 {
diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c
index e9367553..7f02505d 100644
--- a/src/lisp/ao_lisp_prim.c
+++ b/src/lisp/ao_lisp_prim.c
@@ -14,6 +14,12 @@
 
 #include "ao_lisp.h"
 
+#if 0
+#define DBG(...) printf (__VA_ARGS__)
+#else
+#define DBG(...)
+#endif
+
 static void (*const ao_lisp_print_funcs[AO_LISP_NUM_TYPE])(ao_poly) = {
 	[AO_LISP_CONS] = ao_lisp_cons_print,
 	[AO_LISP_STRING] = ao_lisp_string_print,
@@ -33,30 +39,52 @@ ao_lisp_poly_print(ao_poly p)
 
 static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {
 	[AO_LISP_CONS] = &ao_lisp_cons_type,
+	[AO_LISP_INT] = NULL,
 	[AO_LISP_STRING] = &ao_lisp_string_type,
+	[AO_LISP_OTHER] = (void *) 0x1,
 	[AO_LISP_ATOM] = &ao_lisp_atom_type,
 	[AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
+	[AO_LISP_FRAME] = &ao_lisp_frame_type,
 };
 
-void
+int
 ao_lisp_poly_mark(ao_poly p)
 {
 	const struct ao_lisp_type *lisp_type = ao_lisp_types[ao_lisp_poly_type(p)];
 	if (lisp_type)
-		ao_lisp_mark(lisp_type, ao_lisp_ref(p));
+		return ao_lisp_mark(lisp_type, ao_lisp_ref(p));
+	return 1;
 }
 
-ao_poly
-ao_lisp_poly_move(ao_poly p)
+int
+ao_lisp_poly_move(ao_poly *ref)
 {
-	uint8_t				type = p & AO_LISP_TYPE_MASK;
+	uint8_t				type;
+	ao_poly				p = *ref;
 	const struct ao_lisp_type	*lisp_type;
+	int				ret;
+	void				*addr;
+
+	if (!p)
+		return 1;
 
+	type = p & AO_LISP_TYPE_MASK;
 	if (type == AO_LISP_OTHER)
 		type = ao_lisp_other_type(ao_lisp_move_map(ao_lisp_poly_other(p)));
 
+	if (type >= AO_LISP_NUM_TYPE)
+		abort();
+
 	lisp_type = ao_lisp_types[type];
-	if (lisp_type)
-		p = ao_lisp_poly(ao_lisp_move(lisp_type, ao_lisp_ref(p)), p & AO_LISP_TYPE_MASK);
-	return p;
+	if (!lisp_type)
+		return 1;
+	addr = ao_lisp_ref(p);
+	ret = ao_lisp_move(lisp_type, &addr);
+	if (addr != ao_lisp_ref(p)) {
+		ao_poly np = ao_lisp_poly(addr, p & AO_LISP_TYPE_MASK);
+		DBG("poly %d moved %04x -> %04x\n",
+		    type, p, np);
+		*ref = np;
+	}
+	return ret;
 }