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>

5 files changed, 40 insertions, 25 deletions

diff --git a/src/lambdakey-v1.0/Makefile b/src/lambdakey-v1.0/Makefile
index bffe7d4f..cfa009bb 100644
--- a/src/lambdakey-v1.0/Makefile
+++ b/src/lambdakey-v1.0/Makefile
@@ -7,6 +7,9 @@ include ../stmf0/Makefile.defs
 
 include ../scheme/Makefile-inc
 
+vpath %.scheme ../scheme
+vpath ao_scheme_make_const ../scheme/make-const
+
 NEWLIB_FULL=-lm -lc -lgcc
 
 LIBS=$(NEWLIB_FULL)
@@ -30,7 +33,6 @@ ALTOS_SRC = \
 	ao_product.c \
 	ao_cmd.c \
 	ao_notask.c \
-	ao_led.c \
 	ao_stdio.c \
 	ao_stdio_newlib.c \
 	ao_panic.c \
@@ -49,7 +51,7 @@ LDFLAGS=$(CFLAGS) -L$(TOPDIR)/stmf0 -Wl,-Tlambda.ld
 
 MAP=$(PROG).map
 NEWLIB=/local/newlib-mini
-MAPFILE=-Wl,-M=$(MAP)
+MAPFILE=-Wl,-Map=$(MAP)
 LDFLAGS=-L../stmf0 -L$(NEWLIB)/arm-none-eabi/lib/thumb/v6-m/ -Wl,-Tlambda.ld $(MAPFILE) -nostartfiles
 AO_CFLAGS=-I. -I../stmf0 -I../kernel -I../drivers -I.. -I../scheme -isystem $(NEWLIB)/arm-none-eabi/include -DNEWLIB
 
@@ -70,8 +72,8 @@ $(OBJ): $(INC)
 ao_product.h: ao-make-product.5c ../Version
 	$(call quiet,NICKLE,$<) $< -m altusmetrum.org -i $(IDPRODUCT) -p $(PRODUCT) -v $(VERSION) > $@
 
-ao_scheme_const.h: ../scheme/make-const/ao_scheme_make_const ao_lambdakey_const.scheme
-	../scheme/make-const/ao_scheme_make_const -d FLOAT,VECTOR,QUASI,BIGINT -o $@ ao_lambdakey_const.scheme
+ao_scheme_const.h: ao_scheme_make_const ao_scheme_basic_syntax.scheme ao_scheme_finish.scheme
+	$^ -o $@ -d GPIO,FLOAT,VECTOR,QUASI,BIGINT,POSIX,PORT,SAVE,UNDEF
 
 load: $(PROG)
 	stm-load $(PROG)
