From 09ea349f5b37e257e8ca23ead493ba1694395530 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 12 Dec 2017 15:27:26 -0800 Subject: [PATCH] altos/lambdakey-v1.0: Get this building again The lambdakey can't hold a full implementation of the scheme interpreter, so use only a subset, removing floats, bigints and vectors. Also reduce the pre-loaded lisp code as well. It's pretty spare at this point; but it does fill the ROM. Signed-off-by: Keith Packard --- src/lambdakey-v1.0/.gitignore | 1 + src/lambdakey-v1.0/Makefile | 20 +- src/lambdakey-v1.0/ao_lambdakey.c | 4 +- src/lambdakey-v1.0/ao_lambdakey_const.scheme | 389 +++++++++++++++++++ src/lambdakey-v1.0/ao_pins.h | 2 + src/lambdakey-v1.0/ao_scheme_os.h | 8 +- src/lambdakey-v1.0/lambda.ld | 13 +- 7 files changed, 414 insertions(+), 23 deletions(-) create mode 100644 src/lambdakey-v1.0/ao_lambdakey_const.scheme diff --git a/src/lambdakey-v1.0/.gitignore b/src/lambdakey-v1.0/.gitignore index 6462d930..a57994e8 100644 --- a/src/lambdakey-v1.0/.gitignore +++ b/src/lambdakey-v1.0/.gitignore @@ -1,2 +1,3 @@ lambdakey-* ao_product.h +ao_scheme_const.h diff --git a/src/lambdakey-v1.0/Makefile b/src/lambdakey-v1.0/Makefile index 4eb045b6..bffe7d4f 100644 --- a/src/lambdakey-v1.0/Makefile +++ b/src/lambdakey-v1.0/Makefile @@ -20,6 +20,7 @@ INC = \ ao_product.h \ ao_task.h \ $(SCHEME_HDRS) \ + ao_scheme_const.h \ stm32f0.h \ Makefile @@ -27,20 +28,16 @@ ALTOS_SRC = \ ao_boot_chain.c \ ao_interrupt.c \ ao_product.c \ - ao_romconfig.c \ ao_cmd.c \ - ao_config.c \ - ao_task.c \ + ao_notask.c \ ao_led.c \ - ao_dma_stm.c \ ao_stdio.c \ - ao_mutex.c \ + ao_stdio_newlib.c \ ao_panic.c \ ao_timer.c \ ao_usb_stm.c \ - ao_flash_stm.c \ - $(SCHEME_SRCS) \ - ao_scheme_os_save.c + ao_romconfig.c \ + $(SCHEME_SRCS) PRODUCT=LambdaKey-v1.0 PRODUCT_DEF=-DLAMBDAKEY @@ -65,7 +62,7 @@ OBJ=$(SRC:.c=.o) all: $(PROG) $(HEX) -$(PROG): Makefile $(OBJ) lambda.ld altos.ld +$(PROG): Makefile $(OBJ) lambda.ld $(call quiet,CC) $(LDFLAGS) $(CFLAGS) -o $(PROG) $(OBJ) $(LIBS) $(OBJ): $(INC) @@ -73,13 +70,16 @@ $(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 + load: $(PROG) stm-load $(PROG) distclean: clean clean: - rm -f *.o $(PROGNAME)-*.elf $(PROGNAME)-*.ihx + rm -f *.o $(PROGNAME)-*.elf $(PROGNAME)-*.ihx ao_scheme_const.h rm -f ao_product.h install: diff --git a/src/lambdakey-v1.0/ao_lambdakey.c b/src/lambdakey-v1.0/ao_lambdakey.c index d0996eb4..73962e29 100644 --- a/src/lambdakey-v1.0/ao_lambdakey.c +++ b/src/lambdakey-v1.0/ao_lambdakey.c @@ -29,13 +29,11 @@ void main(void) { ao_led_init(LEDS_AVAILABLE); ao_clock_init(); - ao_task_init(); ao_timer_init(); - ao_dma_init(); ao_usb_init(); ao_cmd_init(); ao_cmd_register(blink_cmds); - ao_start_scheduler(); + ao_cmd(); } diff --git a/src/lambdakey-v1.0/ao_lambdakey_const.scheme b/src/lambdakey-v1.0/ao_lambdakey_const.scheme new file mode 100644 index 00000000..d0c0e578 --- /dev/null +++ b/src/lambdakey-v1.0/ao_lambdakey_const.scheme @@ -0,0 +1,389 @@ +; +; Copyright © 2016 Keith Packard +; +; 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. +; +; Lisp code placed in ROM + + ; return a list containing all of the arguments +(def (quote list) (lambda l l)) + +(def (quote def!) + (macro (a b) + (list + def + (list quote a) + b) + ) + ) + +(begin + (def! append + (lambda args + (def! a-l + (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (a-l (cdr a) b))) + ) + ) + ) + + (def! a-ls + (lambda (l) + (cond ((null? l) l) + ((null? (cdr l)) (car l)) + (else (a-l (car l) (a-ls (cdr l)))) + ) + ) + ) + (a-ls args) + ) + ) + 'append) + +(append '(a b c) '(d e f) '(g h i)) + + ; + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated. + ; + ; Also accepts the alternate + ; form for defining lambdas of + ; (define (name a y z) sexprs ...) + ; + +(begin + (def (quote define) + (macro (a . b) + ; check for alternate lambda definition form + + (cond ((list? a) + (set! b + (cons lambda (cons (cdr a) b))) + (set! a (car a)) + ) + (else + (set! b (car b)) + ) + ) + (cons begin + (cons + (cons def + (cons (cons quote (cons a '())) + (cons b '()) + ) + ) + (cons + (cons quote (cons a '())) + '()) + ) + ) + ) + ) + 'define + ) + + ; basic list accessors + +(define (caar l) (car (car l))) + +(define (cadr l) (car (cdr l))) + +(define (cdar l) (cdr (car l))) + +(define (caddr l) (car (cdr (cdr l)))) + + ; (if ) + ; (if 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + + ; simple math operators + +(define zero? (macro (value) (list eqv? value 0))) + +(zero? 1) +(zero? 0) +(zero? "hello") + +(define positive? (macro (value) (list > value 0))) + +(positive? 12) +(positive? -12) + +(define negative? (macro (value) (list < value 0))) + +(negative? 12) +(negative? -12) + +(define (abs a) (if (>= a 0) a (- a))) + +(abs 12) +(abs -12) + +(define max (lambda (a . b) + (while (not (null? b)) + (cond ((< a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(max 1 2 3) +(max 3 2 1) + +(define min (lambda (a . b) + (while (not (null? b)) + (cond ((> a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(min 1 2 3) +(min 3 2 1) + +(define (even? a) (zero? (% a 2))) + +(even? 2) +(even? -2) +(even? 3) +(even? -1) + +(define (odd? a) (not (even? a))) + +(odd? 2) +(odd? -2) +(odd? 3) +(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)) + ) + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a) (- b 1)))) + +(list-tail '(1 2 3) 2) + +(define (list-ref a b) (car (list-tail a b))) + +(list-ref '(1 2 3) 2) + + + ; define a set of local + ; variables one at a time and + ; then evaluate a list of + ; sexprs + ; + ; (let* (var-defines) sexprs) + ; + ; where var-defines are either + ; + ; (name value) + ; + ; or + ; + ; (name) + ; + ; e.g. + ; + ; (let* ((x 1) (y)) (set! y (+ x 1)) y) + +(define let* + (macro (a . b) + + ; + ; make the list of names in the let + ; + + (define (_n a) + (cond ((not (null? a)) + (cons (car (car a)) + (_n (cdr a)))) + (else ()) + ) + ) + + ; the set of expressions is + ; the list of set expressions + ; pre-pended to the + ; expressions to evaluate + + (define (_v a b) + (cond ((null? a) b) (else + (cons + (list set + (list quote + (car (car a)) + ) + (cond ((null? (cdr (car a))) ()) + (else (cadr (car a)))) + ) + (_v (cdr a) b) + ) + ) + ) + ) + + ; the parameters to the lambda is a list + ; of nils of the right length + + (define (_z a) + (cond ((null? a) ()) + (else (cons () (_z (cdr a)))) + ) + ) + ; build the lambda. + + (cons (cons lambda (cons (_n a) (_v a b))) (_z a)) + ) + ) + +(let* ((a 1) (y a)) (+ a y)) + +(define let let*) + ; recursive equality + +(define (equal? a b) + (cond ((eq? a b) #t) + ((pair? a) + (cond ((pair? b) + (cond ((equal? (car a) (car b)) + (equal? (cdr a) (cdr b))) + ) + ) + ) + ) + ) + ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b)) + +(define member (lambda (obj a . test?) + (cond ((null? a) + #f + ) + (else + (if (null? test?) (set! test? equal?) (set! test? (car test?))) + (if (test? obj (car a)) + a + (member obj (cdr a) test?)) + ) + ) + ) + ) + +(member '(2) '((1) (2) (3))) + +(member '(4) '((1) (2) (3))) + +(define (memq obj a) (member obj a eq?)) + +(memq 2 '(1 2 3)) + +(memq 4 '(1 2 3)) + +(memq '(2) '((1) (2) (3))) + +(define (_assoc a b t?) + (if (null? b) + #f + (if (t? a (caar b)) + (car b) + (_assoc a (cdr b) t?) + ) + ) + ) + +(define (assq a b) (_assoc a b eq?)) +(define (assoc a b) (_assoc a b equal?)) + +(assq 'a '((a 1) (b 2) (c 3))) +(assoc '(c) '((a 1) (b 2) ((c) 3))) + +(define string (lambda a (list->string a))) + +(display "apply\n") +(apply cons '(a b)) + +(define map + (lambda (a . b) + (define (args b) + (cond ((null? b) ()) + (else + (cons (caar b) (args (cdr b))) + ) + ) + ) + (define (next b) + (cond ((null? b) ()) + (else + (cons (cdr (car b)) (next (cdr b))) + ) + ) + ) + (define (domap b) + (cond ((null? (car b)) ()) + (else + (cons (apply a (args b)) (domap (next b))) + ) + ) + ) + (domap b) + ) + ) + +(map cadr '((a b) (d e) (g h))) + +(define for-each (lambda (a . b) + (apply map a b) + #t)) + +(for-each display '("hello" " " "world" "\n")) + +(define (newline) (write-char #\newline)) + +(newline) diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h index 2ba79c01..cb1c4aa7 100644 --- a/src/lambdakey-v1.0/ao_pins.h +++ b/src/lambdakey-v1.0/ao_pins.h @@ -19,6 +19,8 @@ #ifndef _AO_PINS_H_ #define _AO_PINS_H_ +#define HAS_TASK 0 + #define LED_PORT_ENABLE STM_RCC_AHBENR_IOPBEN #define LED_PORT (&stm_gpiob) #define LED_PIN_RED 4 diff --git a/src/lambdakey-v1.0/ao_scheme_os.h b/src/lambdakey-v1.0/ao_scheme_os.h index a620684f..0d48af3b 100644 --- a/src/lambdakey-v1.0/ao_scheme_os.h +++ b/src/lambdakey-v1.0/ao_scheme_os.h @@ -20,9 +20,13 @@ #include "ao.h" -#define AO_SCHEME_SAVE 1 +#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 2048 +#define AO_SCHEME_POOL 4096 +#define AO_SCHEME_TOKEN_MAX 64 #ifndef __BYTE_ORDER #define __LITTLE_ENDIAN 1234 diff --git a/src/lambdakey-v1.0/lambda.ld b/src/lambdakey-v1.0/lambda.ld index 5de65eb5..15b2d971 100644 --- a/src/lambdakey-v1.0/lambda.ld +++ b/src/lambdakey-v1.0/lambda.ld @@ -17,10 +17,9 @@ */ MEMORY { - rom (rx) : ORIGIN = 0x08001000, LENGTH = 25K - flash (r): ORIGIN = 0x08007400, LENGTH = 3k - ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 128 - stack (!w) : ORIGIN = 0x20000000 + 6k - 128, LENGTH = 128 + rom (rx) : ORIGIN = 0x08001000, LENGTH = 28K + ram (!w) : ORIGIN = 0x20000000, LENGTH = 6k - 480 + stack (!w) : ORIGIN = 0x20000000 + 6k - 480, LENGTH = 480 } INCLUDE registers.ld @@ -93,9 +92,9 @@ SECTIONS { /* Data -- relocated to RAM, but written to ROM */ - .data : { + .data BLOCK(8): { *(.data) /* initialized data */ - . = ALIGN(4); + . = ALIGN(8); __data_end__ = .; } >ram AT>rom @@ -110,8 +109,6 @@ SECTIONS { PROVIDE(end = .); PROVIDE(__stack__ = ORIGIN(stack) + LENGTH(stack)); - - __flash__ = ORIGIN(flash); } ENTRY(start); -- 2.30.2