From d8c9024f3829dc3f241b16869f165f3ee01764f3 Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 12 Dec 2017 15:25:51 -0800
Subject: altos/scheme: Support scheme subsetting via feature settings

This provides for the creation of smaller versions of the interpreter,
leaving out options like floating point numbers and vectors.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme_make_const.c | 145 +++++++++++++++++++++++++++++++++-----
 1 file changed, 129 insertions(+), 16 deletions(-)

(limited to 'src/scheme/ao_scheme_make_const.c')

diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c
index cf42ec52..6bd552f5 100644
--- a/src/scheme/ao_scheme_make_const.c
+++ b/src/scheme/ao_scheme_make_const.c
@@ -17,6 +17,7 @@
 #include <ctype.h>
 #include <unistd.h>
 #include <getopt.h>
+#include <stdbool.h>
 
 static struct ao_scheme_builtin *
 ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
@@ -29,15 +30,25 @@ ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
 }
 
 struct builtin_func {
+	char	*feature;
 	char	*name;
 	int	args;
 	enum ao_scheme_builtin_id	func;
 };
 
+struct builtin_atom {
+	char	*feature;
+	char	*name;
+};
+
 #define AO_SCHEME_BUILTIN_CONSTS
+#define AO_SCHEME_BUILTIN_ATOM_NAMES
+
 #include "ao_scheme_builtin.h"
 
-#define N_FUNC (sizeof funcs / sizeof funcs[0])
+#define N_FUNC		(sizeof funcs / sizeof funcs[0])
+
+#define N_ATOM		(sizeof atoms / sizeof atoms[0])
 
 struct ao_scheme_frame	*globals;
 
@@ -228,6 +239,36 @@ ao_has_macro(ao_poly p)
 	return p;
 }
 
+static struct ao_scheme_builtin *
+ao_scheme_get_builtin(ao_poly p)
+{
+	if (ao_scheme_poly_type(p) == AO_SCHEME_BUILTIN)
+		return ao_scheme_poly_builtin(p);
+	return NULL;
+}
+
+struct seen_builtin {
+	struct seen_builtin 		*next;
+	struct ao_scheme_builtin	*builtin;
+};
+
+static struct seen_builtin *seen_builtins;
+
+static int
+ao_scheme_seen_builtin(struct ao_scheme_builtin *b)
+{
+	struct seen_builtin	*s;
+
+	for (s = seen_builtins; s; s = s->next)
+		if (s->builtin == b)
+			return 1;
+	s = malloc (sizeof (struct seen_builtin));
+	s->builtin = b;
+	s->next = seen_builtins;
+	seen_builtins = s;
+	return 0;
+}
+
 int
 ao_scheme_read_eval_abort(void)
 {
@@ -248,6 +289,47 @@ ao_scheme_read_eval_abort(void)
 static FILE	*in;
 static FILE	*out;
 
+struct feature {
+	struct feature	*next;
+	char		name[];
+};
+
+static struct feature *enable;
+static struct feature *disable;
+
+void
+ao_scheme_add_feature(struct feature **list, char *name)
+{
+	struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1);
+	strcpy(feature->name, name);
+	feature->next = *list;
+	*list = feature;
+}
+
+bool
+ao_scheme_has_feature(struct feature *list, char *name)
+{
+	while (list) {
+		if (!strcmp(list->name, name))
+			return true;
+		list = list->next;
+	}
+	return false;
+}
+
+void
+ao_scheme_add_features(struct feature **list, char *names)
+{
+	char	*saveptr = NULL;
+	char	*name;
+
+	while ((name = strtok_r(names, ",", &saveptr)) != NULL) {
+		names = NULL;
+		if (!ao_scheme_has_feature(*list, name))
+			ao_scheme_add_feature(list, name);
+	}
+}
+
 int
 ao_scheme_getc(void)
 {
@@ -256,19 +338,21 @@ ao_scheme_getc(void)
 
 static const struct option options[] = {
 	{ .name = "out", .has_arg = 1, .val = 'o' },
+	{ .name = "disable", .has_arg = 1, .val = 'd' },
+	{ .name = "enable", .has_arg = 1, .val = 'e' },
 	{ 0, 0, 0, 0 }
 };
 
 static void usage(char *program)
 {
-	fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
+	fprintf(stderr, "usage: %s [--out=<output>] [--disable={feature,...}] [--enable={feature,...} [input]\n", program);
 	exit(1);
 }
 
 int
 main(int argc, char **argv)
 {
-	int	f, o;
+	int	f, o, an;
 	ao_poly	val;
 	struct ao_scheme_atom	*a;
 	struct ao_scheme_builtin	*b;
@@ -276,15 +360,23 @@ main(int argc, char **argv)
 	char	*out_name = NULL;
 	int	c;
 	enum ao_scheme_builtin_id	prev_func;
+	enum ao_scheme_builtin_id	target_func;
+	enum ao_scheme_builtin_id	func_map[_builtin_last];
 
 	in = stdin;
 	out = stdout;
 
-	while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
+	while ((c = getopt_long(argc, argv, "o:d:e:", options, NULL)) != -1) {
 		switch (c) {
 		case 'o':
 			out_name = optarg;
 			break;
+		case 'd':
+			ao_scheme_add_features(&disable, optarg);
+			break;
+		case 'e':
+			ao_scheme_add_features(&enable, optarg);
+			break;
 		default:
 			usage(argv[0]);
 			break;
@@ -298,21 +390,34 @@ main(int argc, char **argv)
 	ao_scheme_bool_get(1);
 
 	prev_func = _builtin_last;
+	target_func = 0;
 	for (f = 0; f < (int) N_FUNC; f++) {
-		if (funcs[f].func != prev_func)
-			b = ao_scheme_make_builtin(funcs[f].func, funcs[f].args);
-		a = ao_scheme_atom_intern(funcs[f].name);
-		ao_scheme_atom_def(ao_scheme_atom_poly(a),
-				 ao_scheme_builtin_poly(b));
+		if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) {
+			if (funcs[f].func != prev_func) {
+				prev_func = funcs[f].func;
+				b = ao_scheme_make_builtin(prev_func, funcs[f].args);
+
+				/* Target may have only a subset of
+				 * the enum values; record what those
+				 * values will be here. This obviously
+				 * depends on the functions in the
+				 * array being in the same order as
+				 * the enumeration; which
+				 * ao_scheme_make_builtin ensures.
+				 */
+				func_map[prev_func] = target_func++;
+			}
+			a = ao_scheme_atom_intern(funcs[f].name);
+			ao_scheme_atom_def(ao_scheme_atom_poly(a),
+					   ao_scheme_builtin_poly(b));
+		}
 	}
 
-	/* end of file value */
-	a = ao_scheme_atom_intern("eof");
-	ao_scheme_atom_def(ao_scheme_atom_poly(a),
-			 ao_scheme_atom_poly(a));
-
-	/* 'else' */
-	a = ao_scheme_atom_intern("else");
+	/* atoms */
+	for (an = 0; an < (int) N_ATOM; an++) {
+		if (ao_scheme_has_feature(enable, atoms[an].feature) || !ao_scheme_has_feature(disable, atoms[an].feature))
+			a = ao_scheme_atom_intern((char *) atoms[an].name);
+	}
 
 	if (argv[optind]){
 		in = fopen(argv[optind], "r");
@@ -331,6 +436,7 @@ main(int argc, char **argv)
 
 	for (f = 0; f < ao_scheme_frame_global->num; f++) {
 		struct ao_scheme_frame_vals	*vals = ao_scheme_poly_frame_vals(ao_scheme_frame_global->vals);
+
 		val = ao_has_macro(vals->vals[f].val);
 		if (val != AO_SCHEME_NIL) {
 			printf("error: function %s contains unresolved macro: ",
@@ -339,6 +445,13 @@ main(int argc, char **argv)
 			printf("\n");
 			exit(1);
 		}
+
+		/* Remap builtin enum values to match target set */
+		b = ao_scheme_get_builtin(vals->vals[f].val);
+		if (b != NULL) {
+			if (!ao_scheme_seen_builtin(b))
+				b->func = func_map[b->func];
+		}
 	}
 
 	if (out_name) {
-- 
cgit v1.2.3


From 4bfce37e7567d9c2a09ea4da8113e7639516ed6e Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 12 Dec 2017 17:54:03 -0800
Subject: altos/scheme: apply const to places taking const strings.

Mostly printf and friends.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme.h            | 12 +++++-----
 src/scheme/ao_scheme_builtin.c    |  6 ++---
 src/scheme/ao_scheme_error.c      | 10 ++++-----
 src/scheme/ao_scheme_make_builtin |  2 +-
 src/scheme/ao_scheme_make_const.c | 46 +++++++++++++++++++++------------------
 5 files changed, 40 insertions(+), 36 deletions(-)

(limited to 'src/scheme/ao_scheme_make_const.c')

diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index db4417e5..7e4b3697 100644
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -63,7 +63,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)))
 #define ao_scheme_pool ao_scheme_const
 #define AO_SCHEME_POOL AO_SCHEME_POOL_CONST
 
-#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern(n))
+#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern((char *) n))
 #define _bool(v) ao_scheme_bool_poly(ao_scheme_bool_get(v))
 
 #define _ao_scheme_bool_true	_bool(1)
@@ -940,19 +940,19 @@ ao_scheme_stack_eval(void);
 /* error */
 
 void
-ao_scheme_vprintf(char *format, va_list args);
+ao_scheme_vprintf(const char *format, va_list args);
 
 void
-ao_scheme_printf(char *format, ...);
+ao_scheme_printf(const char *format, ...);
 
 void
-ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last);
+ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last);
 
 void
-ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame);
+ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame);
 
 ao_poly
-ao_scheme_error(int error, char *format, ...);
+ao_scheme_error(int error, const char *format, ...);
 
 /* builtins */
 
diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index c0f636fa..4def5704 100644
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -52,7 +52,7 @@ char *ao_scheme_args_name(uint8_t args) {
 	case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name;
 	case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name;
 	case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name;
-	default: return "???";
+	default: return (char *) "???";
 	}
 }
 #else
