altos/scheme: Move scheme test program to scheme sub-directory

Keeps it away from the usual test setup

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

7 files changed, 237 insertions, 217 deletions

diff --git a/src/scheme/Makefile b/src/scheme/Makefile
index d8e4b553..e3174be8 100644
--- a/src/scheme/Makefile
+++ b/src/scheme/Makefile
@@ -1,7 +1,8 @@
-all: ao_scheme_builtin.h ao_scheme_const.h
+all: ao_scheme_builtin.h ao_scheme_const.h test/ao_scheme_test
 
 clean:
 	+cd make-const && make clean
+	+cd test && make clean
 	rm -f ao_scheme_const.h ao_scheme_builtin.h
 
 ao_scheme_const.h: ao_scheme_const.lisp make-const/ao_scheme_make_const
@@ -13,4 +14,7 @@ ao_scheme_builtin.h: ao_scheme_make_builtin ao_scheme_builtin.txt
 make-const/ao_scheme_make_const: FRC
 	+cd make-const && make ao_scheme_make_const
 
+test/ao_scheme_test: FRC ao_scheme_const.h ao_scheme_builtin.h
+	+cd test && make ao_scheme_test
+
 FRC:
diff --git a/src/scheme/test/.gitignore b/src/scheme/test/.gitignore
new file mode 100644
index 00000000..3cdae594
--- /dev/null
+++ b/src/scheme/test/.gitignore
@@ -0,0 +1 @@
+ao_scheme_test
diff --git a/src/test/ao_scheme_os.h b/src/scheme/test/ao_scheme_os.h
index ebd16bb4..09a945bc 100644
--- a/src/test/ao_scheme_os.h
+++ b/src/scheme/test/ao_scheme_os.h
@@ -15,54 +15,54 @@
  * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
  */
 
-#ifndef _AO_LISP_OS_H_
-#define _AO_LISP_OS_H_
+#ifndef _AO_SCHEME_OS_H_
+#define _AO_SCHEME_OS_H_
 
 #include <stdio.h>
 #include <stdlib.h>
 #include <time.h>
 
-#define AO_LISP_POOL_TOTAL	16384
-#define AO_LISP_SAVE		1
+#define AO_SCHEME_POOL_TOTAL	16384
+#define AO_SCHEME_SAVE		1
 #define DBG_MEM_STATS		1
 
-extern int ao_lisp_getc(void);
+extern int ao_scheme_getc(void);
 
 static inline void
