From dba374516ed396633659dec571b6a44b03da8ad1 Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Fri, 11 Nov 2016 21:16:09 -0800
Subject: altos/lisp: Add save/restore infrastructure. Needs OS support to
 work.

This sticks a few globals past the end of the heap and then asks the
OS to save the heap. On restore, the heap is re-populated by the OS
and then various global variables reset.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/lisp/ao_lisp_save.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 src/lisp/ao_lisp_save.c

(limited to 'src/lisp/ao_lisp_save.c')

diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
new file mode 100644
index 00000000..2b19fdcb
--- /dev/null
+++ b/src/lisp/ao_lisp_save.c
@@ -0,0 +1,57 @@
+/*
+ * Copyright © 2016 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ */
+
+#include <ao_lisp.h>
+
+ao_poly
+ao_lisp_save(struct ao_lisp_cons *cons)
+{
+#ifdef AO_LISP_SAVE
+	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
+
+	ao_lisp_collect();
+	os->ao_lisp_atoms = ao_lisp_atom_poly(ao_lisp_atoms);
+	os->ao_lisp_globals = ao_lisp_frame_poly(ao_lisp_frame_global);
+	if (ao_lisp_os_save())
+		return _ao_lisp_atom_t;
+#endif
+	return AO_LISP_NIL;
+}
+
+ao_poly
+ao_lisp_restore(struct ao_lisp_cons *cons)
+{
+#ifdef AO_LISP_SAVE
+	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
+
+	if (ao_lisp_os_restore()) {
+
+		ao_lisp_atoms = ao_lisp_poly_atom(os->ao_lisp_atoms);
+		ao_lisp_frame_global = ao_lisp_poly_frame(os->ao_lisp_globals);
+
+		/* Clear the eval global variabls */
+		ao_lisp_eval_clear_globals();
+
+		/* Reset the allocator */
+		ao_lisp_top = AO_LISP_POOL;
+		ao_lisp_collect();
+
+		/* Re-create the evaluator stack */
+		if (!ao_lisp_eval_restart())
+			return AO_LISP_NIL;
+		return _ao_lisp_atom_t;
+	}
+#endif
+	return AO_LISP_NIL;
+}
-- 
cgit v1.2.3


From 33aeffc123af1f9063969acf585f1caac885ced4 Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Fri, 11 Nov 2016 23:34:54 -0800
Subject: altos/lisp: Append a CRC to the saved image to validate on restore

The CRC is actually of the ROM bits, so we can tell if the restored
image relates to the currently running code.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/lambdakey-v1.0/ao_lisp_os_save.c | 53 ++++++++++++++++++++++++++++++++++++
 src/lisp/ao_lisp.h                   | 18 ++++++++----
 src/lisp/ao_lisp_make_const.c        | 28 +++++++++++++++++++
 src/lisp/ao_lisp_mem.c               |  2 +-
 src/lisp/ao_lisp_save.c              | 27 +++++++++++++++---
 src/test/ao_lisp_test.c              | 18 ++++++++++++
 src/test/hanoi.lisp                  |  8 ------
 7 files changed, 136 insertions(+), 18 deletions(-)
 create mode 100644 src/lambdakey-v1.0/ao_lisp_os_save.c

(limited to 'src/lisp/ao_lisp_save.c')

diff --git a/src/lambdakey-v1.0/ao_lisp_os_save.c b/src/lambdakey-v1.0/ao_lisp_os_save.c
new file mode 100644
index 00000000..44138398
--- /dev/null
+++ b/src/lambdakey-v1.0/ao_lisp_os_save.c
@@ -0,0 +1,53 @@
+/*
+ * Copyright © 2016 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ */
+
+#include <ao.h>
+#include <ao_lisp.h>
+#include <ao_flash.h>
+
+extern uint8_t	__flash__[];
+
+/* saved variables to rebuild the heap
+
+   ao_lisp_atoms
+   ao_lisp_frame_global
+ */
+
+int
+ao_lisp_os_save(void)
+{
+	int i;
+
+	for (i = 0; i < AO_LISP_POOL_TOTAL; i += 256) {
+		uint32_t	*dst = (uint32_t *) &__flash__[i];
+		uint32_t	*src = (uint32_t *) &ao_lisp_pool[i];
+
+		ao_flash_page(dst, src);
+	}
+	return 1;
+}
+
+int
+ao_lisp_os_restore_save(struct ao_lisp_os_save *save, int offset)
+{
+	memcpy(save, &__flash__[offset], sizeof (struct ao_lisp_os_save));
+	return 1;
+}
+
+int
+ao_lisp_os_restore(void)
+{
+	memcpy(ao_lisp_pool, __flash__, AO_LISP_POOL_TOTAL);
+	return 1;
+}
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 44838a34..ea3d2a09 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -26,15 +26,21 @@ typedef int16_t		ao_signed_poly;
 #ifdef AO_LISP_SAVE
 
 struct ao_lisp_os_save {
-	ao_poly	ao_lisp_atoms;
-	ao_poly	ao_lisp_globals;
+	ao_poly		atoms;
+	ao_poly		globals;
+	uint16_t	const_checksum;
+	uint16_t	const_checksum_inv;
 };
 