diff --git a/src/lambdakey-v1.0/ao_lambdakey.c b/src/lambdakey-v1.0/ao_lambdakey.c
index 73962e29..2bd626f1 100644
--- a/src/lambdakey-v1.0/ao_lambdakey.c
+++ b/src/lambdakey-v1.0/ao_lambdakey.c
@@ -16,7 +16,7 @@
 #include <ao_scheme.h>
 
 static void scheme_cmd() {
-	ao_scheme_read_eval_print();
+	ao_scheme_read_eval_print(stdin, stdout, true);
 }
 
 static const struct ao_cmds blink_cmds[] = {
@@ -27,7 +27,9 @@ static const struct ao_cmds blink_cmds[] = {
 
 void main(void)
 {
+#ifdef LEDS_AVAILABLE
 	ao_led_init(LEDS_AVAILABLE);
+#endif
 	ao_clock_init();
 	ao_timer_init();
 	ao_usb_init();
diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
index a912b8ae..a37e1a2b 100644
--- a/src/lambdakey-v1.0/ao_lambdakey_const.scheme
+++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme
@@ -185,7 +185,7 @@
 
 					; simple math operators
 
-(define zero? (macro (value) (list eqv? value 0)))
+(define zero? (macro (value) (list eq? value 0)))
 
 (zero? 1)
 (zero? 0)
@@ -247,13 +247,6 @@
 (odd? -1)
 
 
-(define (list-tail a b)
-  (if (zero? b)
-      a
-      (list-tail (cdr a) (- b 1))
-      )
-  )
-
 (define (list-ref a b)
   (car (list-tail a b))
   )
@@ -280,7 +273,7 @@
 					;
 					; (let* ((x 1) (y)) (set! y (+ x 1)) y)
 
-(define let*
+(define letrec
   (macro (a . b)
 
 					;
@@ -301,7 +294,8 @@
 					; expressions to evaluate
 
 	 (define (_v a b)
-	   (cond ((null? a) b)		 (else
+	   (cond ((null? a) b)
+		 (else
 		  (cons
 		   (list set
 			 (list quote
@@ -330,9 +324,10 @@
 	 )
      )
 
-(let* ((a 1) (y a)) (+ a y))
+(letrec ((a 1) (y a)) (+ a y))
 
-(define let let*)
+(define let letrec)
+(define let* letrec)
 					; recursive equality
 
 (define (equal? a b)
@@ -376,18 +371,21 @@
 
 (memq '(2) '((1) (2) (3)))
 
-(define (_as a b t?)
+(define (assoc a b . t?)
+  (if (null? t?)
+      (set! t? equal?)
+      (set! t? (car t?))
+      )
   (if (null? b)
       #f
     (if (t? a (caar b))
 	(car b)
-      (_as a (cdr b) t?)
+      (assoc a (cdr b) t?)
       )
     )
   )
 
-(define (assq a b) (_as a b eq?))
-(define (assoc a b) (_as a b equal?))
+(define (assq a b) (assoc a b eq?))
 
 (assq 'a '((a 1) (b 2) (c 3)))
 (assoc '(c) '((a 1) (b 2) ((c) 3)))
diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h
index 48b9db16..f330213d 100644
--- a/src/lambdakey-v1.0/ao_pins.h
+++ b/src/lambdakey-v1.0/ao_pins.h
@@ -19,23 +19,34 @@
 #ifndef _AO_PINS_H_
 #define _AO_PINS_H_
 
+#define fprintf(file, ...) 	({ (void) (file); printf(__VA_ARGS__); })
+#undef putc
+#define putc(c,file) 		({ (void) (file); putchar(c); })
+#define fputs(s,file) 		({ (void) (file); printf("%s", s); })
+#define puts(s) 		({ printf("%s\n", s); })
+#undef getc
+#define getc(file) 		({ (void) (file); getchar(); })
+
 #define HAS_TASK	0
 #define HAS_AO_DELAY	1
 
+#if 0
 #define LED_PORT_ENABLE	STM_RCC_AHBENR_IOPBEN
 #define LED_PORT	(&stm_gpiob)
 #define LED_PIN_RED	4
 #define AO_LED_RED	(1 << LED_PIN_RED)
 #define AO_LED_PANIC	AO_LED_RED
+#define LEDS_AVAILABLE	(AO_LED_RED)
+#endif
+
 #define AO_CMD_LEN	128
-#define AO_LISP_POOL_TOTAL	3072
-#define AO_LISP_SAVE	1
+#define AO_LISP_POOL	5120
 #define AO_STACK_SIZE	1024
 
+#if 0
 /* need HSI active to write to flash */
 #define AO_NEED_HSI	1
-
-#define LEDS_AVAILABLE	(AO_LED_RED)
+#endif
 
 #define AO_POWER_MANAGEMENT	0
 
diff --git a/src/lambdakey-v1.0/ao_scheme_os.h b/src/lambdakey-v1.0/ao_scheme_os.h
index b3080f31..5641b476 100644
--- a/src/lambdakey-v1.0/ao_scheme_os.h
+++ b/src/lambdakey-v1.0/ao_scheme_os.h
@@ -56,11 +56,13 @@ ao_scheme_abort(void)
 	ao_panic(1);
 }
 
+#ifdef LEDS_AVAILABLE
 static inline void
 ao_scheme_os_led(int led)
 {
 	ao_led_set(led);
 }
+#endif
 
 #define AO_SCHEME_JIFFIES_PER_SECOND	AO_HERTZ