@@ -64,7 +64,7 @@ static char *
 ao_scheme_builtin_name(enum ao_scheme_builtin_id b) {
 	if (b < _builtin_last)
 		return ao_scheme_poly_atom(builtin_names[b])->name;
-	return "???";
+	return (char *) "???";
 }
 
 static const ao_poly ao_scheme_args_atoms[] = {
@@ -79,7 +79,7 @@ ao_scheme_args_name(uint8_t args)
 	args &= AO_SCHEME_FUNC_MASK;
 	if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0])
 		return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name;
-	return "(unknown)";
+	return (char *) "(unknown)";
 }
 #endif
 
diff --git a/src/scheme/ao_scheme_error.c b/src/scheme/ao_scheme_error.c
index d580a2c0..c015c76a 100644
--- a/src/scheme/ao_scheme_error.c
+++ b/src/scheme/ao_scheme_error.c
@@ -16,7 +16,7 @@
 #include <stdarg.h>
 
 void
-ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last)
+ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last)
 {
 	int first = 1;
 	printf("\t\t%s(", name);
@@ -50,7 +50,7 @@ static void tabs(int indent)
 }
 
 void
-ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame)
+ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame)
 {
 	int			f;
 
@@ -83,7 +83,7 @@ ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame)
 }
 
 void
-ao_scheme_vprintf(char *format, va_list args)
+ao_scheme_vprintf(const char *format, va_list args)
 {
 	char c;
 
@@ -112,7 +112,7 @@ ao_scheme_vprintf(char *format, va_list args)
 }
 
 void
-ao_scheme_printf(char *format, ...)
+ao_scheme_printf(const char *format, ...)
 {
 	va_list args;
 	va_start(args, format);
@@ -121,7 +121,7 @@ ao_scheme_printf(char *format, ...)
 }
 
 ao_poly
-ao_scheme_error(int error, char *format, ...)
+ao_scheme_error(int error, const char *format, ...)
 {
 	va_list	args;
 
diff --git a/src/scheme/ao_scheme_make_builtin b/src/scheme/ao_scheme_make_builtin
index 78f97789..a4d8326f 100644
--- a/src/scheme/ao_scheme_make_builtin
+++ b/src/scheme/ao_scheme_make_builtin
@@ -101,7 +101,7 @@ dump_casename(builtin_t[*] builtins) {
 			       builtins[i].c_name, builtins[i].lisp_names[0]);
 			dump_endif(builtins[i]);
 		}
-	printf("\tdefault: return \"???\";\n");
+	printf("\tdefault: return (char *) \"???\";\n");
 	printf("\t}\n");
 	printf("}\n");
 	printf("#endif /* AO_SCHEME_BUILTIN_CASENAME */\n");
diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c
index 6bd552f5..d0a51ec8 100644
--- a/src/scheme/ao_scheme_make_const.c
+++ b/src/scheme/ao_scheme_make_const.c
@@ -30,15 +30,15 @@ ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
 }
 
 struct builtin_func {
-	char	*feature;
-	char	*name;
-	int	args;
+	const char	*feature;
+	const char	*name;
+	int		args;
 	enum ao_scheme_builtin_id	func;
 };
 
 struct builtin_atom {
-	char	*feature;
-	char	*name;
+	const char	*feature;
+	const char	*name;
 };
 
 #define AO_SCHEME_BUILTIN_CONSTS
@@ -306,8 +306,8 @@ ao_scheme_add_feature(struct feature **list, char *name)
 	*list = feature;
 }
 
-bool
-ao_scheme_has_feature(struct feature *list, char *name)
+static bool
+ao_scheme_has_feature(struct feature *list, const char *name)
 {
 	while (list) {
 		if (!strcmp(list->name, name))
@@ -317,17 +317,20 @@ ao_scheme_has_feature(struct feature *list, char *name)
 	return false;
 }
 
-void
-ao_scheme_add_features(struct feature **list, char *names)
+static void
+ao_scheme_add_features(struct feature **list, const char *names)
 {
 	char	*saveptr = NULL;
 	char	*name;
+	char	*copy = strdup(names);
+	char	*save = copy;
 
-	while ((name = strtok_r(names, ",", &saveptr)) != NULL) {
-		names = NULL;
+	while ((name = strtok_r(copy, ",", &saveptr)) != NULL) {
+		copy = NULL;
 		if (!ao_scheme_has_feature(*list, name))
 			ao_scheme_add_feature(list, name);
 	}
+	free(save);
 }
 
 int
@@ -407,7 +410,7 @@ main(int argc, char **argv)
 				 */
 				func_map[prev_func] = target_func++;
 			}
-			a = ao_scheme_atom_intern(funcs[f].name);
+			a = ao_scheme_atom_intern((char *) funcs[f].name);
 			ao_scheme_atom_def(ao_scheme_atom_poly(a),
 					   ao_scheme_builtin_poly(b));
 		}
@@ -474,32 +477,33 @@ main(int argc, char **argv)
 	fprintf(out, "#define _ao_scheme_bool_true 0x%04x\n", ao_scheme_bool_poly(ao_scheme_true));
 
 	for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) {
-		char	*n = a->name, c;
+		const char	*n = a->name;
+		char		ch;
 		fprintf(out, "#define _ao_scheme_atom_");
-		while ((c = *n++)) {
-			if (isalnum(c))
-				fprintf(out, "%c", c);
+		while ((ch = *n++)) {
+			if (isalnum(ch))
+				fprintf(out, "%c", ch);
 			else
-				fprintf(out, "%02x", c);
+				fprintf(out, "%02x", ch);
 		}
 		fprintf(out, "  0x%04x\n", ao_scheme_atom_poly(a));
 	}
 	fprintf(out, "#ifdef AO_SCHEME_CONST_BITS\n");
 	fprintf(out, "const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute((aligned(4))) = {");
 	for (o = 0; o < ao_scheme_top; o++) {
-		uint8_t	c;
+		uint8_t	ch;
 		if ((o & 0xf) == 0)
 			fprintf(out, "\n\t");
 		else
 			fprintf(out, " ");
-		c = ao_scheme_const[o];
+		ch = ao_scheme_const[o];
 		if (!in_atom)
 			in_atom = is_atom(o);
 		if (in_atom) {
-			fprintf(out, " '%c',", c);
+			fprintf(out, " '%c',", ch);
 			in_atom--;
 		} else {
-			fprintf(out, "0x%02x,", c);
+			fprintf(out, "0x%02x,", ch);
 		}
 	}
 	fprintf(out, "\n};\n");
-- 
cgit v1.2.3


From ca27d467198c556be483961a6ca3b8f97bbe96a6 Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 12 Dec 2017 17:59:26 -0800
Subject: altos/scheme: More compiler warning cleanups

Make local funcs static. Don't mix decls and code.x

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme.h              | 23 ++++++-----------------
 src/scheme/ao_scheme_builtin.c      | 10 ++++++----
 src/scheme/ao_scheme_lambda.c       |  8 ++++----
 src/scheme/ao_scheme_make_const.c   | 19 ++++++++++++-------
 src/scheme/ao_scheme_save.c         | 13 ++++++++++---
 src/scheme/ao_scheme_stack.c        |  3 ++-
 src/scheme/ao_scheme_string.c       | 19 +++++++++++++------
 src/scheme/make-const/Makefile      |  2 +-
 src/scheme/test/Makefile            |  2 +-
 src/scheme/test/ao_scheme_os.h      |  2 +-
 src/scheme/tiny-test/Makefile       |  2 +-
 src/scheme/tiny-test/ao_scheme_os.h |  7 +------
 12 files changed, 58 insertions(+), 52 deletions(-)

(limited to 'src/scheme/ao_scheme_make_const.c')

diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index 7e4b3697..ad80db2f 100644
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -43,6 +43,10 @@ struct ao_scheme_os_save {
 	uint16_t	const_checksum_inv;
 };
 
+#ifndef AO_SCHEME_POOL_TOTAL
+#error Must define AO_SCHEME_POOL_TOTAL for AO_SCHEME_SAVE
+#endif
+
 #define AO_SCHEME_POOL_EXTRA	(sizeof(struct ao_scheme_os_save))
 #define AO_SCHEME_POOL	((int) (AO_SCHEME_POOL_TOTAL - AO_SCHEME_POOL_EXTRA))
 
@@ -78,7 +82,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)))
 #else
 #include "ao_scheme_const.h"
 #ifndef AO_SCHEME_POOL
-#define AO_SCHEME_POOL	3072
+#error Must define AO_SCHEME_POOL
 #endif
 #ifndef AO_SCHEME_POOL_EXTRA
 #define AO_SCHEME_POOL_EXTRA 0
@@ -560,21 +564,10 @@ extern uint64_t ao_scheme_collects[2];
 extern uint64_t ao_scheme_freed[2];
 extern uint64_t ao_scheme_loops[2];
 
-/* returns 1 if the object was already marked */
-int
-ao_scheme_mark(const struct ao_scheme_type *type, void *addr);
-
 /* returns 1 if the object was already marked */
 int
 ao_scheme_mark_memory(const struct ao_scheme_type *type, void *addr);
 
-void *
-ao_scheme_move_map(void *addr);
-
-/* returns 1 if the object was already moved */
-int
-ao_scheme_move(const struct ao_scheme_type *type, void **ref);
-
 /* returns 1 if the object was already moved */
 int
 ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref);
@@ -635,7 +628,7 @@ void
 ao_scheme_bool_write(ao_poly v);
 
 #ifdef AO_SCHEME_MAKE_CONST
-struct ao_scheme_bool	*ao_scheme_true, *ao_scheme_false;
+extern struct ao_scheme_bool	*ao_scheme_true, *ao_scheme_false;
 
 struct ao_scheme_bool *
 ao_scheme_bool_get(uint8_t value);
@@ -825,12 +818,8 @@ ao_scheme_number_typep(uint8_t t)
 {
 	return ao_scheme_integer_typep(t) || (t == AO_SCHEME_FLOAT);
 }
-
-float
-ao_scheme_poly_number(ao_poly p);
 #else
 #define ao_scheme_number_typep ao_scheme_integer_typep