-#define AO_LISP_POOL	(AO_LISP_POOL_TOTAL - sizeof (struct ao_lisp_os_save))
+#define AO_LISP_POOL_EXTRA	(sizeof(struct ao_lisp_os_save))
+#define AO_LISP_POOL	((int) (AO_LISP_POOL_TOTAL - AO_LISP_POOL_EXTRA))
 
 int
 ao_lisp_os_save(void);
 
+int
+ao_lisp_os_restore_save(struct ao_lisp_os_save *save, int offset);
+
 int
 ao_lisp_os_restore(void);
 
@@ -67,12 +73,14 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
 #define _ao_lisp_atom_eval	_atom("eval")
 #define _ao_lisp_atom_read	_atom("read")
 #define _ao_lisp_atom_eof	_atom("eof")
+#define _ao_lisp_atom_save	_atom("save")
+#define _ao_lisp_atom_restore	_atom("restore")
 #else
 #include "ao_lisp_const.h"
 #ifndef AO_LISP_POOL
-#define AO_LISP_POOL	16384
+#define AO_LISP_POOL	3072
 #endif
-extern uint8_t		ao_lisp_pool[AO_LISP_POOL];
+extern uint8_t		ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA];
 #endif
 
 /* Primitive types */
diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 0a8c9d07..6a29f402 100644
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -86,6 +86,33 @@ is_atom(int offset)
 	return 0;
 }
 
+#define AO_FEC_CRC_INIT	0xffff
+
+static inline uint16_t
+ao_fec_crc_byte(uint8_t byte, uint16_t crc)
+{
+	uint8_t	bit;
+
+	for (bit = 0; bit < 8; bit++) {
+		if (((crc & 0x8000) >> 8) ^ (byte & 0x80))
+			crc = (crc << 1) ^ 0x8005;
+		else
+			crc = (crc << 1);
+		byte <<= 1;
+	}
+	return crc;
+}
+
+uint16_t
+ao_fec_crc(const uint8_t *bytes, uint8_t len)
+{
+	uint16_t	crc = AO_FEC_CRC_INIT;
+
+	while (len--)
+		crc = ao_fec_crc_byte(*bytes++, crc);
+	return crc;
+}
+
 int
 main(int argc, char **argv)
 {
@@ -126,6 +153,7 @@ main(int argc, char **argv)
 	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));
 	printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
+	printf("#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
 
 	for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
 		char	*n = a->name, c;
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 31ee9e1e..0373f015 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -24,7 +24,7 @@ uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));
 #undef AO_LISP_POOL
 #define AO_LISP_POOL AO_LISP_POOL_CONST
 #else
-uint8_t	ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
+uint8_t	ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4)));
 #endif
 
 #if 0
diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index 2b19fdcb..030846b7 100644
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -17,12 +17,18 @@
 ao_poly
 ao_lisp_save(struct ao_lisp_cons *cons)
 {
+	if (!ao_lisp_check_argc(_ao_lisp_atom_save, cons, 0, 0))
+		return AO_LISP_NIL;
+
 #ifdef AO_LISP_SAVE
 	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
 
 	ao_lisp_collect();
-	os->ao_lisp_atoms = ao_lisp_atom_poly(ao_lisp_atoms);
-	os->ao_lisp_globals = ao_lisp_frame_poly(ao_lisp_frame_global);
+	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;
+
 	if (ao_lisp_os_save())
 		return _ao_lisp_atom_t;
 #endif
@@ -32,13 +38,26 @@ ao_lisp_save(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_restore(struct ao_lisp_cons *cons)
 {
+	if (!ao_lisp_check_argc(_ao_lisp_atom_save, cons, 0, 0))
+		return AO_LISP_NIL;
+
 #ifdef AO_LISP_SAVE
+	struct ao_lisp_os_save save;
 	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
 
+	if (!ao_lisp_os_restore_save(&save, AO_LISP_POOL))
+		return ao_lisp_error(AO_LISP_INVALID, "header restore failed");
+
+	if (save.const_checksum != ao_lisp_const_checksum ||
+	    save.const_checksum_inv != (uint16_t) ~ao_lisp_const_checksum)
+	{
+		return ao_lisp_error(AO_LISP_INVALID, "image is corrupted or stale");
+	}
+
 	if (ao_lisp_os_restore()) {
 
-		ao_lisp_atoms = ao_lisp_poly_atom(os->ao_lisp_atoms);
-		ao_lisp_frame_global = ao_lisp_poly_frame(os->ao_lisp_globals);
+		ao_lisp_atoms = ao_lisp_poly_atom(os->atoms);
+		ao_lisp_frame_global = ao_lisp_poly_frame(os->globals);
 
 		/* Clear the eval global variabls */
 		ao_lisp_eval_clear_globals();
diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index 41dae07a..648d1abe 100644
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -34,6 +34,24 @@ ao_lisp_os_save(void)
 	return 1;
 }
 
+int
+ao_lisp_os_restore_save(struct ao_lisp_os_save *save, int offset)
+{
+	FILE	*restore = fopen(save_file, "r");
+	size_t	ret;
+
+	if (!restore) {
+		perror(save_file);
+		return 0;
+	}
+	fseek(restore, offset, SEEK_SET);
+	ret = fread(save, sizeof (struct ao_lisp_os_save), 1, restore);
+	fclose(restore);
+	if (ret != 1)
+		return 0;
+	return 1;
+}
+
 int
 ao_lisp_os_restore(void)
 {
diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp
index 01398d91..2b614829 100644
--- a/src/test/hanoi.lisp
+++ b/src/test/hanoi.lisp
@@ -6,19 +6,11 @@
   (patom "\033[2J" nil)
   )
 
-(defun test ()
-  (clear)
-  (move-to 30 12)
-  (patom "hello, world")
-  (move-to 0 19)
-  )
-
 (setq stack '("*" "**" "***" "****" "*****" "******" "*******"))
 
 (setq stacks nil)
 
 (defun display-string (x y str)
-  (move-to x y)
   (move-to x y)
   (patom str)
   )
-- 
cgit v1.2.3


From 5557f6b87a9b8bc9716de8191f2062a772a6ae6c Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Mon, 14 Nov 2016 21:25:38 -0800
Subject: 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>
---
 src/lisp/ao_lisp.h            | 17 ++++++++++++++
 src/lisp/ao_lisp_cons.c       | 32 +++++++++++++++++++------
 src/lisp/ao_lisp_eval.c       | 33 +++++++++++++++++++++-----
 src/lisp/ao_lisp_lambda.c     |  1 +
 src/lisp/ao_lisp_make_const.c | 54 +++++++++++++++++++++----------------------
 src/lisp/ao_lisp_mem.c        | 41 ++++++++++++++++++++++++--------
 src/lisp/ao_lisp_save.c       |  2 +-
 7 files changed, 130 insertions(+), 50 deletions(-)

(limited to 'src/lisp/ao_lisp_save.c')

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,23 +69,41 @@ 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)
 {
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;
-- 
cgit v1.2.3


From c8f9db184cc929ebde845730a6d4b7864e423a84 Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Wed, 16 Nov 2016 12:34:14 -0800
Subject: altos/lisp: Add incremental collection

Realizing that long-lived objects will eventually float to the bottom
of the heap, I added a simple hack to the collector that 'remembers'
the top of the heap the last time a full collect was run and then runs
incremental collects looking to shift only objects above that
boundary. That doesn't perfectly capture the bounds of transient
objects, but does manage to reduce the amount of time spent not moving
persistent objects each time through the collector.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/lisp/ao_lisp.h            | 10 +++--
 src/lisp/ao_lisp_make_const.c |  4 +-
 src/lisp/ao_lisp_mem.c        | 97 +++++++++++--------------------------------
 src/lisp/ao_lisp_save.c       |  4 +-
 src/test/ao_lisp_test.c       |  7 +++-
 5 files changed, 42 insertions(+), 80 deletions(-)

(limited to 'src/lisp/ao_lisp_save.c')

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index bcb0a17f..e9432913 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -421,7 +421,8 @@ ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 
 /* memory functions */
 
-extern int ao_lisp_collects;
+extern int ao_lisp_collects[2];
+extern int ao_lisp_freed[2];
 
 /* returns 1 if the object was already marked */
 int
@@ -445,8 +446,11 @@ ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref);
 void *
 ao_lisp_alloc(int size);
 
-void
-ao_lisp_collect(void);
+#define AO_LISP_COLLECT_FULL		1
+#define AO_LISP_COLLECT_INCREMENTAL	0
+
+int
+ao_lisp_collect(uint8_t style);
 
 void
 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons);
diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
index 416a95d9..60bb80f0 100644
--- a/src/lisp/ao_lisp_make_const.c
+++ b/src/lisp/ao_lisp_make_const.c
@@ -147,7 +147,7 @@ ao_lisp_macro_pop(void)
 	free(m);
 }
 
-#define DBG_MACRO 1
+#define DBG_MACRO 0
 #if DBG_MACRO
 int macro_scan_depth;
 
@@ -355,7 +355,7 @@ main(int argc, char **argv)
 	}
 
 	/* Reduce to referenced values */
