summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lambdakey-v1.0/.gitignore1
-rw-r--r--src/lambdakey-v1.0/Makefile20
-rw-r--r--src/lambdakey-v1.0/ao_lambdakey.c4
-rw-r--r--src/lambdakey-v1.0/ao_lambdakey_const.scheme389
-rw-r--r--src/lambdakey-v1.0/ao_pins.h2
-rw-r--r--src/lambdakey-v1.0/ao_scheme_os.h8
-rw-r--r--src/lambdakey-v1.0/lambda.ld13
7 files changed, 414 insertions, 23 deletions
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 <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.
+;
+; 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 <condition> <if-true>)
+ ; (if <condition> <if-true> <if-false)
+
+(define if
+ (macro (test . args)
+ (cond ((null? (cdr args))
+ (list cond (list test (car args)))
+ )
+ (else
+ (list cond
+ (list test (car args))
+ (list 'else (cadr args))
+ )
+ )
+ )
+ )
+ )
+
+(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);
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 16:40:07 +0000