-#define ao_scheme_poly_number ao_scheme_poly_integer
 #endif
 
 /* builtin */
diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index 4def5704..b6788993 100644
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -127,7 +127,7 @@ ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int ty
 	return _ao_scheme_bool_true;
 }
 
-int32_t
+static int32_t
 ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc)
 {
 	ao_poly p = ao_scheme_arg(cons, argc);
@@ -306,10 +306,10 @@ ao_scheme_do_display(struct ao_scheme_cons *cons)
 	return _ao_scheme_bool_true;
 }
 
-ao_poly
+static ao_poly
 ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
 {
-	struct ao_scheme_cons *cons = cons;
+	struct ao_scheme_cons *cons;
 	ao_poly	ret = AO_SCHEME_NIL;
 
 	for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) {
@@ -501,7 +501,7 @@ ao_scheme_do_remainder(struct ao_scheme_cons *cons)
 	return ao_scheme_math(cons, builtin_remainder);
 }
 
-ao_poly
+static ao_poly
 ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)
 {
 	ao_poly	left;
@@ -545,6 +545,7 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)
 				default:
 					break;
 				}
+#ifdef AO_SCHEME_FEATURE_FLOAT
 			} else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) {
 				float l, r;
 
@@ -574,6 +575,7 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)
 				default:
 					break;
 				}
+#endif /* AO_SCHEME_FEATURE_FLOAT */
 			} else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) {
 				int c = strcmp(ao_scheme_poly_string(left),
 					       ao_scheme_poly_string(right));
diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c
index ec6f858c..be87f4d1 100644
--- a/src/scheme/ao_scheme_lambda.c
+++ b/src/scheme/ao_scheme_lambda.c
@@ -17,14 +17,14 @@
 
 #include "ao_scheme.h"
 
-int
+static int
 lambda_size(void *addr)
 {
 	(void) addr;
 	return sizeof (struct ao_scheme_lambda);
 }
 
-void
+static void
 lambda_mark(void *addr)
 {
 	struct ao_scheme_lambda	*lambda = addr;
@@ -33,7 +33,7 @@ lambda_mark(void *addr)
 	ao_scheme_poly_mark(lambda->frame, 0);
 }
 
-void
+static void
 lambda_move(void *addr)
 {
 	struct ao_scheme_lambda	*lambda = addr;
@@ -65,7 +65,7 @@ ao_scheme_lambda_write(ao_poly poly)
 	printf(")");
 }
 
-ao_poly
+static ao_poly
 ao_scheme_lambda_alloc(struct ao_scheme_cons *code, int args)
 {
 	struct ao_scheme_lambda	*lambda;
diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c
index d0a51ec8..51bb1269 100644
--- a/src/scheme/ao_scheme_make_const.c
+++ b/src/scheme/ao_scheme_make_const.c
@@ -80,7 +80,7 @@ ao_fec_crc_byte(uint8_t byte, uint16_t crc)
 	return crc;
 }
 
-uint16_t
+static uint16_t
 ao_fec_crc(const uint8_t *bytes, uint8_t len)
 {
 	uint16_t	crc = AO_FEC_CRC_INIT;
@@ -97,7 +97,7 @@ struct ao_scheme_macro_stack {
 
 struct ao_scheme_macro_stack *macro_stack;
 
-int
+static int
 ao_scheme_macro_push(ao_poly p)
 {
 	struct ao_scheme_macro_stack *m = macro_stack;
@@ -114,7 +114,7 @@ ao_scheme_macro_push(ao_poly p)
 	return 0;
 }
 
-void
+static void
 ao_scheme_macro_pop(void)
 {
 	struct ao_scheme_macro_stack *m = macro_stack;
@@ -141,7 +141,7 @@ void indent(void)
 ao_poly
 ao_has_macro(ao_poly p);
 
-ao_poly
+static ao_poly
 ao_macro_test_get(ao_poly atom)
 {
 	ao_poly	*ref = ao_scheme_atom_ref(atom, NULL);
@@ -150,7 +150,7 @@ ao_macro_test_get(ao_poly atom)
 	return AO_SCHEME_NIL;
 }
 
-ao_poly
+static ao_poly
 ao_is_macro(ao_poly p)
 {
 	struct ao_scheme_builtin	*builtin;
@@ -269,7 +269,7 @@ ao_scheme_seen_builtin(struct ao_scheme_builtin *b)
 	return 0;
 }
 
-int
+static int
 ao_scheme_read_eval_abort(void)
 {
 	ao_poly	in, out = AO_SCHEME_NIL;
@@ -297,7 +297,7 @@ struct feature {
 static struct feature *enable;
 static struct feature *disable;
 
-void
+static void
 ao_scheme_add_feature(struct feature **list, char *name)
 {
 	struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1);
@@ -359,6 +359,7 @@ main(int argc, char **argv)
 	ao_poly	val;
 	struct ao_scheme_atom	*a;
 	struct ao_scheme_builtin	*b;
+	struct feature			*d;
 	int	in_atom = 0;
 	char	*out_name = NULL;
 	int	c;
@@ -394,6 +395,7 @@ main(int argc, char **argv)
 
 	prev_func = _builtin_last;
 	target_func = 0;
+	b = NULL;
 	for (f = 0; f < (int) N_FUNC; f++) {
 		if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) {
 			if (funcs[f].func != prev_func) {
@@ -467,6 +469,9 @@ main(int argc, char **argv)
 
 	fprintf(out, "/* Generated file, do not edit */\n\n");
 
+	for (d = disable; d; d = d->next)
+		fprintf(out, "#undef AO_SCHEME_FEATURE_%s\n", d->name);
+
 	fprintf(out, "#define AO_SCHEME_POOL_CONST %d\n", ao_scheme_top);
 	fprintf(out, "extern const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)));\n");
 	fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_scheme_atom_poly(ao_scheme_atoms));
diff --git a/src/scheme/ao_scheme_save.c b/src/scheme/ao_scheme_save.c
index af9345b8..3a595d71 100644
--- a/src/scheme/ao_scheme_save.c
+++ b/src/scheme/ao_scheme_save.c
@@ -17,11 +17,15 @@
 ao_poly
 ao_scheme_do_save(struct ao_scheme_cons *cons)
 {
+#ifdef AO_SCHEME_SAVE
+	struct ao_scheme_os_save *os;
+#endif
+
 	if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0))
 		return AO_SCHEME_NIL;
 
 #ifdef AO_SCHEME_SAVE
-	struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL];
+	os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL];
 
 	ao_scheme_collect(AO_SCHEME_COLLECT_FULL);
 	os->atoms = ao_scheme_atom_poly(ao_scheme_atoms);
@@ -38,12 +42,15 @@ ao_scheme_do_save(struct ao_scheme_cons *cons)
 ao_poly
 ao_scheme_do_restore(struct ao_scheme_cons *cons)
 {
+#ifdef AO_SCHEME_SAVE
+	struct ao_scheme_os_save save;
+	struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL];
+#endif
 	if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0))
 		return AO_SCHEME_NIL;
 
 #ifdef AO_SCHEME_SAVE
-	struct ao_scheme_os_save save;
-	struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL];
+	os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL];
 
 	if (!ao_scheme_os_restore_save(&save, AO_SCHEME_POOL))
 		return ao_scheme_error(AO_SCHEME_INVALID, "header restore failed");
diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c
index d19dd6d6..e062a093 100644
--- a/src/scheme/ao_scheme_stack.c
+++ b/src/scheme/ao_scheme_stack.c
@@ -221,11 +221,12 @@ ao_scheme_stack_copy(struct ao_scheme_stack *old)
 ao_poly
 ao_scheme_stack_eval(void)
 {
+	struct ao_scheme_cons	*cons;
 	struct ao_scheme_stack	*new = ao_scheme_stack_copy(ao_scheme_poly_stack(ao_scheme_v));
 	if (!new)
 		return AO_SCHEME_NIL;
 
-	struct ao_scheme_cons	*cons = ao_scheme_poly_cons(ao_scheme_stack->values);
+	cons = ao_scheme_poly_cons(ao_scheme_stack->values);
 
 	if (!cons || !cons->cdr)
 		return ao_scheme_error(AO_SCHEME_INVALID, "continuation requires a value");
diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c
index e25306cb..ada626c3 100644
--- a/src/scheme/ao_scheme_string.c
+++ b/src/scheme/ao_scheme_string.c
@@ -45,9 +45,10 @@ char *
 ao_scheme_string_copy(char *a)
 {
 	int	alen = strlen(a);
+	char	*r;
 
 	ao_scheme_string_stash(0, a);
-	char	*r = ao_scheme_alloc(alen + 1);
+	r = ao_scheme_alloc(alen + 1);
 	a = ao_scheme_string_fetch(0);
 	if (!r)
 		return NULL;
@@ -60,10 +61,11 @@ ao_scheme_string_cat(char *a, char *b)
 {
 	int	alen = strlen(a);
 	int	blen = strlen(b);
+	char 	*r;
 
 	ao_scheme_string_stash(0, a);
 	ao_scheme_string_stash(1, b);
-	char	*r = ao_scheme_alloc(alen + blen + 1);
+	r = ao_scheme_alloc(alen + blen + 1);
 	a = ao_scheme_string_fetch(0);
 	b = ao_scheme_string_fetch(1);
 	if (!r)
@@ -76,11 +78,15 @@ ao_scheme_string_cat(char *a, char *b)
 ao_poly
 ao_scheme_string_pack(struct ao_scheme_cons *cons)
 {
-	int	len = ao_scheme_cons_length(cons);
+	char	*r;
+	char	*s;
+	int	len;
+
+	len = ao_scheme_cons_length(cons);
 	ao_scheme_cons_stash(0, cons);
-	char	*r = ao_scheme_alloc(len + 1);
+	r = ao_scheme_alloc(len + 1);
 	cons = ao_scheme_cons_fetch(0);
-	char	*s = r;
+	s = r;
 
 	while (cons) {
 		if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car)))
@@ -100,10 +106,11 @@ ao_scheme_string_unpack(char *a)
 	int			i;
 
 	for (i = 0; (c = a[i]); i++) {
+		struct ao_scheme_cons	*n;
 		ao_scheme_cons_stash(0, cons);
 		ao_scheme_cons_stash(1, tail);
 		ao_scheme_string_stash(0, a);
-		struct ao_scheme_cons	*n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
+		n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL);
 		a = ao_scheme_string_fetch(0);
 		cons = ao_scheme_cons_fetch(0);
 		tail = ao_scheme_cons_fetch(1);
diff --git a/src/scheme/make-const/Makefile b/src/scheme/make-const/Makefile
index caf7acbe..438b6a79 100644
--- a/src/scheme/make-const/Makefile
+++ b/src/scheme/make-const/Makefile
@@ -10,7 +10,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_os.h
 OBJS=$(SRCS:.c=.o)
 
 CC=cc
-CFLAGS=-DAO_SCHEME_MAKE_CONST -O0 -g -I. -Wall -Wextra
+CFLAGS=-DAO_SCHEME_MAKE_CONST -O2 -g -I. -Wall -Wextra -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast
 
 .c.o:
 	$(CC) -c $(CFLAGS) $< -o $@
diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile
index d1bc4239..d51fa7ba 100644
--- a/src/scheme/test/Makefile
+++ b/src/scheme/test/Makefile
@@ -9,7 +9,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_const.h
 
 OBJS=$(SRCS:.c=.o)
 
-CFLAGS=-O2 -g -Wall -Wextra -I. -I..
+CFLAGS=-O2 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast
 
 ao-scheme: $(OBJS)
 	cc $(CFLAGS) -o $@ $(OBJS) -lm
diff --git a/src/scheme/test/ao_scheme_os.h b/src/scheme/test/ao_scheme_os.h
index 958f68be..b225b2e8 100644
--- a/src/scheme/test/ao_scheme_os.h
+++ b/src/scheme/test/ao_scheme_os.h
@@ -28,7 +28,7 @@
 extern int ao_scheme_getc(void);
 
 static inline void
-ao_scheme_os_flush() {
+ao_scheme_os_flush(void) {
 	fflush(stdout);
 }
 
diff --git a/src/scheme/tiny-test/Makefile b/src/scheme/tiny-test/Makefile
index 5082df44..6b1fe003 100644
--- a/src/scheme/tiny-test/Makefile
+++ b/src/scheme/tiny-test/Makefile
@@ -11,7 +11,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_const.h
 
 OBJS=$(SRCS:.c=.o)
 
-CFLAGS=-O0 -g -Wall -Wextra -I. -I..
+CFLAGS=-O0 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast
 
 ao-scheme-tiny: $(OBJS)
 	cc $(CFLAGS) -o $@ $(OBJS) -lm
diff --git a/src/scheme/tiny-test/ao_scheme_os.h b/src/scheme/tiny-test/ao_scheme_os.h
index 7cfe3981..b9f3e31f 100644
--- a/src/scheme/tiny-test/ao_scheme_os.h
+++ b/src/scheme/tiny-test/ao_scheme_os.h
@@ -22,18 +22,13 @@
 #include <stdlib.h>
 #include <time.h>
 
-#undef AO_SCHEME_FEATURE_FLOAT
-#undef AO_SCHEME_FEATURE_VECTOR
-#undef AO_SCHEME_FEATURE_QUASI
-#undef AO_SCHEME_FEATURE_BIGINT
-
 #define AO_SCHEME_POOL_TOTAL	4096
 #define AO_SCHEME_SAVE		1
 
 extern int ao_scheme_getc(void);
 
 static inline void
-ao_scheme_os_flush() {
+ao_scheme_os_flush(void) {
 	fflush(stdout);
 }
 
-- 
cgit v1.2.3


From 431165e5fa72ba6dffd477de32960745cdec332c Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 19 Dec 2017 11:33:36 -0800
Subject: altos/scheme: Rework display/write code
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Unify output functions and add bool to switch between write and
display mode. Make that only affect strings (as per r⁷rs).

Use print recursion detection in frame and stack code, eliminating
PRINT flags in type field.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme.h            |  65 +++++++++---------------
 src/scheme/ao_scheme_atom.c       |   3 +-
 src/scheme/ao_scheme_bool.c       |   3 +-
 src/scheme/ao_scheme_builtin.c    |  11 ++--
 src/scheme/ao_scheme_cons.c       |  62 +++++++++++------------
 src/scheme/ao_scheme_error.c      |  74 ++-------------------------
 src/scheme/ao_scheme_float.c      |   3 +-
 src/scheme/ao_scheme_frame.c      |  55 +++++++++++++-------
 src/scheme/ao_scheme_int.c        |   6 ++-
 src/scheme/ao_scheme_lambda.c     |   4 +-
 src/scheme/ao_scheme_make_const.c |   6 +--
 src/scheme/ao_scheme_mem.c        |  33 ++++++++----
 src/scheme/ao_scheme_poly.c       | 103 ++++++++------------------------------
 src/scheme/ao_scheme_rep.c        |   2 +-
 src/scheme/ao_scheme_stack.c      |  31 ++++++++----
 src/scheme/ao_scheme_string.c     |  56 +++++++++------------
 src/scheme/ao_scheme_vector.c     |  28 +++--------
 17 files changed, 213 insertions(+), 332 deletions(-)

(limited to 'src/scheme/ao_scheme_make_const.c')

diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index 0881721b..b37e9098 100644
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -249,7 +249,6 @@ struct ao_scheme_bigint {
 
 /* Set on type when the frame escapes the lambda */
 #define AO_SCHEME_FRAME_MARK	0x80
-#define AO_SCHEME_FRAME_PRINT	0x40
 
 static inline int ao_scheme_frame_marked(struct ao_scheme_frame *f) {
 	return f->type & AO_SCHEME_FRAME_MARK;
@@ -301,7 +300,6 @@ struct ao_scheme_stack {
 };
 
 #define AO_SCHEME_STACK_MARK	0x80	/* set on type when a reference has been taken */
-#define AO_SCHEME_STACK_PRINT	0x40	/* stack is being printed */
 
 static inline int ao_scheme_stack_marked(struct ao_scheme_stack *s) {
 	return s->type & AO_SCHEME_STACK_MARK;
@@ -567,15 +565,15 @@ ao_scheme_alloc(int size);
 int
 ao_scheme_print_mark_addr(void *addr);
 
-int
-ao_scheme_print_mark_poly(ao_poly poly);
+void
+ao_scheme_print_clear_addr(void *addr);
 
 /* Notes that printing has started */
 void
 ao_scheme_print_start(void);
 
-/* Notes that printing has ended */
-void
+/* Notes that printing has ended, returns 1 if printing is still happening */
+int
 ao_scheme_print_stop(void);
 
 #define AO_SCHEME_COLLECT_FULL		1
@@ -628,7 +626,7 @@ ao_scheme_frame_fetch(int id);
 extern const struct ao_scheme_type ao_scheme_bool_type;
 
 void
-ao_scheme_bool_write(ao_poly v);
+ao_scheme_bool_write(ao_poly v, bool write);
 
 #ifdef AO_SCHEME_MAKE_CONST
 extern struct ao_scheme_bool	*ao_scheme_true, *ao_scheme_false;
@@ -656,10 +654,7 @@ void
 ao_scheme_cons_free(struct ao_scheme_cons *cons);
 
 void
-ao_scheme_cons_write(ao_poly);
-
-void
-ao_scheme_cons_display(ao_poly);
+ao_scheme_cons_write(ao_poly, bool write);
 
 int
 ao_scheme_cons_length(struct ao_scheme_cons *cons);
@@ -689,10 +684,7 @@ ao_poly
 ao_scheme_string_unpack(struct ao_scheme_string *a);
 
 void
-ao_scheme_string_write(ao_poly s);
-
-void
-ao_scheme_string_display(ao_poly s);
+ao_scheme_string_write(ao_poly s, bool write);
 
 /* atom */
 extern const struct ao_scheme_type ao_scheme_atom_type;
@@ -702,7 +694,7 @@ extern struct ao_scheme_frame	*ao_scheme_frame_global;
 extern struct ao_scheme_frame	*ao_scheme_frame_current;
 
 void
-ao_scheme_atom_write(ao_poly a);
+ao_scheme_atom_write(ao_poly a, bool write);
 
 struct ao_scheme_atom *
 ao_scheme_string_to_atom(struct ao_scheme_string *string);
@@ -724,7 +716,7 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val);
 
 /* int */
 void
-ao_scheme_int_write(ao_poly i);
+ao_scheme_int_write(ao_poly i, bool write);
 
 #ifdef AO_SCHEME_FEATURE_BIGINT
 int32_t
@@ -740,7 +732,7 @@ ao_scheme_integer_typep(uint8_t t)
 }
 
 void
-ao_scheme_bigint_write(ao_poly i);
+ao_scheme_bigint_write(ao_poly i, bool write);
 
 extern const struct ao_scheme_type	ao_scheme_bigint_type;
 
@@ -760,10 +752,7 @@ ao_scheme_integer_typep(uint8_t t)
 /* vector */
 
 void
-ao_scheme_vector_write(ao_poly v);
-
-void
-ao_scheme_vector_display(ao_poly v);
+ao_scheme_vector_write(ao_poly v, bool write);
 
 struct ao_scheme_vector *
 ao_scheme_vector_alloc(uint16_t length, ao_poly fill);
@@ -783,14 +772,10 @@ ao_scheme_vector_to_list(struct ao_scheme_vector *vector);
 extern const struct ao_scheme_type	ao_scheme_vector_type;
 
 /* prim */
-void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p);
-void (*ao_scheme_poly_display_func(ao_poly p))(ao_poly p);
-
-static inline void
-ao_scheme_poly_write(ao_poly p) { (*ao_scheme_poly_write_func(p))(p); }
+void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write);
 
 static inline void
-ao_scheme_poly_display(ao_poly p) { (*ao_scheme_poly_display_func(p))(p); }
+ao_scheme_poly_write(ao_poly p, bool write) { (*ao_scheme_poly_write_func(p))(p, write); }
 
 int
 ao_scheme_poly_mark(ao_poly p, uint8_t note_cons);
@@ -818,7 +803,7 @@ ao_scheme_set_cond(struct ao_scheme_cons *cons);
 extern const struct ao_scheme_type ao_scheme_float_type;
 
 void
-ao_scheme_float_write(ao_poly p);
+ao_scheme_float_write(ao_poly p, bool write);
 
 ao_poly
 ao_scheme_float_get(float value);
@@ -836,7 +821,7 @@ ao_scheme_number_typep(uint8_t t)
 
 /* builtin */
 void
-ao_scheme_builtin_write(ao_poly b);
+ao_scheme_builtin_write(ao_poly b, bool write);
 
 extern const struct ao_scheme_type ao_scheme_builtin_type;
 
@@ -895,7 +880,7 @@ ao_poly
 ao_scheme_frame_add(struct ao_scheme_frame *frame, ao_poly atom, ao_poly val);
 
 void
-ao_scheme_frame_write(ao_poly p);
+ao_scheme_frame_write(ao_poly p, bool write);
 
 void
 ao_scheme_frame_init(void);
@@ -909,7 +894,7 @@ struct ao_scheme_lambda *
 ao_scheme_lambda_new(ao_poly cons);
 
 void
-ao_scheme_lambda_write(ao_poly lambda);
+ao_scheme_lambda_write(ao_poly lambda, bool write);
 
 ao_poly
 ao_scheme_lambda_eval(void);
@@ -920,6 +905,8 @@ extern const struct ao_scheme_type ao_scheme_stack_type;
 extern struct ao_scheme_stack	*ao_scheme_stack;
 extern struct ao_scheme_stack	*ao_scheme_stack_free_list;
 
+extern int			ao_scheme_frame_print_indent;
+
 void
 ao_scheme_stack_reset(struct ao_scheme_stack *stack);
 
@@ -933,7 +920,7 @@ void
 ao_scheme_stack_clear(void);
 
 void
-ao_scheme_stack_write(ao_poly stack);
+ao_scheme_stack_write(ao_poly stack, bool write);
 
 ao_poly
 ao_scheme_stack_eval(void);
@@ -946,12 +933,6 @@ ao_scheme_vprintf(const char *format, va_list args);
 void
 ao_scheme_printf(const char *format, ...);
 
-void
-ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last);
-
-void
-ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame);
-
 ao_poly
 ao_scheme_error(int error, const char *format, ...);
 
@@ -974,10 +955,10 @@ int ao_scheme_stack_depth;
 #define DBG_RESET()	(ao_scheme_stack_depth = 0)
 #define DBG(...) 	ao_scheme_printf(__VA_ARGS__)
 #define DBGI(...)	do { printf("%4d: ", __LINE__); DBG_INDENT(); DBG(__VA_ARGS__); } while (0)
-#define DBG_CONS(a)	ao_scheme_cons_write(ao_scheme_cons_poly(a))
-#define DBG_POLY(a)	ao_scheme_poly_write(a)
+#define DBG_CONS(a)	ao_scheme_cons_write(ao_scheme_cons_poly(a), true)
+#define DBG_POLY(a)	ao_scheme_poly_write(a, true)
 #define OFFSET(a)	((a) ? (int) ((uint8_t *) a - ao_scheme_pool) : -1)
-#define DBG_STACK()	ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack))
+#define DBG_STACK()	ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true)
 static inline void
 ao_scheme_frames_dump(void)
 {
diff --git a/src/scheme/ao_scheme_atom.c b/src/scheme/ao_scheme_atom.c
index 745c32fe..8989cefd 100644
--- a/src/scheme/ao_scheme_atom.c
+++ b/src/scheme/ao_scheme_atom.c
@@ -188,8 +188,9 @@ ao_scheme_atom_def(ao_poly atom, ao_poly val)
 }
 
 void
-ao_scheme_atom_write(ao_poly a)
+ao_scheme_atom_write(ao_poly a, bool write)
 {
 	struct ao_scheme_atom *atom = ao_scheme_poly_atom(a);
+	(void) write;
 	printf("%s", atom->name);
 }
diff --git a/src/scheme/ao_scheme_bool.c b/src/scheme/ao_scheme_bool.c
index c1e880ca..88970667 100644
--- a/src/scheme/ao_scheme_bool.c
+++ b/src/scheme/ao_scheme_bool.c
@@ -38,10 +38,11 @@ const struct ao_scheme_type ao_scheme_bool_type = {
 };
 
 void
-ao_scheme_bool_write(ao_poly v)
+ao_scheme_bool_write(ao_poly v, bool write)
 {
 	struct ao_scheme_bool	*b = ao_scheme_poly_bool(v);
 
+	(void) write;
 	if (b->value)
 		printf("#t");
 	else
diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index 9a823f6a..221570c7 100644
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -84,9 +84,10 @@ ao_scheme_args_name(uint8_t args)
 #endif
 
 void
-ao_scheme_builtin_write(ao_poly b)
+ao_scheme_builtin_write(ao_poly b, bool write)
 {
 	struct ao_scheme_builtin *builtin = ao_scheme_poly_builtin(b);
+	(void) write;
 	printf("%s", ao_scheme_builtin_name(builtin->func));
 }
 
@@ -287,7 +288,7 @@ ao_scheme_do_write(struct ao_scheme_cons *cons)
 	ao_poly	val = AO_SCHEME_NIL;
 	while (cons) {
 		val = cons->car;
-		ao_scheme_poly_write(val);
+		ao_scheme_poly_write(val, true);
 		cons = ao_scheme_cons_cdr(cons);
 		if (cons)
 			printf(" ");
@@ -301,7 +302,7 @@ ao_scheme_do_display(struct ao_scheme_cons *cons)
 	ao_poly	val = AO_SCHEME_NIL;
 	while (cons) {
 		val = cons->car;
-		ao_scheme_poly_display(val);
+		ao_scheme_poly_write(val, false);
 		cons = ao_scheme_cons_cdr(cons);
 	}
 	return _ao_scheme_bool_true;
@@ -855,7 +856,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons)
 	if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 		return AO_SCHEME_NIL;
 	v = ao_scheme_arg(cons, 0);
-	if (v != AO_SCHEME_NIL && ao_scheme_poly_type(v) == AO_SCHEME_CONS)
+	if (v != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(v))
 		return _ao_scheme_bool_true;
 	return _ao_scheme_bool_false;
 }
@@ -946,7 +947,7 @@ ao_scheme_do_listp(struct ao_scheme_cons *cons)
 	for (;;) {
 		if (v == AO_SCHEME_NIL)
 			return _ao_scheme_bool_true;
-		if (ao_scheme_poly_type(v) != AO_SCHEME_CONS)
+		if (!AO_SCHEME_IS_CONS(v))
 			return _ao_scheme_bool_false;
 		v = ao_scheme_poly_cons(v)->cdr;
 	}
diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c
index 0b3cbf80..7976250b 100644
--- a/src/scheme/ao_scheme_cons.c
+++ b/src/scheme/ao_scheme_cons.c
@@ -111,7 +111,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons)
 	ao_poly	cdr = cons->cdr;
 	if (cdr == AO_SCHEME_NIL)
 		return NULL;