-	ao_lisp_collect();
+	ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
 	for (f = 0; f < ao_lisp_frame_num(ao_lisp_frame_global); f++) {
 		val = ao_has_macro(ao_lisp_frame_global->vals[f].val);
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 7e7464c4..37d0af2b 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -36,10 +36,6 @@ uint8_t	ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4
 
 #endif
 
-#if 0
-#define MDBG_POOL
-#endif
-
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
@@ -436,15 +432,19 @@ 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;
+int ao_lisp_collects[2];
+int ao_lisp_freed[2];
 
-void
-ao_lisp_collect(void)
+int ao_lisp_last_top;
+
+int
+ao_lisp_collect(uint8_t style)
 {
+	int	ret;
 	int	i;
 	int	top;
-#if DBG_MEM
 	int	loops = 0;
+#if DBG_MEM
 	int	marked;
 	int	moved;
 	struct ao_lisp_record	*mark_record = NULL, *move_record = NULL;
@@ -453,15 +453,18 @@ ao_lisp_collect(void)
 	marked = moved = 0;
 #endif
 
-	++ao_lisp_collects;
+	++ao_lisp_collects[style];
 
 	/* Clear references to all caches */
 	for (i = 0; i < (int) AO_LISP_CACHE; i++)
 		*ao_lisp_cache[i] = NULL;
-	chunk_low = 0;
-	top = 0;
+	if (style == AO_LISP_COLLECT_FULL) {
+		chunk_low = top = 0;
+	} else {
+		chunk_low = top = ao_lisp_last_top;
+	}
 	for (;;) {
-		MDBG_DO(loops++);
+		loops++;
 		MDBG_MOVE("move chunks from %d to %d\n", chunk_low, top);
 		/* Find the sizes of the first chunk of objects to move */
 		memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
@@ -542,12 +545,18 @@ ao_lisp_collect(void)
 		if (chunk_last != AO_LISP_NCHUNK)
 			break;
 	}
+	ret = ao_lisp_top - top;
+	ao_lisp_freed[style] += ret;
+
 	ao_lisp_top = top;
+	if (style == AO_LISP_COLLECT_FULL || ao_lisp_last_top == 0)
+		ao_lisp_last_top = top;
 
 	MDBG_DO(memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 		walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref));
 
-//	printf ("collect. top %d loops %d\n", top, loops);
+//	printf ("collect. style %d loops %d freed %d\n", style, loops, ret);
+	return ret;
 }
 
 /*
@@ -737,45 +746,6 @@ ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
 	return ret;
 }
 
-#ifdef MDBG_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
-
 #if DBG_MEM
 void
 ao_lisp_validate(void)
@@ -789,7 +759,6 @@ int dbg_allocs;
 
 #endif
 
-
 void *
 ao_lisp_alloc(int size)
 {
@@ -798,26 +767,10 @@ ao_lisp_alloc(int size)
 	MDBG_DO(++dbg_allocs);
 	MDBG_DO(if (dbg_validate) ao_lisp_validate());
 	size = ao_lisp_size_round(size);
-	if (ao_lisp_top + size > AO_LISP_POOL_CUR) {
-#ifdef MDBG_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 MDBG_POOL
+	if (ao_lisp_top + size > AO_LISP_POOL) {
+		if (!ao_lisp_collect(AO_LISP_COLLECT_INCREMENTAL) &&
+		    !ao_lisp_collect(AO_LISP_COLLECT_FULL))
 		{
-			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_error(AO_LISP_OOM, "out of memory");
 			return NULL;
 		}
diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index d5f28e7d..e6e8b65e 100644
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -23,7 +23,7 @@ ao_lisp_save(struct ao_lisp_cons *cons)
 #ifdef AO_LISP_SAVE
 	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
 
-	ao_lisp_collect();
+	ao_lisp_collect(AO_LISP_COLLECT_FULL);
 	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;
@@ -64,7 +64,7 @@ ao_lisp_restore(struct ao_lisp_cons *cons)
 
 		/* Reset the allocator */
 		ao_lisp_top = AO_LISP_POOL;
