altos/scheme: Add ports. Split scheme code up.

And lots of other changes, including freeing unreferenced atoms.

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

4 files changed, 75 insertions, 43 deletions

diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile
index 8858f0f6..686d809b 100644
--- a/src/scheme/test/Makefile
+++ b/src/scheme/test/Makefile
@@ -23,7 +23,7 @@ ao-scheme: $(OBJS)
 $(OBJS): $(HDRS)
 
 ao_scheme_const.h: ao_scheme_make_const $(SCHEME_SCHEME)
-	$^ -o $@
+	$^ -o $@ -d GPIO
 
 clean::
 	rm -f $(OBJS) ao-scheme ao_scheme_const.h
diff --git a/src/scheme/test/ao_scheme_os.h b/src/scheme/test/ao_scheme_os.h
index b225b2e8..9836d534 100644
--- a/src/scheme/test/ao_scheme_os.h
+++ b/src/scheme/test/ao_scheme_os.h
@@ -23,14 +23,6 @@
 #include <time.h>
 
 #define AO_SCHEME_POOL_TOTAL	32768
-#define AO_SCHEME_SAVE		1
-
-extern int ao_scheme_getc(void);
-
-static inline void
-ao_scheme_os_flush(void) {
-	fflush(stdout);
-}
 
 static inline void
 ao_scheme_abort(void)
@@ -38,12 +30,6 @@ ao_scheme_abort(void)
 	abort();
 }
 
-static inline void
-ao_scheme_os_led(int led)
-{
-	printf("leds set to 0x%x\n", led);
-}
-
 #define AO_SCHEME_JIFFIES_PER_SECOND	100
 
 static inline void
diff --git a/src/scheme/test/ao_scheme_test.c b/src/scheme/test/ao_scheme_test.c
index 45068369..ed10d3be 100644
--- a/src/scheme/test/ao_scheme_test.c
+++ b/src/scheme/test/ao_scheme_test.c
@@ -14,9 +14,8 @@
 
 #include "ao_scheme.h"
 #include <stdio.h>
-
-static FILE *ao_scheme_file;
-static int newline = 1;
+#include <unistd.h>
+#include <getopt.h>
 
 static char save_file[] = "scheme.image";
 
@@ -69,43 +68,86 @@ ao_scheme_os_restore(void)
 	return 1;
 }
 
-int
-ao_scheme_getc(void)
+static const struct option options[] = {
+	{ .name = "load", .has_arg = 1, .val = 'l' },
+	{ 0, 0, 0, 0 },
+};
+
+static void usage(char *program)
 {
-	int c;
+	fprintf(stderr, "usage: %s [--load=<library> ...] <program ...>\n", program);
+}
 
-	if (ao_scheme_file)
-		return getc(ao_scheme_file);
+static void
+check_exit(ao_poly v)
+{
+	if (ao_scheme_exception & AO_SCHEME_EXIT) {
+		int	ret;
+
+		if (v == _ao_scheme_bool_true)
+			ret = 0;
+		else {
+			ret = 1;
+			if (ao_scheme_is_integer(v))
+				ret = ao_scheme_poly_integer(v);
+		}
+		exit(ret);
+	}
+}
 
-	if (newline) {
-		if (ao_scheme_read_list)
-			printf("+ ");
-		else
-			printf("> ");
-		newline = 0;
+static void
+run_file(char *name)
+{
+	FILE	*in;
+	int 	c;
+	ao_poly	v;
+
+	in = fopen(name, "r");
+	if (!in) {
+		perror(name);
+		exit(1);
 	}
-	c = getchar();
-	if (c == '\n')
-		newline = 1;
-	return c;
+	c = getc(in);
+	if (c == '#') {
+		do {
+			c = getc(in);
+		} while (c != EOF && c != '\n');
+	} else {
+		ungetc(c, in);
+	}
+	v = ao_scheme_read_eval_print(in, NULL, false);
+	fclose(in);
+	check_exit(v);
 }
 
 int
 main (int argc, char **argv)
 {
-	(void) argc;
-
-	while (*++argv) {
-		ao_scheme_file = fopen(*argv, "r");
-		if (!ao_scheme_file) {
-			perror(*argv);
+	int	o;
+
+	while ((o = getopt_long(argc, argv, "?l:", options, NULL)) != -1) {
+		switch (o) {
+		case '?':
+			usage(argv[0]);
+			exit(0);
+		case 'l':
+			ao_scheme_set_argv(&argv[argc]);
+			run_file(optarg);
+			break;
+		default:
+			usage(argv[0]);
 			exit(1);
 		}
-		ao_scheme_read_eval_print();
-		fclose(ao_scheme_file);
-		ao_scheme_file = NULL;
 	}
-	ao_scheme_read_eval_print();
+	ao_scheme_set_argv(argv + optind);
+	if (argv[optind]) {
+		run_file(argv[optind]);
+	} else {
+		ao_poly v;
+		v = ao_scheme_read_eval_print(stdin, stdout, true);
+		check_exit(v);
+		putchar('\n');
+	}
 
 #ifdef DBG_MEM_STATS
 	printf ("collects: full: %lu incremental %lu\n",
@@ -138,4 +180,5 @@ main (int argc, char **argv)
 	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] /
 	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]);
 #endif
+	return 0;
 }
diff --git a/src/scheme/test/hanoi.scheme b/src/scheme/test/hanoi.scheme
index c4ae7378..0180de1e 100644..100755
--- a/src/scheme/test/hanoi.scheme
+++ b/src/scheme/test/hanoi.scheme
@@ -1,3 +1,4 @@
+#!/home/keithp/bin/ao-scheme
 ;
 ; Towers of Hanoi
 ;
@@ -172,3 +173,5 @@
   (_hanoi len 0 1 2)
   #t
   )
+
+(unless (null? (command-line)) (hanoi 6))