-	if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
+	if (!AO_SCHEME_IS_CONS(cdr)) {
 		(void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
 		return NULL;
 	}
@@ -151,7 +151,7 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons)
 			tail->cdr = ao_scheme_cons_poly(new);
 		tail = new;
 		cdr = cons->cdr;
-		if (ao_scheme_poly_type(cdr) != AO_SCHEME_CONS) {
+		if (!AO_SCHEME_IS_CONS(cdr)) {
 			tail->cdr = cdr;
 			break;
 		}
@@ -175,59 +175,53 @@ ao_scheme_cons_free(struct ao_scheme_cons *cons)
 }
 
 void
-ao_scheme_cons_write(ao_poly c)
+ao_scheme_cons_write(ao_poly c, bool write)
 {
 	struct ao_scheme_cons	*cons = ao_scheme_poly_cons(c);
+	struct ao_scheme_cons	*clear = cons;
 	ao_poly			cdr;
-	int			first = 1;
+	int			written = 0;
 
 	ao_scheme_print_start();
 	printf("(");
 	while (cons) {
-		if (!first)
+		if (written != 0)
 			printf(" ");
+
+		/* Note if there's recursion in printing. Not
+		 * as good as actual references, but at least
+		 * we don't infinite loop...
+		 */
 		if (ao_scheme_print_mark_addr(cons)) {
 			printf("...");
 			break;
 		}
-		ao_scheme_poly_write(cons->car);
+
+		ao_scheme_poly_write(cons->car, write);
+
+		/* keep track of how many pairs have been printed */
+		written++;
+
 		cdr = cons->cdr;
-		if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS) {
-			cons = ao_scheme_poly_cons(cdr);
-			first = 0;
-		} else {
+		if (!AO_SCHEME_IS_CONS(cdr)) {
 			printf(" . ");
-			ao_scheme_poly_write(cdr);
-			cons = NULL;
+			ao_scheme_poly_write(cdr, write);
+			break;
 		}
+		cons = ao_scheme_poly_cons(cdr);
 	}
 	printf(")");
-	ao_scheme_print_stop();
-}
 