-		ao_lisp_collect();
+		ao_lisp_collect(AO_LISP_COLLECT_FULL);
 
 		/* Re-create the evaluator stack */
 		if (!ao_lisp_eval_restart())
diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index bbaa3f9d..720355d2 100644
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -101,5 +101,10 @@ main (int argc, char **argv)
 		ao_lisp_file = NULL;
 	}
 	ao_lisp_read_eval_print();
-	printf ("%d collects\n", ao_lisp_collects);
+	printf ("collects: full: %d incremental %d\n",
+		ao_lisp_collects[AO_LISP_COLLECT_FULL],
+		ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
+	printf ("freed: full %d incremental %d\n",
+		ao_lisp_freed[AO_LISP_COLLECT_FULL],
+		ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL]);
 }
-- 
cgit v1.2.3


From 9c85c9d60334edc2af65a47124873e94e0ff1e9c Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 10 Jan 2017 14:47:03 -0800
Subject: altos/lisp: Add casts to keep the latest GCC from whinging

Something about alignment issues.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/lisp/ao_lisp_mem.c  | 8 ++++----
 src/lisp/ao_lisp_save.c | 4 ++--
 2 files changed, 6 insertions(+), 6 deletions(-)

(limited to 'src/lisp/ao_lisp_save.c')

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 5bf6e1e4..d067ea07 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -169,15 +169,15 @@ static const struct ao_lisp_root	ao_lisp_root[] = {
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &save_poly[0]
+		.addr = (void **) (void *) &save_poly[0]
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &save_poly[1]
+		.addr = (void **) (void *) &save_poly[1]
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &save_poly[2]
+		.addr = (void **) (void *) &save_poly[2]
 	},
 	{
 		.type = &ao_lisp_atom_type,
@@ -197,7 +197,7 @@ static const struct ao_lisp_root	ao_lisp_root[] = {
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &ao_lisp_v,
+		.addr = (void **) (void *) &ao_lisp_v,
 	},
 	{
 		.type = &ao_lisp_cons_type,
diff --git a/src/lisp/ao_lisp_save.c b/src/lisp/ao_lisp_save.c
index e6e8b65e..4f850fb9 100644
--- a/src/lisp/ao_lisp_save.c
+++ b/src/lisp/ao_lisp_save.c
@@ -21,7 +21,7 @@ ao_lisp_save(struct ao_lisp_cons *cons)
 		return AO_LISP_NIL;
 
 #ifdef AO_LISP_SAVE
-	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
+	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) (void *) &ao_lisp_pool[AO_LISP_POOL];
 
 	ao_lisp_collect(AO_LISP_COLLECT_FULL);
 	os->atoms = ao_lisp_atom_poly(ao_lisp_atoms);
@@ -43,7 +43,7 @@ ao_lisp_restore(struct ao_lisp_cons *cons)
 
 #ifdef AO_LISP_SAVE
 	struct ao_lisp_os_save save;
-	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) &ao_lisp_pool[AO_LISP_POOL];
+	struct ao_lisp_os_save *os = (struct ao_lisp_os_save *) (void *) &ao_lisp_pool[AO_LISP_POOL];
 
 	if (!ao_lisp_os_restore_save(&save, AO_LISP_POOL))
 		return ao_lisp_error(AO_LISP_INVALID, "header restore failed");
-- 
cgit v1.2.3