-ao_lisp_os_flush() {
+ao_scheme_os_flush() {
 	fflush(stdout);
 }
 
 static inline void
-ao_lisp_abort(void)
+ao_scheme_abort(void)
 {
 	abort();
 }
 
 static inline void
-ao_lisp_os_led(int led)
+ao_scheme_os_led(int led)
 {
 	printf("leds set to 0x%x\n", led);
 }
 
-#define AO_LISP_JIFFIES_PER_SECOND	100
+#define AO_SCHEME_JIFFIES_PER_SECOND	100
 
 static inline void
-ao_lisp_os_delay(int jiffies)
+ao_scheme_os_delay(int jiffies)
 {
 	struct timespec ts = {
-		.tv_sec = jiffies / AO_LISP_JIFFIES_PER_SECOND,
-		.tv_nsec = (jiffies % AO_LISP_JIFFIES_PER_SECOND) * (1000000000L / AO_LISP_JIFFIES_PER_SECOND)
+		.tv_sec = jiffies / AO_SCHEME_JIFFIES_PER_SECOND,
+		.tv_nsec = (jiffies % AO_SCHEME_JIFFIES_PER_SECOND) * (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND)
 	};
 	nanosleep(&ts, NULL);
 }
 
 static inline int
-ao_lisp_os_jiffy(void)
+ao_scheme_os_jiffy(void)
 {
 	struct timespec tp;
 	clock_gettime(CLOCK_MONOTONIC, &tp);
-	return tp.tv_sec * AO_LISP_JIFFIES_PER_SECOND + (tp.tv_nsec / (1000000000L / AO_LISP_JIFFIES_PER_SECOND));
+	return tp.tv_sec * AO_SCHEME_JIFFIES_PER_SECOND + (tp.tv_nsec / (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND));
 }
 
 #endif
diff --git a/src/scheme/test/ao_scheme_test.c b/src/scheme/test/ao_scheme_test.c
new file mode 100644
index 00000000..15c71203
--- /dev/null
+++ b/src/scheme/test/ao_scheme_test.c
@@ -0,0 +1,139 @@
+/*
+ * 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_scheme.h"
+#include <stdio.h>
+
+static FILE *ao_scheme_file;
+static int newline = 1;
+
+static char save_file[] = "scheme.image";
+
+int
+ao_scheme_os_save(void)
+{
+	FILE	*save = fopen(save_file, "w");
+
+	if (!save) {
+		perror(save_file);
+		return 0;
+	}
+	fwrite(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, save);
+	fclose(save);
+	return 1;
+}
+
+int
+ao_scheme_os_restore_save(struct ao_scheme_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_scheme_os_save), 1, restore);
+	fclose(restore);
+	if (ret != 1)
+		return 0;
+	return 1;
+}
+
+int
+ao_scheme_os_restore(void)
+{
+	FILE	*restore = fopen(save_file, "r");
+	size_t	ret;
+
+	if (!restore) {
+		perror(save_file);
+		return 0;
+	}
+	ret = fread(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, restore);
+	fclose(restore);
+	if (ret != AO_SCHEME_POOL_TOTAL)
+		return 0;
+	return 1;
+}
+
+int
+ao_scheme_getc(void)
+{
+	int c;
+
+	if (ao_scheme_file)
+		return getc(ao_scheme_file);
+
+	if (newline) {
+		if (ao_scheme_read_stack)
+			printf("+ ");
+		else
+			printf("> ");
+		newline = 0;
+	}
+	c = getchar();
+	if (c == '\n')
+		newline = 1;
+	return c;
+}
+
+int
+main (int argc, char **argv)
+{
+	(void) argc;
+
+	while (*++argv) {
+		ao_scheme_file = fopen(*argv, "r");
+		if (!ao_scheme_file) {
+			perror(*argv);
+			exit(1);
+		}
+		ao_scheme_read_eval_print();
+		fclose(ao_scheme_file);
+		ao_scheme_file = NULL;
+	}
+	ao_scheme_read_eval_print();
+
+	printf ("collects: full: %d incremental %d\n",
+		ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
+		ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
+
+	printf ("freed: full %d incremental %d\n",
+		ao_scheme_freed[AO_SCHEME_COLLECT_FULL],
+		ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL]);
+
+	printf("loops: full %d incremental %d\n",
+		ao_scheme_loops[AO_SCHEME_COLLECT_FULL],
+		ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]);
+
+	printf("loops per collect: full %f incremental %f\n",
+	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL] /
+	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
+	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL] /
+	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
+
+	printf("freed per collect: full %f incremental %f\n",
+	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] /
+	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL],
+	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] /
+	       (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]);
+
+	printf("freed per loop: full %f incremental %f\n",
+	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] /
+	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL],
+	       (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] /
+	       (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]);
+}
diff --git a/src/test/hanoi.lisp b/src/scheme/test/hanoi.scheme
index 4afde883..c4ae7378 100644
--- a/src/test/hanoi.lisp
+++ b/src/scheme/test/hanoi.scheme
@@ -29,17 +29,50 @@
   (display str)
   )
 
-					; Here's the pieces to display
+(define (make-piece num max)
+					; A piece for position 'num'
+					; is num + 1 + num stars
+					; centered in a field of max *
+					; 2 + 1 characters with spaces
+					; on either side. This way,
+					; every piece is the same
+					; number of characters
+
+  (define (chars n c)
+    (if (zero? n) ""
+      (+ c (chars (- n 1) c))
+      )
+    )
+  (+ (chars (- max num 1) " ")
+     (chars (+ (* num 2) 1) "*")
+     (chars (- max num 1) " ")
+     )
+  )
+
+(define (make-pieces max)
+					; Make a list of numbers from 0 to max-1
+  (define (nums cur max)
+    (if (= cur max) ()
+      (cons cur (nums (+ cur 1) max))
+      )
+    )
+					; Create a list of pieces
 
-(define tower '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
+  (map (lambda (x) (make-piece x max)) (nums 0 max))
+  )
 
 					; Here's all of the towers of pieces
 					; This is generated when the program is run
 
 (define towers ())
 
-(define (one- x) (- x 1))
-(define (one+ x) (+ x 1))
+					; position of the bottom of
+					; the stacks set at runtime
+(define bottom-y 0)
+(define left-x 0)
+
+(define move-delay 25)
+
 					; Display one tower, clearing any
 					; space above it
 
@@ -47,13 +80,13 @@
   (cond ((= 0 clear)
 	 (cond ((not (null? tower))
 		(display-string x y (car tower))
-		(display-tower x (one+ y) 0 (cdr tower))
+		(display-tower x (+ y 1) 0 (cdr tower))
 		)
 	       )
 	 )
 	(else 
-	 (display-string x y "                   ")
-	 (display-tower x (one+ y) (one- clear) tower)
+	 (display-string x y "                    ")
+	 (display-tower x (+ y 1) (- clear 1) tower)
 	 )
 	)
   )
@@ -61,76 +94,68 @@
 					; Position of the top of the tower on the screen
 					; Shorter towers start further down the screen
 
-(define (tower-pos y tower)
-  (- y (length tower))
+(define (tower-pos tower)
+  (- bottom-y (length tower))
   )
 
 					; Display all of the towers, spaced 20 columns apart
 
-(define (display-towers x y towers)
+(define (display-towers x towers)
   (cond ((not (null? towers))
-	 (display-tower x 0 (tower-pos y (car towers)) (car towers))
-	 (display-towers (+ x 20) y (cdr towers)))
+	 (display-tower x 0 (tower-pos (car towers)) (car towers))
+	 (display-towers (+ x 20) (cdr towers)))
 	)
   )
 
-(define top 0)
 					; Display all of the towers, then move the cursor
 					; out of the way and flush the output
 
 (define (display-hanoi)
-  (display-towers 0 top towers)
-  (move-to 1 21)
+  (display-towers left-x towers)
+  (move-to 1 23)
   (flush-output)
+  (delay move-delay)
   )
 
 					; Reset towers to the starting state, with
 					; all of the pieces in the first tower and the
 					; other two empty
 
-(define (reset-towers)
-  (set! towers (list tower () ()))
-  (set! top (+ (length tower) 3))
-  (length tower)
-  )
-
-					; Replace a tower in the list of towers
-					; with a new value
-
-(define (replace list pos member)
-  (cond ((= pos 0) (cons member (cdr list)))
-	(else (cons (car list) (replace (cdr list) (one- pos) member)))
-	)
+(define (reset-towers len)
+  (set! towers (list (make-pieces len) () ()))
+  (set! bottom-y (+ len 3))
   )
 
 					; Move a piece from the top of one tower
 					; to the top of another
 
-(define move-delay 10)
-
 (define (move-piece from to)
-  (let* ((from-tower (list-ref towers from))
-	 (to-tower (list-ref towers to))
-	 (piece (car from-tower)))
-    (set! from-tower (cdr from-tower))
-    (set! to-tower (cons piece to-tower))
-    (set! towers (replace towers from from-tower))
-    (set! towers (replace towers to to-tower))
-    (display-hanoi)
-    (delay move-delay)
-    )
+
+					; references to the cons holding the two towers
+
+  (define from-tower (list-tail towers from))
+  (define to-tower (list-tail towers to))
+
+					; stick the car of from-tower onto to-tower
+
+  (set-car! to-tower (cons (caar from-tower) (car to-tower)))
+
+					; remove the car of from-tower
+
+  (set-car! from-tower (cdar from-tower))
   )
 
-; The implementation of the game
+					; The implementation of the game
 
 (define (_hanoi n from to use)
   (cond ((= 1 n)
 	 (move-piece from to)
+	 (display-hanoi)
 	 )
 	(else
-	 (_hanoi (one- n) from use to)
+	 (_hanoi (- n 1) from use to)
 	 (_hanoi 1 from to use)
-	 (_hanoi (one- n) use to from)
+	 (_hanoi (- n 1) use to from)
 	 )
 	)
   )
@@ -140,12 +165,10 @@
 					; clears the screen and runs
 					; the program
 
-(define (hanoi)
-  (let ((len (reset-towers)))
-    (clear)
-    (_hanoi len 0 1 2)
-    (move-to 0 23)
-    #t
-    )
-  )
+(define (hanoi len)
+  (reset-towers len)
+  (clear)
+  (display-hanoi)
+  (_hanoi len 0 1 2)
+  #t
   )
diff --git a/src/test/Makefile b/src/test/Makefile
index 4ac2c893..7bd13db9 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -1,13 +1,13 @@
 vpath %.o .
-vpath %.c ..:../kernel:../drivers:../util:../micropeak:../aes:../product:../lisp
-vpath %.h ..:../kernel:../drivers:../util:../micropeak:../aes:../product:../lisp
-vpath make-kalman ..:../kernel:../drivers:../util:../micropeak:../aes:../product:../lisp
+vpath %.c ..:../kernel:../drivers:../util:../micropeak:../aes:../product
+vpath %.h ..:../kernel:../drivers:../util:../micropeak:../aes:../product
+vpath make-kalman ..:../kernel:../drivers:../util:../micropeak:../aes:../product
 
 PROGS=ao_flight_test ao_flight_test_baro ao_flight_test_accel ao_flight_test_noisy_accel ao_flight_test_mm \
 	ao_flight_test_metrum ao_flight_test_mini \
 	ao_gps_test ao_gps_test_skytraq ao_gps_test_ublox ao_convert_test ao_convert_pa_test ao_fec_test \
 	ao_aprs_test ao_micropeak_test ao_fat_test ao_aes_test ao_int64_test \
-	ao_ms5607_convert_test ao_quaternion_test ao_lisp_test
+	ao_ms5607_convert_test ao_quaternion_test
 
 INCS=ao_kalman.h ao_ms5607.h ao_log.h ao_data.h altitude-pa.h altitude.h ao_quaternion.h ao_eeprom_read.h
 TEST_SRC=ao_flight_test.c
@@ -97,16 +97,3 @@ ao_ms5607_convert_test: ao_ms5607_convert_test.c ao_ms5607_convert_8051.c ao_int
 ao_quaternion_test: ao_quaternion_test.c ao_quaternion.h
 	cc $(CFLAGS) -o $@ ao_quaternion_test.c -lm
 
-include ../lisp/Makefile-inc
-
-AO_LISP_SRCS=$(LISP_SRCS) ao_lisp_test.c
-
-AO_LISP_OBJS=$(AO_LISP_SRCS:.c=.o)
-
-ao_lisp_test: $(AO_LISP_OBJS)
-	cc $(CFLAGS) -o $@ $(AO_LISP_OBJS) -lm
-
-$(AO_LISP_OBJS): $(LISP_HDRS) ao_lisp_const.h
-
-clean::
-	rm -f $(AO_LISP_OBJS)
diff --git a/src/test/ao_scheme_test.c b/src/test/ao_scheme_test.c
deleted file mode 100644
index 68e3a202..00000000
--- a/src/test/ao_scheme_test.c
+++ /dev/null
@@ -1,134 +0,0 @@
-/*
- * 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"
-#include <stdio.h>
-
-static FILE *ao_lisp_file;
-static int newline = 1;
-
-static char save_file[] = "lisp.image";
-
-int
-ao_lisp_os_save(void)
-{
-	FILE	*save = fopen(save_file, "w");
-
-	if (!save) {
-		perror(save_file);
-		return 0;
-	}
-	fwrite(ao_lisp_pool, 1, AO_LISP_POOL_TOTAL, save);
-	fclose(save);
-	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)
-{
-	FILE	*restore = fopen(save_file, "r");
-	size_t	ret;
-
-	if (!restore) {
-		perror(save_file);
-		return 0;
-	}
-	ret = fread(ao_lisp_pool, 1, AO_LISP_POOL_TOTAL, restore);
-	fclose(restore);
-	if (ret != AO_LISP_POOL_TOTAL)
-		return 0;
-	return 1;
-}
-
-int
-ao_lisp_getc(void)
-{
-	int c;
-
-	if (ao_lisp_file)
-		return getc(ao_lisp_file);
-
-	if (newline) {
-		printf("> ");
-		newline = 0;
-	}
-	c = getchar();
-	if (c == '\n')
-		newline = 1;
-	return c;
-}
-
-int
-main (int argc, char **argv)
-{
-	while (*++argv) {
-		ao_lisp_file = fopen(*argv, "r");
-		if (!ao_lisp_file) {
-			perror(*argv);
-			exit(1);
-		}
-		ao_lisp_read_eval_print();
-		fclose(ao_lisp_file);
-		ao_lisp_file = NULL;
-	}
-	ao_lisp_read_eval_print();
-
-	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]);
-
-	printf("loops: full %d incremental %d\n",
-		ao_lisp_loops[AO_LISP_COLLECT_FULL],
-		ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL]);
-
-	printf("loops per collect: full %f incremental %f\n",
-	       (double) ao_lisp_loops[AO_LISP_COLLECT_FULL] /
-	       (double) ao_lisp_collects[AO_LISP_COLLECT_FULL],
-	       (double) ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL] /
-	       (double) ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
-
-	printf("freed per collect: full %f incremental %f\n",
-	       (double) ao_lisp_freed[AO_LISP_COLLECT_FULL] /
-	       (double) ao_lisp_collects[AO_LISP_COLLECT_FULL],
-	       (double) ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL] /
-	       (double) ao_lisp_collects[AO_LISP_COLLECT_INCREMENTAL]);
-
-	printf("freed per loop: full %f incremental %f\n",
-	       (double) ao_lisp_freed[AO_LISP_COLLECT_FULL] /
-	       (double) ao_lisp_loops[AO_LISP_COLLECT_FULL],
-	       (double) ao_lisp_freed[AO_LISP_COLLECT_INCREMENTAL] /
-	       (double) ao_lisp_loops[AO_LISP_COLLECT_INCREMENTAL]);
-}