-void
-ao_scheme_cons_display(ao_poly c)
-{
-	struct ao_scheme_cons	*cons = ao_scheme_poly_cons(c);
-	ao_poly			cdr;
-
-	ao_scheme_print_start();
-	while (cons) {
-		if (ao_scheme_print_mark_addr(cons)) {
-			printf("...");
-			break;
-		}
-		ao_scheme_poly_display(cons->car);
+	if (ao_scheme_print_stop()) {
 
-		cdr = cons->cdr;
-		if (ao_scheme_poly_type(cdr) == AO_SCHEME_CONS)
-			cons = ao_scheme_poly_cons(cdr);
-		else {
-			ao_scheme_poly_display(cdr);
-			cons = NULL;
+		/* If we're still printing, clear the print marks on
+		 * all printed pairs
+		 */
+		while (written--) {
+			ao_scheme_print_clear_addr(clear);
+			clear = ao_scheme_poly_cons(clear->cdr);
 		}
 	}
-	ao_scheme_print_stop();
 }
 
 int
diff --git a/src/scheme/ao_scheme_error.c b/src/scheme/ao_scheme_error.c
index c015c76a..6a71ca51 100644
--- a/src/scheme/ao_scheme_error.c
+++ b/src/scheme/ao_scheme_error.c
@@ -15,73 +15,6 @@
 #include "ao_scheme.h"
 #include <stdarg.h>
 
-void
-ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last)
-{
-	int first = 1;
-	printf("\t\t%s(", name);
-	if (ao_scheme_poly_type(poly) == AO_SCHEME_CONS) {
-		if (poly) {
-			while (poly) {
-				struct ao_scheme_cons *cons = ao_scheme_poly_cons(poly);
-				if (!first)
-					printf("\t\t         ");
-				else
-					first = 0;
-				ao_scheme_poly_write(cons->car);
-				printf("\n");
-				if (poly == last)
-					break;
-				poly = cons->cdr;
-			}
-			printf("\t\t         )\n");
-		} else
-			printf(")\n");
-	} else {
-		ao_scheme_poly_write(poly);
-		printf("\n");
-	}
-}
-
-static void tabs(int indent)
-{
-	while (indent--)
-		printf("\t");
-}
-
-void
-ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame)
-{
-	int			f;
-
-	tabs(indent);
-	printf ("%s{", name);
-	if (frame) {
-		struct ao_scheme_frame_vals	*vals = ao_scheme_poly_frame_vals(frame->vals);
-		if (frame->type & AO_SCHEME_FRAME_PRINT)
-			printf("recurse...");
-		else {
-			frame->type |= AO_SCHEME_FRAME_PRINT;
-			for (f = 0; f < frame->num; f++) {
-				if (f != 0) {
-					tabs(indent);
-					printf("         ");
-				}
-				ao_scheme_poly_write(vals->vals[f].atom);
-				printf(" = ");
-				ao_scheme_poly_write(vals->vals[f].val);
-				printf("\n");
-			}
-			if (frame->prev)
-				ao_scheme_error_frame(indent + 1, "prev:   ", ao_scheme_poly_frame(frame->prev));
-			frame->type &= ~AO_SCHEME_FRAME_PRINT;
-		}
-		tabs(indent);
-		printf("        }\n");
-	} else
-		printf ("}\n");
-}
-
 void
 ao_scheme_vprintf(const char *format, va_list args)
 {
@@ -91,7 +24,10 @@ ao_scheme_vprintf(const char *format, va_list args)
 		if (c == '%') {
 			switch (c = *format++) {
 			case 'v':
-				ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int));
+				ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), true);
+				break;
+			case 'V':
+				ao_scheme_poly_write((ao_poly) va_arg(args, unsigned int), false);
 				break;
 			case 'p':
 				printf("%p", va_arg(args, void *));
@@ -133,7 +69,7 @@ ao_scheme_error(int error, const char *format, ...)
 	ao_scheme_printf("Value:  %v\n", ao_scheme_v);
 	ao_scheme_printf("Frame:  %v\n", ao_scheme_frame_poly(ao_scheme_frame_current));
 	printf("Stack:\n");
-	ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack));
+	ao_scheme_stack_write(ao_scheme_stack_poly(ao_scheme_stack), true);
 	ao_scheme_printf("Globals: %v\n", ao_scheme_frame_poly(ao_scheme_frame_global));
 	return AO_SCHEME_NIL;
 }
diff --git a/src/scheme/ao_scheme_float.c b/src/scheme/ao_scheme_float.c
index b75289d7..d8501548 100644
--- a/src/scheme/ao_scheme_float.c
+++ b/src/scheme/ao_scheme_float.c
@@ -46,11 +46,12 @@ const struct ao_scheme_type ao_scheme_float_type = {
 #endif
 
 void
-ao_scheme_float_write(ao_poly p)
+ao_scheme_float_write(ao_poly p, bool write)
 {
 	struct ao_scheme_float *f = ao_scheme_poly_float(p);
 	float	v = f->value;
 
+	(void) write;
 	if (isnanf(v))
 		printf("+nan.0");
 	else if (isinff(v)) {
diff --git a/src/scheme/ao_scheme_frame.c b/src/scheme/ao_scheme_frame.c
index 3f4c9157..46f941e6 100644
--- a/src/scheme/ao_scheme_frame.c
+++ b/src/scheme/ao_scheme_frame.c
@@ -142,32 +142,53 @@ const struct ao_scheme_type ao_scheme_frame_type = {
 	.name = "frame",
 };
 
+int ao_scheme_frame_print_indent;
+
+static void
+ao_scheme_frame_indent(int extra)
+{
+	int				i;
+	putchar('\n');
+	for (i = 0; i < ao_scheme_frame_print_indent+extra; i++)
+		putchar('\t');
+}
+
 void
-ao_scheme_frame_write(ao_poly p)
+ao_scheme_frame_write(ao_poly p, bool write)
 {
 	struct ao_scheme_frame		*frame = ao_scheme_poly_frame(p);
+	struct ao_scheme_frame		*clear = frame;
 	struct ao_scheme_frame_vals	*vals = ao_scheme_poly_frame_vals(frame->vals);
 	int				f;
+	int				written = 0;
 
-	printf ("{");
-	if (frame) {
-		if (frame->type & AO_SCHEME_FRAME_PRINT)
+	ao_scheme_print_start();
+	while (frame) {
+		if (written != 0)
+			printf(", ");
+		if (ao_scheme_print_mark_addr(frame)) {
 			printf("recurse...");
-		else {
-			frame->type |= AO_SCHEME_FRAME_PRINT;
-			for (f = 0; f < frame->num; f++) {
-				if (f != 0)
-					printf(", ");
-				ao_scheme_poly_write(vals->vals[f].atom);
-				printf(" = ");
-				ao_scheme_poly_write(vals->vals[f].val);
-			}
-			if (frame->prev)
-				ao_scheme_poly_write(frame->prev);
-			frame->type &= ~AO_SCHEME_FRAME_PRINT;
+			break;
+		}
+
+		putchar('{');
+		written++;
+		for (f = 0; f < frame->num; f++) {
+			ao_scheme_frame_indent(1);
+			ao_scheme_poly_write(vals->vals[f].atom, write);
+			printf(" = ");
+			ao_scheme_poly_write(vals->vals[f].val, write);
+		}
+		frame = ao_scheme_poly_frame(frame->prev);
+		ao_scheme_frame_indent(0);
+		putchar('}');
+	}
+	if (ao_scheme_print_stop()) {
+		while (written--) {
+			ao_scheme_print_clear_addr(clear);
+			clear = ao_scheme_poly_frame(clear->prev);
 		}
 	}
-	printf("}");
 }
 
 static int
diff --git a/src/scheme/ao_scheme_int.c b/src/scheme/ao_scheme_int.c
index 4fcf4931..01b571c0 100644
--- a/src/scheme/ao_scheme_int.c
+++ b/src/scheme/ao_scheme_int.c
@@ -15,9 +15,10 @@
 #include "ao_scheme.h"
 
 void
-ao_scheme_int_write(ao_poly p)
+ao_scheme_int_write(ao_poly p, bool write)
 {
 	int i = ao_scheme_poly_int(p);
+	(void) write;
 	printf("%d", i);
 }
 
@@ -76,10 +77,11 @@ const struct ao_scheme_type ao_scheme_bigint_type = {
 };
 
 void
-ao_scheme_bigint_write(ao_poly p)
+ao_scheme_bigint_write(ao_poly p, bool write)
 {
 	struct ao_scheme_bigint	*bi = ao_scheme_poly_bigint(p);
 
+	(void) write;
 	printf("%d", bi->value);
 }
 #endif /* AO_SCHEME_FEATURE_BIGINT */
diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c
index be87f4d1..e8ce0710 100644
--- a/src/scheme/ao_scheme_lambda.c
+++ b/src/scheme/ao_scheme_lambda.c
@@ -50,7 +50,7 @@ const struct ao_scheme_type ao_scheme_lambda_type = {
 };
 
 void
-ao_scheme_lambda_write(ao_poly poly)
+ao_scheme_lambda_write(ao_poly poly, bool write)
 {
 	struct ao_scheme_lambda	*lambda = ao_scheme_poly_lambda(poly);
 	struct ao_scheme_cons	*cons = ao_scheme_poly_cons(lambda->code);
@@ -59,7 +59,7 @@ ao_scheme_lambda_write(ao_poly poly)
 	printf("%s", ao_scheme_args_name(lambda->args));
 	while (cons) {
 		printf(" ");
-		ao_scheme_poly_write(cons->car);
+		ao_scheme_poly_write(cons->car, write);
 		cons = ao_scheme_poly_cons(cons->cdr);
 	}
 	printf(")");
diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c
index 51bb1269..79ba1bf1 100644
--- a/src/scheme/ao_scheme_make_const.c
+++ b/src/scheme/ao_scheme_make_const.c
@@ -220,7 +220,7 @@ ao_has_macro(ao_poly p)
 
 		list = cons->cdr;
 		p = AO_SCHEME_NIL;
-		while (list != AO_SCHEME_NIL && ao_scheme_poly_type(list) == AO_SCHEME_CONS) {
+		while (list != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(list)) {
 			cons = ao_scheme_poly_cons(list);
 			m = ao_has_macro(cons->car);
 			if (m) {
@@ -280,7 +280,7 @@ ao_scheme_read_eval_abort(void)
 		out = ao_scheme_eval(in);
 		if (ao_scheme_exception)
 			return 0;
-		ao_scheme_poly_write(out);
+		ao_scheme_poly_write(out, true);
 		putchar ('\n');
 	}
 	return 1;
@@ -446,7 +446,7 @@ main(int argc, char **argv)
 		if (val != AO_SCHEME_NIL) {
 			printf("error: function %s contains unresolved macro: ",
 			       ao_scheme_poly_atom(vals->vals[f].atom)->name);
-			ao_scheme_poly_write(val);
+			ao_scheme_poly_write(val, true);
 			printf("\n");
 			exit(1);
 		}
diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c
index 94275451..a336fdfe 100644
--- a/src/scheme/ao_scheme_mem.c
+++ b/src/scheme/ao_scheme_mem.c
@@ -1061,7 +1061,7 @@ ao_scheme_print_mark_addr(void *addr)
 #endif
 
 	if (!AO_SCHEME_IS_POOL(addr))
-		return 1;
+		return 0;
 
 	if (!ao_scheme_print_cleared) {
 		ao_scheme_print_cleared = 1;
@@ -1074,14 +1074,23 @@ ao_scheme_print_mark_addr(void *addr)
 	return 0;
 }
 
-int
-ao_scheme_print_mark_poly(ao_poly p)
+void
+ao_scheme_print_clear_addr(void *addr)
 {
-	uint8_t type = ao_scheme_poly_base_type(p);
+	int	offset;
 
-	if (type == AO_SCHEME_INT)
-		return 1;
-	return ao_scheme_print_mark_addr(ao_scheme_ref(p));
+#if DBG_MEM
+	if (ao_scheme_collecting)
+		ao_scheme_abort();
+#endif
+
+	if (!AO_SCHEME_IS_POOL(addr))
+		return;
+
+	if (!ao_scheme_print_cleared)
+		return;
+	offset = pool_offset(addr);
+	clear(ao_scheme_busy, offset);
 }
 
 /* Notes that printing has started */
@@ -1091,11 +1100,13 @@ ao_scheme_print_start(void)
 	ao_scheme_printing++;
 }
 
-/* Notes that printing has ended */
-void
+/* Notes that printing has ended. Returns 1 if printing is still going on */
+int
 ao_scheme_print_stop(void)
 {
 	ao_scheme_printing--;
-	if (ao_scheme_printing == 0)
-		ao_scheme_print_cleared = 0;
+	if (ao_scheme_printing != 0)
+		return 1;
+	ao_scheme_print_cleared = 0;
+	return 0;
 }
diff --git a/src/scheme/ao_scheme_poly.c b/src/scheme/ao_scheme_poly.c
index 70e577a2..25ac6d67 100644
--- a/src/scheme/ao_scheme_poly.c
+++ b/src/scheme/ao_scheme_poly.c
@@ -14,100 +14,41 @@
 
 #include "ao_scheme.h"
 
-struct ao_scheme_funcs {
-	void (*write)(ao_poly);
-	void (*display)(ao_poly);
-};
+static void ao_scheme_invalid_write(ao_poly p, bool write) {
+	printf("??? type %d poly 0x%04x ???", ao_scheme_poly_type (p), p);
+	(void) write;
+	ao_scheme_abort();
+}
 
-static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = {
-	[AO_SCHEME_CONS] = {
-		.write = ao_scheme_cons_write,
-		.display = ao_scheme_cons_display,
-	},
+static void (*const ao_scheme_write_funcs[AO_SCHEME_NUM_TYPE]) (ao_poly p, bool write) = {
+	[AO_SCHEME_CONS] = ao_scheme_cons_write,
 #ifdef AO_SCHEME_FEATURE_BIGINT
-	[AO_SCHEME_BIGINT] = {
-		.write = ao_scheme_bigint_write,
-		.display = ao_scheme_bigint_write,
-	},
+	[AO_SCHEME_BIGINT] = ao_scheme_bigint_write,
 #endif
-	[AO_SCHEME_INT] = {
-		.write = ao_scheme_int_write,
-		.display = ao_scheme_int_write,
-	},
-	[AO_SCHEME_ATOM] = {
-		.write = ao_scheme_atom_write,
-		.display = ao_scheme_atom_write,
-	},
-	[AO_SCHEME_BUILTIN] = {
-		.write = ao_scheme_builtin_write,
-		.display = ao_scheme_builtin_write,
-	},
-	[AO_SCHEME_FRAME] = {
-		.write = ao_scheme_frame_write,
-		.display = ao_scheme_frame_write,
-	},
-	[AO_SCHEME_FRAME_VALS] = {
-		.write = NULL,
-		.display = NULL,
-	},
-	[AO_SCHEME_LAMBDA] = {
-		.write = ao_scheme_lambda_write,
-		.display = ao_scheme_lambda_write,
-	},
-	[AO_SCHEME_STACK] = {
-		.write = ao_scheme_stack_write,
-		.display = ao_scheme_stack_write,
-	},
-	[AO_SCHEME_BOOL] = {
-		.write = ao_scheme_bool_write,
-		.display = ao_scheme_bool_write,
-	},
-	[AO_SCHEME_STRING] = {
-		.write = ao_scheme_string_write,
-		.display = ao_scheme_string_display,
-	},
+	[AO_SCHEME_INT] = ao_scheme_int_write,
+	[AO_SCHEME_ATOM] = ao_scheme_atom_write,
+	[AO_SCHEME_BUILTIN] = ao_scheme_builtin_write,
+	[AO_SCHEME_FRAME] = ao_scheme_frame_write,
+	[AO_SCHEME_FRAME_VALS] = ao_scheme_invalid_write,
+	[AO_SCHEME_LAMBDA] = ao_scheme_lambda_write,
+	[AO_SCHEME_STACK] = ao_scheme_stack_write,
+	[AO_SCHEME_BOOL] = ao_scheme_bool_write,
+	[AO_SCHEME_STRING] = ao_scheme_string_write,
 #ifdef AO_SCHEME_FEATURE_FLOAT
-	[AO_SCHEME_FLOAT] = {
-		.write = ao_scheme_float_write,
-		.display = ao_scheme_float_write,
-	},
+	[AO_SCHEME_FLOAT] = ao_scheme_float_write,
 #endif
 #ifdef AO_SCHEME_FEATURE_VECTOR
-	[AO_SCHEME_VECTOR] = {
-		.write = ao_scheme_vector_write,
-		.display = ao_scheme_vector_display
-	},
+	[AO_SCHEME_VECTOR] = ao_scheme_vector_write,
 #endif
 };
 
-static void ao_scheme_invalid_write(ao_poly p) {
-	printf("??? 0x%04x ???", p);
-	ao_scheme_abort();
-}
-
-static const struct ao_scheme_funcs ao_scheme_invalid_funcs = {
-	.write = ao_scheme_invalid_write,
-	.display = ao_scheme_invalid_write,
-};
-
-static const struct ao_scheme_funcs *
-funcs(ao_poly p)
+void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p, bool write)
 {
 	uint8_t	type = ao_scheme_poly_type(p);
 
 	if (type < AO_SCHEME_NUM_TYPE)
-		return &ao_scheme_funcs[type];
-	return &ao_scheme_invalid_funcs;
-}
-
-void (*ao_scheme_poly_write_func(ao_poly p))(ao_poly p)
-{
-	return funcs(p)->write;
-}
-
-void (*ao_scheme_poly_display_func(ao_poly p))(ao_poly p)
-{
-	return funcs(p)->display;
+		return ao_scheme_write_funcs[type];
+	return ao_scheme_invalid_write;
 }
 
 void *
diff --git a/src/scheme/ao_scheme_rep.c b/src/scheme/ao_scheme_rep.c
index 5b94d940..b35ba5b8 100644
--- a/src/scheme/ao_scheme_rep.c
+++ b/src/scheme/ao_scheme_rep.c
@@ -30,7 +30,7 @@ ao_scheme_read_eval_print(void)
 				break;
 			ao_scheme_exception = 0;
 		} else {
-			ao_scheme_poly_write(out);
+			ao_scheme_poly_write(out, true);
 			putchar ('\n');
 		}
 	}
diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c
index e062a093..e29e2b68 100644
--- a/src/scheme/ao_scheme_stack.c
+++ b/src/scheme/ao_scheme_stack.c
@@ -158,26 +158,35 @@ ao_scheme_stack_clear(void)
 }
 
 void
-ao_scheme_stack_write(ao_poly poly)
+ao_scheme_stack_write(ao_poly poly, bool write)
 {
-	struct ao_scheme_stack *s = ao_scheme_poly_stack(poly);
+	struct ao_scheme_stack 	*s = ao_scheme_poly_stack(poly);
+	struct ao_scheme_stack	*clear = s;
+	int			written = 0;
 
+	(void) write;
+	ao_scheme_print_start();
+	ao_scheme_frame_print_indent += 2;
 	while (s) {
-		if (s->type & AO_SCHEME_STACK_PRINT) {
+		if (ao_scheme_print_mark_addr(s)) {
 			printf("[recurse...]");
-			return;
+			break;
 		}
-		s->type |= AO_SCHEME_STACK_PRINT;
+		written++;
 		printf("\t[\n");
-		printf("\t\texpr:   "); ao_scheme_poly_write(s->list); printf("\n");
-		printf("\t\tstate:  %s\n", ao_scheme_state_names[s->state]);
-		ao_scheme_error_poly ("values: ", s->values, s->values_tail);
-		ao_scheme_error_poly ("sexprs: ", s->sexprs, AO_SCHEME_NIL);
-		ao_scheme_error_frame(2, "frame:  ", ao_scheme_poly_frame(s->frame));
+		ao_scheme_printf("\t\texpr:     %v\n", s->list);
+		ao_scheme_printf("\t\tvalues:   %v\n", s->values);
+		ao_scheme_printf("\t\tframe:    %v\n", s->frame);
 		printf("\t]\n");
-		s->type &= ~AO_SCHEME_STACK_PRINT;
 		s = ao_scheme_poly_stack(s->prev);
 	}
+	ao_scheme_frame_print_indent -= 2;
+	if (ao_scheme_print_stop()) {
+		while (written--) {
+			ao_scheme_print_clear_addr(clear);
+			clear = ao_scheme_poly_stack(clear->prev);
+		}
+	}
 }
 
 /*
diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c
index e18a8e85..b00ef276 100644
--- a/src/scheme/ao_scheme_string.c
+++ b/src/scheme/ao_scheme_string.c
@@ -173,42 +173,36 @@ ao_scheme_string_unpack(struct ao_scheme_string *a)
 }
 
 void
-ao_scheme_string_write(ao_poly p)
+ao_scheme_string_write(ao_poly p, bool write)
 {
 	struct ao_scheme_string	*s = ao_scheme_poly_string(p);
 	char			*sval = s->val;
 	char			c;
 
-	putchar('"');
-	while ((c = *sval++)) {
-		switch (c) {
-		case '\n':
-			printf ("\\n");
-			break;
-		case '\r':
-			printf ("\\r");
-			break;
-		case '\t':
-			printf ("\\t");
-			break;
-		default:
-			if (c < ' ')
-				printf("\\%03o", c);
-			else
-				putchar(c);
-			break;
+	if (write) {
+		putchar('"');
+		while ((c = *sval++)) {
+			switch (c) {
+			case '\n':
+				printf ("\\n");
+				break;
+			case '\r':
+				printf ("\\r");
+				break;
+			case '\t':
+				printf ("\\t");
+				break;
+			default:
+				if (c < ' ')
+					printf("\\%03o", c);
+				else
+					putchar(c);
+				break;
+			}
 		}
+		putchar('"');
+	} else {
+		while ((c = *sval++))
+			putchar(c);
 	}
-	putchar('"');
-}
-
-void
-ao_scheme_string_display(ao_poly p)
-{
-	struct ao_scheme_string	*s = ao_scheme_poly_string(p);
-	char			*sval = s->val;
-	char			c;
-
-	while ((c = *sval++))
-		putchar(c);
 }
diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c
index ff2067e2..419d6765 100644
--- a/src/scheme/ao_scheme_vector.c
+++ b/src/scheme/ao_scheme_vector.c
@@ -73,39 +73,27 @@ ao_scheme_vector_alloc(uint16_t length, ao_poly fill)
 }
 
 void
-ao_scheme_vector_write(ao_poly v)
+ao_scheme_vector_write(ao_poly v, bool write)
 {
 	struct ao_scheme_vector	*vector = ao_scheme_poly_vector(v);
 	unsigned int i;
+	int was_marked = 0;
 
 	ao_scheme_print_start();
-	if (ao_scheme_print_mark_addr(vector))
+	was_marked = ao_scheme_print_mark_addr(vector);
+	if (was_marked) {
 		printf ("...");
-	else {
+	} else {
 		printf("#(");
 		for (i = 0; i < vector->length; i++) {
 			if (i != 0)
 				printf(" ");
-			ao_scheme_poly_write(vector->vals[i]);
+			ao_scheme_poly_write(vector->vals[i], write);
 		}
 		printf(")");
 	}
-	ao_scheme_print_stop();
-}
-
-void
-ao_scheme_vector_display(ao_poly v)
-{
-	struct ao_scheme_vector *vector = ao_scheme_poly_vector(v);
-	unsigned int i;
-
-	ao_scheme_print_start();
-	if (ao_scheme_print_mark_addr(vector))
-		printf ("...");
-	else {
-		for (i = 0; i < vector->length; i++)
-			ao_scheme_poly_display(vector->vals[i]);
-	}
+	if (ao_scheme_print_stop() && !was_marked)
+		ao_scheme_print_clear_addr(vector);
 }
 
 static int32_t
-- 
cgit v1.2.3


From 34f998d147d08e966daad1ab76c40906018d3d8d Mon Sep 17 00:00:00 2001
From: Keith Packard <keithp@keithp.com>
Date: Tue, 19 Dec 2017 11:51:33 -0800
Subject: altos/scheme: AO_SCHEME_IS_CONS -> ao_scheme_is_cons

This inline was already defined; just use it. Also, switch some places
to use ao_scheme_is_pair instead as appropriate.

Signed-off-by: Keith Packard <keithp@keithp.com>
---
 src/scheme/ao_scheme.h            |  2 --
 src/scheme/ao_scheme_builtin.c    |  4 ++--
 src/scheme/ao_scheme_cons.c       | 10 +++++-----
 src/scheme/ao_scheme_eval.c       |  4 ++--
 src/scheme/ao_scheme_make_const.c |  2 +-
 5 files changed, 10 insertions(+), 12 deletions(-)

(limited to 'src/scheme/ao_scheme_make_const.c')

diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h
index 5b31c623..b8e683fb 100644
--- a/src/scheme/ao_scheme.h
+++ b/src/scheme/ao_scheme.h
@@ -157,8 +157,6 @@ ao_scheme_is_const(ao_poly poly) {
 
 #define AO_SCHEME_IS_CONST(a)	(ao_scheme_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_const + AO_SCHEME_POOL_CONST)
 #define AO_SCHEME_IS_POOL(a)	(ao_scheme_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_scheme_pool + AO_SCHEME_POOL)
-#define AO_SCHEME_IS_INT(p)	(ao_scheme_poly_base_type(p) == AO_SCHEME_INT)
-#define AO_SCHEME_IS_CONS(p)	(ao_scheme_poly_base_type(p) == AO_SCHEME_CONS)
 
 void *
 ao_scheme_ref(ao_poly poly);
diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index f4dff5bf..84382434 100644
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -856,7 +856,7 @@ ao_scheme_do_pairp(struct ao_scheme_cons *cons)
 	if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))
 		return AO_SCHEME_NIL;
 	v = ao_scheme_arg(cons, 0);
-	if (v != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(v))
+	if (ao_scheme_is_pair(v))
 		return _ao_scheme_bool_true;
 	return _ao_scheme_bool_false;
 }
@@ -947,7 +947,7 @@ ao_scheme_do_listp(struct ao_scheme_cons *cons)
 	for (;;) {
 		if (v == AO_SCHEME_NIL)
 			return _ao_scheme_bool_true;
-		if (!AO_SCHEME_IS_CONS(v))
+		if (!ao_scheme_is_cons(v))
 			return _ao_scheme_bool_false;
 		v = ao_scheme_poly_cons(v)->cdr;
 	}
diff --git a/src/scheme/ao_scheme_cons.c b/src/scheme/ao_scheme_cons.c
index d40c2826..1a2de823 100644
--- a/src/scheme/ao_scheme_cons.c
+++ b/src/scheme/ao_scheme_cons.c
@@ -24,7 +24,7 @@ static void cons_mark(void *addr)
 		ao_scheme_poly_mark(cons->car, 1);
 		if (!cdr)
 			break;
-		if (!AO_SCHEME_IS_CONS(cdr)) {
+		if (!ao_scheme_is_cons(cdr)) {
 			ao_scheme_poly_mark(cdr, 0);
 			break;
 		}
@@ -58,7 +58,7 @@ static void cons_move(void *addr)
 		cdr = cons->cdr;
 		if (!cdr)
 			break;
-		if (!AO_SCHEME_IS_CONS(cdr)) {
+		if (!ao_scheme_is_cons(cdr)) {
 			(void) ao_scheme_poly_move(&cons->cdr, 0);
 			break;
 		}
@@ -111,7 +111,7 @@ ao_scheme_cons_cdr(struct ao_scheme_cons *cons)
 	ao_poly	cdr = cons->cdr;
 	if (cdr == AO_SCHEME_NIL)
 		return NULL;
-	if (!AO_SCHEME_IS_CONS(cdr)) {
+	if (!ao_scheme_is_cons(cdr)) {
 		(void) ao_scheme_error(AO_SCHEME_INVALID, "improper cdr %v", cdr);
 		return NULL;
 	}
@@ -151,7 +151,7 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons)
 			tail->cdr = ao_scheme_cons_poly(new);
 		tail = new;
 		cdr = cons->cdr;
-		if (!AO_SCHEME_IS_CONS(cdr)) {
+		if (!ao_scheme_is_cons(cdr)) {
 			tail->cdr = cdr;
 			break;
 		}
@@ -203,7 +203,7 @@ ao_scheme_cons_write(ao_poly c, bool write)
 		written++;
 
 		cdr = cons->cdr;
-		if (!AO_SCHEME_IS_CONS(cdr)) {
+		if (!ao_scheme_is_cons(cdr)) {
 			printf(" . ");
 			ao_scheme_poly_write(cdr, write);
 			break;
diff --git a/src/scheme/ao_scheme_eval.c b/src/scheme/ao_scheme_eval.c
index edc16a73..91f6a84f 100644
--- a/src/scheme/ao_scheme_eval.c
+++ b/src/scheme/ao_scheme_eval.c
@@ -348,7 +348,7 @@ ao_scheme_eval_cond(void)
 		ao_scheme_stack->state = eval_val;
 	} else {
 		ao_scheme_v = ao_scheme_poly_cons(ao_scheme_stack->sexprs)->car;
-		if (!ao_scheme_v || !AO_SCHEME_IS_CONS(ao_scheme_v)) {
+		if (!ao_scheme_is_pair(ao_scheme_v)) {
 			ao_scheme_error(AO_SCHEME_INVALID, "invalid cond clause");
 			return 0;
 		}
@@ -492,7 +492,7 @@ ao_scheme_eval_macro(void)
 
 	if (ao_scheme_v == AO_SCHEME_NIL)
 		ao_scheme_abort();
-	if (AO_SCHEME_IS_CONS(ao_scheme_v)) {
+	if (ao_scheme_is_cons(ao_scheme_v)) {
 		*ao_scheme_poly_cons(ao_scheme_stack->sexprs) = *ao_scheme_poly_cons(ao_scheme_v);
 		ao_scheme_v = ao_scheme_stack->sexprs;
 		DBGI("sexprs rewritten to: "); DBG_POLY(ao_scheme_v); DBG("\n");
diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c
index 79ba1bf1..e34792c4 100644
--- a/src/scheme/ao_scheme_make_const.c
+++ b/src/scheme/ao_scheme_make_const.c
@@ -220,7 +220,7 @@ ao_has_macro(ao_poly p)
 
 		list = cons->cdr;
 		p = AO_SCHEME_NIL;
-		while (list != AO_SCHEME_NIL && AO_SCHEME_IS_CONS(list)) {
+		while (ao_scheme_is_pair(list)) {
 			cons = ao_scheme_poly_cons(list);
 			m = ao_has_macro(cons->car);
 			if (m) {
-- 
cgit v1.2.3