kyle
/
ulisp
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

import ulisp-builder

This commit is contained in:
Kyle Isom 2025-04-10 23:36:48 -07:00
parent eb6afd4869
commit 641c9480c7
22 changed files with 19358 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
builder/LICENSE Normal file
View File

@ -0,0 +1,21 @@
MIT License
Copyright (c) 2021 David Johnson-Davies
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

35
builder/Load Builder.lisp Normal file
View File

@ -0,0 +1,35 @@
;; Options: :avr :avr-nano :arm :msp430 :esp :stm32 :badge :zero :riscv
(push :avr-nano *features*)
(defparameter *release* "4.7")
(defparameter *date* "5th November 2024")
;***************************************
#+badge
(push :avr *features*)
#+(or arm esp stm32 riscv)
(push :float *features*)
#+(or arm esp stm32 riscv avr)
(push :arrays *features*)
#+(or arm esp)
(push :wifi *features*)
#+(or riscv arm esp)
(push :gfx *features*)
#+(or arm esp riscv avr)
(push :doc *features*)
#+(or arm esp riscv avr)
(push :errors *features*)
(load "/Users/david/Projects/Builder/builder defsys.lisp")
(map nil #'delete-file (directory "/Users/david/Projects/Builder/fasls/*"))
(compile-system "builder" :load t)

6
builder/README.md Normal file
View File

@ -0,0 +1,6 @@
# uLisp Builder
Builds a version of uLisp for a particular platform from a common repository of source files.
Currently updated to Version 4.7 for the AVR, AVR-Nano, ARM, ESP32, and RISC-V platforms.
For information see http://www.ulisp.com/show?3F07.

937
builder/Test Suites/AutoTester 32-bit.lisp Normal file
View File

@ -0,0 +1,937 @@
; uLisp Auto Tester
; Sharp-double-quote
(defun sharp-double-quote-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let (chars)
(do ((prev (read-char stream) curr)
(curr (read-char stream) (read-char stream)))
((and (char= prev #\") (char= curr #\#)))
(push prev chars))
(coerce (nreverse chars) 'string)))
(set-dispatch-macro-character
#\# #\" #'sharp-double-quote-reader)
; do (run-tests)
;;; ================================================================
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "serial-port"))
(cl:in-package "CL-USER")
;;; ================================================================
;;; Class SERIAL-STREAM
(defclass serial-stream (stream:fundamental-character-input-stream
stream:fundamental-character-output-stream)
((serial-port :initform nil
:initarg :serial-port
:accessor stream-serial-port)))
(defmethod initialize-instance :after ((stream serial-stream)
&key name (baud-rate 9600) (data-bits 8) (stop-bits 1) (parity :none)
&allow-other-keys)
(unless (stream-serial-port stream)
(check-type name string)
(setf (stream-serial-port stream)
(serial-port:open-serial-port name
:baud-rate baud-rate
:data-bits data-bits
:stop-bits stop-bits
:parity parity))))
(defmethod stream-element-type ((stream serial-stream))
'character)
(defmethod input-stream-p ((stream serial-stream))
t)
(defmethod output-stream-p ((stream serial-stream))
t)
;;; ================================================================
;;; Input
(defmethod stream:stream-read-char ((stream serial-stream))
(serial-port:read-serial-port-char (stream-serial-port stream)))
(defmethod stream:stream-read-char-no-hang ((stream serial-stream))
(when (stream:stream-listen stream)
(stream:stream-read-char stream)))
(defmethod stream:stream-listen ((stream serial-stream))
(serial-port:serial-port-input-available-p (stream-serial-port stream)))
(defmethod stream:stream-clear-input ((stream serial-stream))
(loop while (stream:stream-listen stream)
do (stream:stream-read-char stream))
nil)
;;; ================================================================
;;; Output
(defmethod stream:stream-write-char ((stream serial-stream) char)
(serial-port:write-serial-port-char char (stream-serial-port stream)))
(defmethod stream:stream-write-string ((stream serial-stream) string &optional (start 0) (end (length string)))
(serial-port:write-serial-port-string string (stream-serial-port stream) t :start start :end end))
(defmethod stream:stream-force-output ((stream serial-stream))
nil)
(defmethod stream:stream-finish-output ((stream serial-stream))
nil)
(defmethod stream:stream-clear-output ((stream serial-stream))
nil)
(defmethod close :after ((stream serial-stream) &key abort)
(declare (ignorable abort))
(serial-port:close-serial-port (stream-serial-port stream)))
;;; ================================================================
;;; Example
(defparameter *tests*
#"#| Symbols |#
(aeq 'let 123 (let ((cat 123)) cat))
(aeq 'let 79 (let ((ca% 79)) ca%))
(aeq 'let 83 (let ((1- 83)) 1-))
(aeq 'let 13 (let ((12a 13)) 12a))
(aeq 'let 17 (let ((-1- 17)) -1-))
(aeq 'let 66 (let ((abcdef 66)) abcdef))
(aeq 'let 77 (let ((abcdefg 77)) abcdefg))
(aeq 'let 88 (let ((abcdefgh 88)) abcdefgh))
(aeq 'let 99 (let ((abcdefghi 99)) abcdefghi))
(aeq 'let 1010 (let ((abcdefghij 1010)) abcdefghij))
(aeq 'let "ab9" (princ-to-string 'ab9))
(aeq 'let t (eq 'me 'me))
(aeq 'let t (eq 'fishcake 'fishcake))
(aeq 'let nil (eq 'fishcak 'fishca))
#| Arithmetic |#
(aeq '* 9 (* -3 -3))
(aeq '* 32580 (* 180 181))
(aeq '* 1 (*))
(aeq '+ 32767 (+ 32765 1 1))
(aeq '+ 0 (+))
(aeq '+ -2 (+ -1 -1))
(aeq '- -4 (- 4))
(aeq '- 0 (- 4 2 1 1))
(aeq '/ 2 (/ 60 10 3))
(aeq '1+ 2 (1+ 1))
(aeq '1+ 0 (1+ -1))
(aeq '1- 0 (1- 1))
#| Comparisons |#
(aeq '< t (< -32768 32767))
(aeq '< t (< -1 0))
(aeq '< t (< 1 2 3 4))
(aeq '< nil (< 1 2 2 4))
(aeq '< t (<= 1 2 2 4))
(aeq '< nil (<= 1 3 2 4))
(aeq '< t (> 4 3 2 1))
(aeq '< nil (> 4 2 2 1))
(aeq '< t (>= 4 2 2 1))
(aeq '< nil (>= 4 2 3 1))
(aeq '< t (< 1))
(aeq '< nil (< 1 3 2))
(aeq '< nil (< -1 -2))
(aeq '< nil (< 10 10))
(aeq '<= t (<= 10 10))
(aeq '= t (= 32767 32767))
(aeq '>= t (>= 10 10))
(aeq '>= nil (>= 9 10))
(aeq '/= t (/= 1))
(aeq '/= nil (/= 1 2 1))
(aeq '/= nil (/= 1 2 3 1))
(aeq '/= t (/= 1 2 3 4))
(aeq 'plusp t (plusp 1))
(aeq 'plusp nil (plusp 0))
(aeq 'plusp nil (plusp -1))
(aeq 'minusp nil (minusp 1))
(aeq 'minusp nil (minusp 0))
(aeq 'minusp t (minusp -1))
(aeq 'zerop nil (zerop 1))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop -1))
(aeq 'evenp nil (evenp 1))
(aeq 'evenp t (evenp 0))
(aeq 'evenp nil (evenp -1))
(aeq 'oddp t (oddp 1))
(aeq 'oddp nil (oddp 0))
(aeq 'oddp t (oddp -1))
#| Maths functions |#
(aeq 'abs 10 (abs 10))
(aeq 'abs 10 (abs -10))
(aeq 'max 45 (max 23 45))
(aeq 'max -23 (max -23 -45))
(aeq 'min 23 (min 23 45))
(aeq 'min -45 (min -23 -45))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop 32767))
(aeq 'mod 1 (mod 13 4))
(aeq 'mod 3 (mod -13 4))
(aeq 'mod -3 (mod 13 -4))
(aeq 'mod -1 (mod -13 -4))
#| Number entry |#
(aeq 'hex -1 #xFFFFFFFF)
(aeq 'hex 1 #x0001)
(aeq 'hex 4112 #x1010)
(aeq 'oct 511 #o777)
(aeq 'oct 1 #o1)
(aeq 'oct 65535 #o177777)
(aeq 'bin -1 #b11111111111111111111111111111111)
(aeq 'bin 10 #b1010)
(aeq 'bin 0 #b0)
(aeq 'hash 12 #'12)
(aeq 'hash 6 (funcall #'(lambda (x) (+ x 2)) 4))
#| Boolean |#
(aeq 'and 7 (and t t 7))
(aeq 'and nil (and t nil 7))
(aeq 'or t (or t nil 7))
(aeq 'or 1 (or 1 2 3))
(aeq 'or nil (or nil nil nil))
(aeq 'or 'a (or 'a 'b 'c))
(aeq 'or 1 (let ((x 0)) (or (incf x)) x))
#| Bitwise |#
(aeq 'logand -1 (logand))
(aeq 'logand 170 (logand #xAA))
(aeq 'logand 0 (logand #xAAAA #x5555))
(aeq 'logior 0 (logior))
(aeq 'logior 170 (logior #xAA))
(aeq 'logior #xFFFF (logior #xAAAA #x5555))
(aeq 'logxor 0 (logxor))
(aeq 'logxor 170 (logior #xAA))
(aeq 'logxor 255 (logxor #xAAAA #xAA55))
(aeq 'lognot -43691 (lognot #xAAAA))
(aeq 'ash 492 (ash 123 2))
(aeq 'ash 65535 (ash #xFFFF 0))
(aeq 'ash 16383 (ash #xFFFF -2))
(aeq 'ash 262140 (ash #xFFFF 2))
(aeq 'ash 8191 (ash #x7FFF -2))
(aeq 'logbitp t (logbitp 0 1))
(aeq 'logbitp t (logbitp 1000 -1))
(aeq 'logbitp nil (logbitp 1000 0))
#| Tests |#
(aeq 'atom t (atom nil))
(aeq 'atom t (atom t))
(aeq 'atom nil (atom '(1 2)))
(aeq 'consp nil (consp 'b))
(aeq 'consp t (consp '(a b)))
(aeq 'consp nil (consp nil))
(aeq 'listp nil (listp 'b))
(aeq 'listp t (listp '(a b)))
(aeq 'listp t (listp nil))
(aeq 'numberp t (numberp (+ 1 2)))
(aeq 'numberp nil (numberp 'b))
(aeq 'numberp nil (numberp nil))
(aeq 'symbolp t (symbolp 'b))
(aeq 'symbolp nil (symbolp 3))
(aeq 'symbolp t (symbolp nil))
(aeq 'streamp nil (streamp 'b))
(aeq 'streamp nil (streamp nil))
(aeq 'boundp t (let (x) (boundp 'x)))
(aeq 'boundp nil (let (x) (boundp 'y)))
#| cxr operations |#
(aeq 'car 'a (car '(a b c)))
(aeq 'car nil (car nil))
(aeq 'first 'a (first '(a b c)))
(aeq 'first nil (first nil))
(aeq 'cdr 'b (cdr '(a . b)))
(aeq 'cdr 'b (car (cdr '(a b))))
(aeq 'cdr nil (cdr nil))
(aeq 'rest 'b (rest '(a . b)))
(aeq 'rest 'b (car (rest '(a b))))
(aeq 'rest nil (rest nil))
(aeq 'caaar 'a (caaar '(((a)))))
(aeq 'caaar 'nil (caaar nil))
(aeq 'caadr 'b (caadr '(a (b))))
(aeq 'caadr 'nil (caadr nil))
(aeq 'caar 'a (caar '((a))))
(aeq 'caar 'nil (caar nil))
(aeq 'cadar 'c (cadar '((a c) (b))))
(aeq 'cadar 'nil (cadar nil))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'cadr 'b (cadr '(a b)))
(aeq 'second 'nil (second '(a)))
(aeq 'second 'b (second '(a b)))
(aeq 'cadr 'nil (cadr '(a)))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'third 'c (third '(a b c)))
(aeq 'third 'nil (third nil))
(aeq 'cdaar 'b (car (cdaar '(((a b)) b c))))
(aeq 'cdaar 'nil (cdaar nil))
(aeq 'cdadr 'c (car (cdadr '(a (b c)))))
(aeq 'cdadr 'nil (cdadr nil))
(aeq 'cdar 'b (car (cdar '((a b c)))))
(aeq 'cdar 'nil (cdar nil))
(aeq 'cddar 'c (car (cddar '((a b c)))))
(aeq 'cddar 'nil (cddar nil))
(aeq 'cdddr 'd (car (cdddr '(a b c d))))
(aeq 'cdddr nil (car (cdddr '(a b c))))
(aeq 'cddr 'c (car (cddr '(a b c))))
(aeq 'cddr 'nil (cddr '(a)))
#| List operations |#
(aeq 'cons 'a (car (cons 'a 'b)))
(aeq 'cons nil (car (cons nil 'b)))
(aeq 'append 6 (length (append '(a b c) '(d e f))))
(aeq 'append nil (append nil nil))
(aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6)))
(aeq 'list nil (car (list nil)))
(aeq 'list 'a (car (list 'a 'b 'c)))
(aeq 'reverse 'c (car (reverse '(a b c))))
(aeq 'reverse nil (reverse nil))
(aeq 'length 0 (length nil))
(aeq 'length 4 (length '(a b c d)))
(aeq 'length 2 (length '(nil nil)))
(aeq 'assoc nil (assoc 'b nil))
(aeq 'assoc nil (assoc 'b '(nil nil)))
(aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12))))
(aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12))))
(aeq 'assoc '(b) (assoc 'b '((a . 10) (b))))
(aeq 'assoc '("three" . 3) (assoc "three" '(("one" . 1) ("two" . 2) ("three" . 3)) :test string=))
(aeq 'member '(3 4) (member 3 '(1 2 3 4)))
(aeq 'member nil (member 5 '(1 2 3 4)))
(aeq 'member '(3 4) (member 3 '(1 2 3 4) :test eq))
(aeq 'member '("three" "four") (member "three" '("one" "two" "three" "four") :test string=))
(aeq 'member '("two" "three" "four") (member "three" '("one" "two" "three" "four") :test string<))
#| map operations |#
(aeq 'mapc 2 (cadr (mapc + '(1 2 3 4))))
(aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x))
(aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5)))
(aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6)))
(aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4)))
(aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11)))
(aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4))))
(aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4))))
(aeq 'maplist '(((1 2 3) 6 7 8) ((2 3) 7 8) ((3) 8)) (maplist #'cons '(1 2 3) '(6 7 8)))
(aeq 'maplist '(1 2 3) (mapl #'cons '(1 2 3) '(6 7 8)))
(aeq 'mapcan '(3 7 11) (mapcon (lambda (x) (when (eq (first x) (second x)) (list (car x)))) '(1 2 3 3 5 7 7 8 9 11 11)))
#| let/let*/lambda |#
(aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y)))
(aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y)))
(aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3))
(aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4))
(aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2))
(aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3))
(aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3))
(aeq 'lambda 123 ((lambda (list) list) 123))
#| loops and control |#
(aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x))))
(aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y)))))
(aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y)))))
(aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y)))))
(aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y)))))
(aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x))))
(aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x))))
(aeq 'return 'a (let ((a 7)) (loop (progn (return 'a)))))
(aeq 'return nil (loop (return)))
(aeq 'return 'a (let ((a 7)) (loop (progn (return 'a) nil))))
(aeq 'do 2 (do* ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x)))
(aeq 'do 3 (do ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x)))
(aeq 'do 720 (do* ((n 6) (f 1 (* j f)) (j n (- j 1))) ((= j 0) f)))
(aeq 'do 720 (let ((n 6)) (do ((f 1 (* j f)) (j n (- j 1)) ) ((= j 0) f))))
(aeq 'do 10 (do (a (b 1 (1+ b))) ((> b 10) a) (setq a b)))
#| conditions |#
(aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4)))
(aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4)))
(aeq 'if 4 (let ((a 3)) (if (= a 3) 4)))
(aeq 'if nil (let ((a 4)) (if (= a 3) 4)))
(aeq 'when 4 (let ((a 3)) (when (= a 3) 4)))
(aeq 'when nil (let ((a 2)) (when (= a 3) 4)))
(aeq 'unless nil (let ((a 3)) (unless (= a 3) 4)))
(aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4)))
(aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9))))
(aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9))))
(aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8))))
(aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4))))))
(aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
#| eval/funcall/apply |#
(aeq 'funcall 10 (funcall + 1 2 3 4))
(aeq 'funcall 'a (funcall car '(a b c d)))
(aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x))
(aeq 'apply 10 (apply + '(1 2 3 4)))
(aeq 'apply 13 (apply + 1 2 '(1 2 3 4)))
(aeq 'eval 10 (eval (list + 1 2 3 4)))
(aeq 'eval nil (eval nil))
(aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2)))
(aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3))))
#| in-place operations |#
(aeq 'incf 5 (let ((x 0)) (+ (incf x) (incf x 2) (incf x -2))))
(aeq 'decf -5 (let ((x 0)) (+ (decf x) (decf x 2) (decf x -2))))
(aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2))))
(aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1)))))
(aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b)))
(aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a)))
(aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a)))
(aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a)))
#| recursion |#
(aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10)))
(aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7)))
(aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a))
#| streams |#
(aeq 'stream "<string-stream 0>" (with-output-to-string (s) (princ s s)))
(aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34)))
#| features |#
(aeq 'features t (not (not (member :floating-point *features*))))
(aeq 'features t (not (not (member :arrays *features*))))
#| printing |#
(aeq 'princ "hello" (princ-to-string "hello"))
(aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\""))
(aeq 'prin1 "\"hello\"" (prin1-to-string "hello"))
(aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\""))
#| prettyprinting |#
(aeq 'princ "hello" (princ-to-string "hello"))
(aeq 'pprint 10996 (let ((n 0) (st (with-output-to-string (str) (pprint aeq str)))) (dotimes (i (length st) n) (incf n (char-code (char st i))))))
#| documentation |#
(aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list 'pro))
(aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list "pro"))
(aeq 'documentation 7397 (let ((n 0)) (let ((st (documentation '?))) (dotimes (i (length st) n) (incf n (char-code (char st i)))))))
#| format |#
(aeq 'format "hello" (format nil "hello"))
(aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23))
(aeq 'format " 17" (format nil "~5x" 23))
(aeq 'format " 10111" (format nil "~6b" 23))
(aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23))
(aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23))
(aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7))
(aeq 'format "Hello42" (format nil "Hello~a" 42))
(aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3)))
(aeq 'format "0003.14159" (format nil "~10,'0g" 3.14159))
(aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil))
#| strings |#
(aeq 'stringp t (stringp "hello"))
(aeq 'stringp nil (stringp 5))
(aeq 'stringp nil (stringp '(a b)))
(aeq 'numberp nil (numberp "hello"))
(aeq 'atom t (atom "hello"))
(aeq 'consp nil (consp "hello"))
(aeq 'eq nil (eq "hello" "hello"))
(aeq 'eq t (let ((a "hello")) (eq a a)))
(aeq 'length 0 (length ""))
(aeq 'length 5 (length "hello"))
(aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB"))
(aeq 'concatenate 3 (length (concatenate 'string "A" "BC")))
(aeq 'concatenate 0 (length (concatenate 'string)))
(aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD"))
(aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE"))
(aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE"))
(aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF"))
(aeq 'string= nil (string= "cat" "cat "))
(aeq 'string= t (string= "cat" "cat"))
(aeq 'string/= 3 (string/= "cat" "catx"))
(aeq 'string/= nil (string/= "cat" "cat"))
(aeq 'string/= nil (string/= "catt" "catt"))
(aeq 'string< nil (string< "cat" "cat"))
(aeq 'string<= 3 (string<= "cat" "cat"))
(aeq 'string< 3 (string< "cat" "cat "))
(aeq 'string< 4 (string< "fish" "fish "))
(aeq 'string> nil (string> "cat" "cat"))
(aeq 'string>= 3 (string>= "cat" "cat"))
(aeq 'string>= 5 (string>= "cattx" "cattx"))
(aeq 'string> 0 (string> "c" "a"))
(aeq 'string> 1 (string> "fc" "fa"))
(aeq 'string> 2 (string> "ffc" "ffa"))
(aeq 'string> 3 (string> "fffc" "fffa"))
(aeq 'string> 4 (string> "ffffc" "ffffa"))
(aeq 'string> 5 (string> "fffffc" "fffffa"))
(aeq 'string> nil (string< "fffffc" "fffffa"))
(aeq 'string "albatross" (string "albatross"))
(aeq 'string "x" (string #\x))
(aeq 'string "cat" (string 'cat))
(aeq 'string "albatross" (string 'albatross))
#| subseq and search |#
(aeq 'subseq "hello" (subseq "hellofromdavid" 0 5))
(aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5))
(aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2))
(aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3))
(aeq 'subseq nil (subseq '() 0))
(aeq 'search 4 (search "cat" "the cat sat on the mat"))
(aeq 'search 19 (search "mat" "the cat sat on the mat"))
(aeq 'search nil (search "hat" "the cat sat on the mat"))
(aeq 'search 1 (search '(1 2) '( 0 1 2 3 4)))
(aeq 'search nil (search '(2 1 2 3 4 5) '(2 1 2 3 4)))
#| characters |#
(aeq 'char-code 97 (char-code #\a))
(aeq 'char-code 13 (char-code #\return))
(aeq 'char-code 255 (char-code #\255))
(aeq 'code-char #\return (code-char 13))
(aeq 'code-char #\a (code-char 97))
(aeq 'code-char #\255 (code-char 255))
(aeq 'eq t (eq #\b #\b))
(aeq 'eq nil (eq #\b #\B))
(aeq 'numberp nil (numberp #\b))
(aeq 'characterp t (characterp #\b))
(aeq 'char #\o (char "hello" 4))
(aeq 'char #\h (char "hello" 0))
(aeq 'char "A" (princ-to-string (code-char 65)))
(aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7)))
(aeq 'char "[#\\Return]" (format nil "[~s]" #\return))
(aeq 'char "[#\\127]" (format nil "[~s]" #\127))
(aeq 'char "[#\\255]" (format nil "[~s]" #\255))
#| read-from-string |#
(aeq 'read-from-string 123 (read-from-string "123"))
(aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)")))
(aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)")))
(aeq 'read-from-string nil (read-from-string "()"))
#| closures |#
(aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn))))))
(aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1)))
(aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x))
(aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x))
(aeq 'closure '(8 10 13 17) (let ((x 0) (clo (lambda () (let ((x 7)) (lambda (y) (incf x y)))))) (mapcar (funcall clo) '(1 2 3 4))))
(aeq 'closure 3 (let ((y 0) (test (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (test (+ x 2))) (incf y x))))
#| arrays |#
(aeq 'array '(0 0) (array-dimensions #2a()))
(aeq 'array '(1 0) (array-dimensions #2a(())))
(aeq 'array '(2 0) (array-dimensions #2a(() ())))
(aeq 'array '(0) (array-dimensions (make-array '(0))))
(aeq 'array '(0) (array-dimensions (make-array 0)))
(aeq 'array 1 (let ((a (make-array 3 :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array '(3) :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array '(2 3) :initial-element 0))) (incf (aref a 1 (+ 1 1))) (aref a 1 2)))
(aeq 'array 1 (let ((a (make-array '(2 3 2 2) :initial-element 0))) (incf (aref a 1 (+ 1 1) 1 1)) (aref a 1 2 1 1)))
(aeq 'array 10 (length (make-array 10 :initial-element 1)))
#| bit arrays |#
(aeq 'array '(0) (array-dimensions (make-array '(0) :element-type 'bit)))
(aeq 'array '(1 1) (array-dimensions (make-array '(1 1) :element-type 'bit)))
(aeq 'array 10 (length (make-array '(10) :element-type 'bit)))
(aeq 'array 10 (length (make-array 10 :element-type 'bit)))
(aeq 'array 1 (let ((a (make-array 3 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array 3 :initial-element 0 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 0 (let ((a (make-array 10 :element-type 'bit :initial-element 1))) (decf (aref a 4)) (aref a 4)))
(aeq 'array 1 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (aref a 39)))
(aeq 'array 0 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (decf (aref a 39)) (aref a 39)))
#| repl |#
(aeq 'repl 23 (read-from-string "23(2)"))
(aeq 'repl nil (read-from-string "()23"))
(aeq 'repl 23 (read-from-string "23\"Hi\""))
(aeq 'repl "Hi" (read-from-string "\"Hi\"23"))
(aeq 'repl #\1 (read-from-string " #\\1\"Hi\""))
(aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101")))
#| equal |#
(aeq 'equal t (equal '(1 2 3) '(1 2 3)))
(aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3)))
(aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3)))
(aeq 'equal t (equal "cat" "cat"))
(aeq 'equal nil (equal "cat" "Cat"))
(aeq 'equal t (equal 'cat 'Cat))
(aeq 'equal t (equal 2 (+ 1 1)))
(aeq 'equal t (equal '("cat" "dog") '("cat" "dog")))
(aeq 'equal nil (equal '("cat" "dog") '("cat" "dig")))
(aeq 'equal nil (equal '("cat" "dog") '("cat" "Dog")))
#| keywords |#
(aeq 'keywordp t (keywordp :led-builtin))
(aeq 'keywordp nil (keywordp print))
(aeq 'keywordp nil (keywordp nil))
(aeq 'keywordp nil (keywordp 12))
(aeq 'keywordp t (keywordp :fred))
(aeq 'keywordp t (keywordp :initial-element))
(aeq 'keywordp t (keywordp :element-type))
#| errors |#
(aeq 'error 7 (let ((x 7)) (ignore-errors (setq x (/ 1 0))) x))
(aeq 'error 5 (unwind-protect (+ 2 3) 13))
#| Printing floats |#
(aeq 'print t (string= (princ-to-string 101.0) "101.0"))
(aeq 'print t (string= (princ-to-string 1010.0) "1010.0"))
(aeq 'print t (string= (princ-to-string 10100.0) "10100.0"))
(aeq 'print t (string= (princ-to-string 101000.0) "1.01e5"))
(aeq 'print t (string= (princ-to-string 1010000.0) "1.01e6"))
(aeq 'print t (string= (princ-to-string 1.01E7) "1.01e7"))
(aeq 'print t (string= (princ-to-string 1.01E8) "1.01e8"))
(aeq 'print t (string= (princ-to-string 7.0) "7.0"))
(aeq 'print t (string= (princ-to-string 70.0) "70.0"))
(aeq 'print t (string= (princ-to-string 700.0) "700.0"))
(aeq 'print t (string= (princ-to-string 7000.0) "7000.0"))
(aeq 'print t (string= (princ-to-string 70000.0) "70000.0"))
(aeq 'print t (string= (princ-to-string 700000.0) "7.0e5"))
(aeq 'print t (string= (princ-to-string 0.7) "0.7"))
(aeq 'print t (string= (princ-to-string 0.07) "0.07"))
(aeq 'print t (string= (princ-to-string 0.007) "0.007"))
(aeq 'print t (string= (princ-to-string 7.0E-4) "7.0e-4"))
(aeq 'print t (string= (princ-to-string 7.0E-5) "7.0e-5"))
(aeq 'print t (string= (princ-to-string 7.0E-6) "7.0e-6"))
(aeq 'print t (string= (princ-to-string 0.9) "0.9"))
(aeq 'print t (string= (princ-to-string 0.99) "0.99"))
(aeq 'print t (string= (princ-to-string 0.999) "0.999"))
(aeq 'print t (string= (princ-to-string 0.9999) "0.9999"))
(aeq 'print t (string= (princ-to-string 0.99999) "0.99999"))
(aeq 'print t (string= (princ-to-string 0.999999) "0.999999"))
(aeq 'print t (string= (princ-to-string 0.9999999) "1.0"))
(aeq 'print t (string= (princ-to-string 1.0) "1.0"))
(aeq 'print t (string= (princ-to-string 10.0) "10.0"))
(aeq 'print t (string= (princ-to-string 100.0) "100.0"))
(aeq 'print t (string= (princ-to-string 1000.0) "1000.0"))
(aeq 'print t (string= (princ-to-string 10000.0) "10000.0"))
(aeq 'print t (string= (princ-to-string 100000.0) "1.0e5"))
(aeq 'print t (string= (princ-to-string 9.0) "9.0"))
(aeq 'print t (string= (princ-to-string 90.0) "90.0"))
(aeq 'print t (string= (princ-to-string 900.0) "900.0"))
(aeq 'print t (string= (princ-to-string 9000.0) "9000.0"))
(aeq 'print t (string= (princ-to-string 90000.0) "90000.0"))
(aeq 'print t (string= (princ-to-string 900000.0) "9.0e5"))
(aeq 'print t (string= (princ-to-string -9.0) "-9.0"))
(aeq 'print t (string= (princ-to-string -90.0) "-90.0"))
(aeq 'print t (string= (princ-to-string -900.0) "-900.0"))
(aeq 'print t (string= (princ-to-string -9000.0) "-9000.0"))
(aeq 'print t (string= (princ-to-string -90000.0) "-90000.0"))
(aeq 'print t (string= (princ-to-string -900000.0) "-9.0e5"))
(aeq 'print t (string= (princ-to-string 1.0) "1.0"))
(aeq 'print t (string= (princ-to-string 1.01) "1.01"))
(aeq 'print t (string= (princ-to-string 1.001) "1.001"))
(aeq 'print t (string= (princ-to-string 1.0001) "1.0001"))
(aeq 'print t (string= (princ-to-string 1.00001) "1.00001"))
(aeq 'print t (string= (princ-to-string 1.000001) "1.0"))
(aeq 'print t (string= (princ-to-string 0.0012345678) "0.00123457"))
(aeq 'print t (string= (princ-to-string 1.2345678E-4) "1.23457e-4"))
(aeq 'print t (string= (princ-to-string 1234567.9) "1.23457e6"))
(aeq 'print t (string= (princ-to-string 1.2345679E7) "1.23457e7"))
(aeq 'print t (string= (princ-to-string 1.2E-9) "1.2e-9"))
(aeq 'print t (string= (princ-to-string 9.9E-8) "9.9e-8"))
(aeq 'print t (string= (princ-to-string 9.9999E-5) "9.9999e-5"))
(aeq 'print t (string= (princ-to-string 9.01) "9.01"))
(aeq 'print t (string= (princ-to-string 0.9999999) "1.0"))
(aeq 'print t (string= (princ-to-string 0.8999999) "0.9"))
(aeq 'print t (string= (princ-to-string 0.01) "0.01"))
(aeq 'print t (string= (princ-to-string 1.2345679) "1.23457"))
(aeq 'print t (string= (princ-to-string 12.345679) "12.3457"))
(aeq 'print t (string= (princ-to-string 123.45679) "123.457"))
(aeq 'print t (string= (princ-to-string 1234.5679) "1234.57"))
(aeq 'print t (string= (princ-to-string 12345.679) "12345.7"))
(aeq 'print t (string= (princ-to-string 123456.79) "1.23457e5"))
(aeq 'print t (string= (princ-to-string 1234567.9) "1.23457e6"))
(aeq 'print t (string= (princ-to-string 0.12345679) "0.123457"))
(aeq 'print t (string= (princ-to-string 0.012345679) "0.0123457"))
(aeq 'print t (string= (princ-to-string 0.0012345678) "0.00123457"))
(aeq 'print t (string= (princ-to-string 1.2345679E-4) "1.23457e-4"))
#| Arithmetic |#
(aeq '= t (= (- 4 2 1 1) 0))
(aeq '* 9 (* -3 -3))
(aeq '* 32580 (* 180 181))
(aeq '* 1 (*))
(aeq '* t (string= "-4.29497e9" (princ-to-string (* 2 -2147483648))))
(aeq '* -2147483648 (* 2 -1073741824))
(aeq '+ 32767 (+ 32765 1 1))
(aeq '+ 0 (+))
(aeq '+ -2 (+ -1 -1))
(aeq '- -4 (- 4))
(aeq '/ 2 (/ 60 10 3))
(aeq '1+ 2.5 (1+ 1.5))
(aeq '1+ 2147483647 (1+ 2147483646))
(aeq '1+ t (string= "2.14748e9" (princ-to-string (1+ 2147483647))))
(aeq '1- 0.5 (1- 1.5))
(aeq '1- -2147483648 (1- -2147483647))
(aeq '1- t (string= "-2.14748e9" (princ-to-string (1- -2147483648))))
#| Arithmetic |#
(aeq '/ 1.75 (/ 3.5 2))
(aeq '/ 1.75 (/ 3.5 2.0))
(aeq '/ 0.0625 (/ 1 16))
(aeq '/ 0.0625 (/ 1.0 16))
(aeq '/ 0.0625 (/ 1 16.0))
(aeq '/ 2 (/ 12 2 3))
(aeq '/ 2.0 (/ 12.0 2 3))
(aeq '/ 2.0 (/ 12 2.0 3))
(aeq '/ 2.0 (/ 12 2 3.0))
(aeq '/ 1 (/ 1))
(aeq '/ t (string= "2.14748e9" (princ-to-string (/ -2147483648 -1))))
(aeq '/ 2147483647 (/ -2147483647 -1))
(aeq '/ 0.5 (/ 2))
(aeq '* 1.0 (* 0.0625 16))
(aeq '* 1.0 (* 0.0625 16.0))
#| Place |#
(aeq 'incf 5.4 (let ((x 0)) (+ (incf x) (incf x 0.2) (incf x 2))))
(aeq 'decf -5.4 (let ((x 0)) (+ (decf x) (decf x 0.2) (decf x 2))))
(aeq 'incf 30.6 (let ((n 10)) (let* ((f1 (lambda () (incf n 0.1) n))) (+ (funcall f1) (funcall f1) (funcall f1)))))
(aeq 'setf "hellx" (let ((s "hello")) (setf (char s 4) #\x) s))
#| Comparisons |#
(aeq '< t (< 1 2 3 4))
(aeq '< nil (< 1 2 3 2))
(aeq '< t (< 1.0 2 3 4))
(aeq '< nil (< 1 2 3 2))
(aeq '< t (< 1.0 1.001 3 4))
(aeq '< nil (< 1.001 1.0 3 4))
(aeq '< t (< 1.001 1.002 1.003 1.004))
(aeq '< t (< 1. 2. 3. 4.))
(aeq '< nil (< 1. 2. 2. 4.))
(aeq '< t (<= 1. 2. 2. 4.))
(aeq '< nil (<= 1. 3. 2. 4.))
(aeq '< t (> 4. 3. 2. 1.))
(aeq '< nil (> 4. 2. 2. 1.))
(aeq '< t (>= 4. 2. 2. 1.))
(aeq '< nil (>= 4. 2. 3. 1.))
(aeq '/= t (= 1. 1. 1. 1.))
(aeq '/= nil (= 1. 1. 2. 1.))
(aeq '/= nil (/= 1. 2. 3. 1.))
(aeq '/= t (/= 1. 2. 3. 4.))
#| Transcendental |#
(aeq 'sin 0.84147096 (sin 1))
(aeq 'sin 0.0 (sin 0))
(aeq 'sin 0.84147096 (sin 1.0))
(aeq 'sin 0.0 (sin 0.0))
(aeq 'cos 0.540302 (cos 1))
(aeq 'cos 0.540302 (cos 1.0))
(aeq 'tan 1.55741 (tan 1))
(aeq 'tan 1.55741 (tan 1.0))
(aeq 'asin 1.5707964 (asin 1))
(aeq 'asin 1.5707964 (asin 1))
(aeq 'asin 0.0 (asin 0))
(aeq 'asin 0.0 (asin 0.0))
(aeq 'acos 0.0 (acos 1))
(aeq 'acos 0.0 (acos 1.0))
(aeq 'acos 1.0471976 (acos 0.5))
(aeq 'atan 0.4636476 (atan 0.5))
(aeq 'atan 0.110657 (atan 1 9))
(aeq 'atan 0.049958397 (atan 1 20))
(aeq 'atan 0.785398 (atan 1 1))
(aeq 'atan 0.785398 (atan .5 .5))x
(aeq 'sinh 1.1752 (sinh 1))
(aeq 'sinh 1.1752 (sinh 1.0))
(aeq 'sinh 0.0 (sinh 0))
(aeq 'sinh 0.0 (sin 0.0))
(aeq 'cosh 1.5430807 (cosh 1))
(aeq 'cosh 1.5430807 (cosh 1.0))
(aeq 'tanh 0.7615942 (tanh 1))
(aeq 'tanh 0.7615942 (tanh 1.0))
#| Rounding |#
(aeq 'truncate 3 (truncate 10 3))
(aeq 'truncate 3 (truncate 3.3333333))
(aeq 'ceiling 4 (ceiling 10 3))
(aeq 'ceiling 4 (ceiling 3.3333333))
(aeq 'round 3 (round 10 3))
(aeq 'round 3 (round 3.3333333))
(aeq 'floor 3 (floor 10 3))
(aeq 'floor 3 (floor 3.3333333))
(aeq 'truncate -3 (truncate -10 3))
(aeq 'truncate -3 (truncate -3.3333333))
(aeq 'ceiling -3 (ceiling -10 3))
(aeq 'ceiling -3 (ceiling -3.3333333))
(aeq 'round -3 (round -10 3))
(aeq 'round -3 (round -3.3333333))
(aeq 'floor -4 (floor -10 3))
(aeq 'floor -4 (floor -3.3333333))
(aeq 'abs 10.0 (abs 10.0))
(aeq 'abs 10.0 (abs -10.0))
(aeq 'abs t (string= "2.14748e9" (princ-to-string (abs -2147483648))))
(aeq 'abs 2147483647 (abs -2147483647))
(aeq 'mod 1.0 (mod 13.0 4))
(aeq 'mod 3.0 (mod -13.0 4))
(aeq 'mod -3.0 (mod 13.0 -4))
(aeq 'mod -1.0 (mod -13.0 -4))
(aeq 'mod -3.0 (mod 13.0 -4))
(aeq 'mod 1.0 (mod -12.5 1.5))
(aeq 'mod 0.5 (mod 12.5 1.5))
#| Log and exp |#
(aeq 'exp 2.7182818 (exp 1))
(aeq 'exp 2.7182818 (exp 1.0))
(aeq 'exp 0.36787945 (exp -1))
(aeq 'exp 0.36787945 (exp -1.0))
(aeq 'exp 0.36787945 (exp -1.0))
(aeq 'log 0.0 (log 1.0))
(aeq 'log 4.0 (log 16 2))
(aeq 'log 4.0 (log 16.0 2))
(aeq 'log 4.0 (log 16 2.0))
(aeq 'log 4.0 (log 16.0 2.0))
(aeq 'log 1.0 (log 2 2))
(aeq 'log 1.0 (log 2.5 2.5))
(aeq 'log 2.3025852 (log 10))
(aeq 'log 2.3025852 (log 10))
(aeq 'expt 1024 (expt 2 10))
(aeq 'expt 1024.0 (expt 2.0 10.0))
(aeq 'expt 1073741824 (expt 2 30))
(aeq 'expt t (string= "2.14748e9" (princ-to-string (expt 2 31))))
(aeq 'expt t (string= "4.29497e9" (princ-to-string (expt 2 32))))
(aeq 'expt 1024 (expt -2 10))
(aeq 'expt -2048 (expt -2 11))
#| Tests |#
(aeq 'floatp nil (floatp 1))
(aeq 'floatp nil (floatp nil))
(aeq 'floatp t (floatp 2.3))
(aeq 'integerp t (integerp 1))
(aeq 'integerp nil (integerp nil))
(aeq 'integerp nil (integerp 2.3))
#| error checks |#
(aeq 'dolist nothing (ignore-errors (dolist 12 (print x))))
(aeq 'dolist nothing (ignore-errors (dolist () (print x))))
(aeq 'dolist nothing (ignore-errors (dolist (x) (print x))))
(aeq 'dolist nothing (ignore-errors (dolist (x nil x x) (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes 12 (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes () (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes (x) (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes (x 1 x x) (print x))))
(aeq 'for-millis nothing (ignore-errors (for-millis 12 (print 12))))
(aeq 'for-millis nothing (ignore-errors (for-millis (12 12) (print 12))))
(aeq 'push nothing (ignore-errors (let ((a #*00000000)) (push 1 (aref a 1)) a)))
(aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 5) #\x) s)))
(aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 20) #\x) s)))
#| errors |#
(aeq 'errors 0 ers)
"#)
(defun run-tests (&optional usb)
(let ((name (cond
((numberp usb) (format nil "/dev/cu.usbmodem~a" usb))
((eq usb :esp) "/dev/cu.SLAB_USBtoUART")
((eq usb :ftdi) "/dev/cu.usbserial-A104OVGT")
;((eq usb :maix) "/dev/cu.usbserial-495223D74D0")
((eq usb :maix) "/dev/cu.usbserial-xel_sipeed0")
((eq usb :dock) "/dev/cu.wchusbserial1410")
((eq usb :teensy) "/dev/cu.usbmodem7705521")
(t usb)))
(speed 1))
(flet ((serial-write-exp (string stream)
(write-string string stream)
(write-char #\newline stream))
;;
(echo (s)
(sleep speed)
(loop
(let ((c (read-char-no-hang s)))
(unless c (return))
(unless (eq c #\return) (write-char c))))
(format t "~%"))
;;
(read-serial (s)
(sleep speed)
(let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
(loop
(let ((c (read-char-no-hang s)))
(unless c (return string))
(vector-push-extend c string))))))
;;
(with-open-stream (s (make-instance 'serial-stream :name name))
(echo s)
(echo s)
(serial-write-exp "(defvar ers 0)" s)
(echo s)
(serial-write-exp
"(defun aeq (tst x y)
(unless (or
(and (floatp x) (floatp y) (< (abs (- x y)) 0.000005))
(equal x y))
(incf ers)
(format t \"~a=~a/~a~%\" tst x y)))"
s)
(echo s)
;;
;; tests
;;
(with-input-from-string (str *tests*)
(loop
(let ((line (read-line str nil nil)))
(unless line (return))
(serial-write-exp line s)
(let ((output (read-serial s)))
(let* ((m1 (position #\return output))
(m2 (when m1 (position #\return output :start (+ 2 m1)))))
(cond
((null m2) (format t "~a~%" output))
((string= (subseq output (+ 2 m1) m2) "nil") nil)
(t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1)))))))))))))

576
builder/Test Suites/AutoTester AVR Nano.lisp Normal file
View File

@ -0,0 +1,576 @@
; uLisp Auto Tester
; Sharp-double-quote
(defun sharp-double-quote-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let (chars)
(do ((prev (read-char stream) curr)
(curr (read-char stream) (read-char stream)))
((and (char= prev #\") (char= curr #\#)))
(push prev chars))
(coerce (nreverse chars) 'string)))
(set-dispatch-macro-character
#\# #\" #'sharp-double-quote-reader)
; do (run-tests)
;;; ================================================================
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "serial-port"))
(cl:in-package "CL-USER")
;;; ================================================================
;;; Class SERIAL-STREAM
(defclass serial-stream (stream:fundamental-character-input-stream
stream:fundamental-character-output-stream)
((serial-port :initform nil
:initarg :serial-port
:accessor stream-serial-port)))
(defmethod initialize-instance :after ((stream serial-stream)
&key name (baud-rate 9600) (data-bits 8) (stop-bits 1) (parity :none)
&allow-other-keys)
(unless (stream-serial-port stream)
(check-type name string)
(setf (stream-serial-port stream)
(serial-port:open-serial-port name
:baud-rate baud-rate
:data-bits data-bits
:stop-bits stop-bits
:parity parity))))
(defmethod stream-element-type ((stream serial-stream))
'character)
(defmethod input-stream-p ((stream serial-stream))
t)
(defmethod output-stream-p ((stream serial-stream))
t)
;;; ================================================================
;;; Input
(defmethod stream:stream-read-char ((stream serial-stream))
(serial-port:read-serial-port-char (stream-serial-port stream)))
(defmethod stream:stream-read-char-no-hang ((stream serial-stream))
(when (stream:stream-listen stream)
(stream:stream-read-char stream)))
(defmethod stream:stream-listen ((stream serial-stream))
(serial-port:serial-port-input-available-p (stream-serial-port stream)))
(defmethod stream:stream-clear-input ((stream serial-stream))
(loop while (stream:stream-listen stream)
do (stream:stream-read-char stream))
nil)
;;; ================================================================
;;; Output
(defmethod stream:stream-write-char ((stream serial-stream) char)
(serial-port:write-serial-port-char char (stream-serial-port stream)))
(defmethod stream:stream-write-string ((stream serial-stream) string &optional (start 0) (end (length string)))
(serial-port:write-serial-port-string string (stream-serial-port stream) t :start start :end end))
(defmethod stream:stream-force-output ((stream serial-stream))
nil)
(defmethod stream:stream-finish-output ((stream serial-stream))
nil)
(defmethod stream:stream-clear-output ((stream serial-stream))
nil)
(defmethod close :after ((stream serial-stream) &key abort)
(declare (ignorable abort))
(serial-port:close-serial-port (stream-serial-port stream)))
;;; ================================================================
;;; Example
(defparameter *tests*
#"#| Symbols |#
(aeq 'let 123 (let ((cat 123)) cat))
(aeq 'let 79 (let ((ca% 79)) ca%))
(aeq 'let 83 (let ((1- 83)) 1-))
(aeq 'let 13 (let ((12a 13)) 12a))
(aeq 'let 17 (let ((-1- 17)) -1-))
(aeq 'let 66 (let ((abcdef 66)) abcdef))
(aeq 'let 77 (let ((abcdefg 77)) abcdefg))
(aeq 'let 88 (let ((abcdefgh 88)) abcdefgh))
(aeq 'let 99 (let ((abcdefghi 99)) abcdefghi))
(aeq 'let 1010 (let ((abcdefghij 1010)) abcdefghij))
(aeq 'let "ab9" (princ-to-string 'ab9))
#| Arithmetic |#
(aeq '* 9 (* -3 -3))
(aeq '* 32580 (* 180 181))
(aeq '* 1 (*))
(aeq '+ 32767 (+ 32765 1 1))
(aeq '+ 0 (+))
(aeq '+ -2 (+ -1 -1))
(aeq '- -4 (- 4))
(aeq '- 0 (- 4 2 1 1))
(aeq '/ 2 (/ 60 10 3))
(aeq '1+ 2 (1+ 1))
(aeq '1+ 0 (1+ -1))
(aeq '1- 0 (1- 1))
#| Comparisons |#
(aeq '< t (< -32768 32767))
(aeq '< t (< -1 0))
(aeq '< t (< 1 2 3 4))
(aeq '< nil (< 1 2 2 4))
(aeq '< t (<= 1 2 2 4))
(aeq '< nil (<= 1 3 2 4))
(aeq '< t (> 4 3 2 1))
(aeq '< nil (> 4 2 2 1))
(aeq '< t (>= 4 2 2 1))
(aeq '< nil (>= 4 2 3 1))
(aeq '< t (< 1))
(aeq '< nil (< 1 3 2))
(aeq '< nil (< -1 -2))
(aeq '< nil (< 10 10))
(aeq '<= t (<= 10 10))
(aeq '= t (= 32767 32767))
(aeq '>= t (>= 10 10))
(aeq '>= nil (>= 9 10))
(aeq '/= t (/= 1))
(aeq '/= nil (/= 1 2 1))
(aeq '/= nil (/= 1 2 3 1))
(aeq '/= t (/= 1 2 3 4))
(aeq 'plusp t (plusp 1))
(aeq 'plusp nil (plusp 0))
(aeq 'plusp nil (plusp -1))
(aeq 'minusp nil (minusp 1))
(aeq 'minusp nil (minusp 0))
(aeq 'minusp t (minusp -1))
(aeq 'zerop nil (zerop 1))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop -1))
(aeq 'evenp nil (evenp 1))
(aeq 'evenp t (evenp 0))
(aeq 'evenp nil (evenp -1))
(aeq 'oddp t (oddp 1))
(aeq 'oddp nil (oddp 0))
(aeq 'oddp t (oddp -1))
#| Maths functions |#
(aeq 'abs 10 (abs 10))
(aeq 'abs 10 (abs -10))
(aeq 'max 45 (max 23 45))
(aeq 'max -23 (max -23 -45))
(aeq 'min 23 (min 23 45))
(aeq 'min -45 (min -23 -45))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop 32767))
(aeq 'mod 1 (mod 13 4))
(aeq 'mod 3 (mod -13 4))
(aeq 'mod -3 (mod 13 -4))
(aeq 'mod -1 (mod -13 -4))
#| Number entry |#
(aeq 'hex -1 #xFFFF)
(aeq 'hex 1 #x0001)
(aeq 'hex 4112 #x1010)
(aeq 'oct 511 #o777)
(aeq 'oct 1 #o1)
(aeq 'oct -1 #o177777)
(aeq 'bin -1 #b1111111111111111)
(aeq 'bin 10 #b1010)
(aeq 'bin 0 #b0)
(aeq 'bin 12 #'12)
(aeq 'bin 6 (funcall #'(lambda (x) (+ x 2)) 4))
#| Boolean |#
(aeq 'and 7 (and t t 7))
(aeq 'and nil (and t nil 7))
(aeq 'or t (or t nil 7))
(aeq 'or 1 (or 1 2 3))
(aeq 'or nil (or nil nil nil))
(aeq 'or 'a (or 'a 'b 'c))
(aeq 'or 1 (let ((x 0)) (or (incf x)) x))
#| Bitwise |#
(aeq 'logand -1 (logand))
(aeq 'logand 170 (logand #xAA))
(aeq 'logand 0 (logand #xAAAA #x5555))
(aeq 'logior 0 (logior))
(aeq 'logior 170 (logior #xAA))
(aeq 'logior #xFFFF (logior #xAAAA #x5555))
(aeq 'logxor 0 (logxor))
(aeq 'logxor 170 (logior #xAA))
(aeq 'logxor 255 (logxor #xAAAA #xAA55))
(aeq 'lognot #x5555 (lognot #xAAAA))
(aeq 'ash 492 (ash 123 2))
(aeq 'ash #xFFFF (ash #xFFFF 0))
(aeq 'ash #xFFFF (ash #xFFFF -2))
(aeq 'ash -4 (ash #xFFFF 2))
(aeq 'ash 8191 (ash #x7FFF -2))
(aeq 'logbitp t (logbitp 0 1))
(aeq 'logbitp t (logbitp 1000 -1))
(aeq 'logbitp nil (logbitp 1000 0))
#| Tests |#
(aeq 'atom t (atom nil))
(aeq 'atom t (atom t))
(aeq 'atom nil (atom '(1 2)))
(aeq 'consp nil (consp 'b))
(aeq 'consp t (consp '(a b)))
(aeq 'consp nil (consp nil))
(aeq 'listp nil (listp 'b))
(aeq 'listp t (listp '(a b)))
(aeq 'listp t (listp nil))
(aeq 'numberp t (numberp (+ 1 2)))
(aeq 'numberp nil (numberp 'b))
(aeq 'numberp nil (numberp nil))
(aeq 'symbolp t (symbolp 'b))
(aeq 'symbolp nil (symbolp 3))
(aeq 'symbolp t (symbolp nil))
(aeq 'streamp nil (streamp 'b))
(aeq 'streamp nil (streamp nil))
(aeq 'boundp t (let (x) (boundp 'x)))
(aeq 'boundp nil (let (x) (boundp 'y)))
#| cxr operations |#
(aeq 'car 'a (car '(a b c)))
(aeq 'car nil (car nil))
(aeq 'first 'a (first '(a b c)))
(aeq 'first nil (first nil))
(aeq 'cdr 'b (cdr '(a . b)))
(aeq 'cdr 'b (car (cdr '(a b))))
(aeq 'cdr nil (cdr nil))
(aeq 'rest 'b (rest '(a . b)))
(aeq 'rest 'b (car (rest '(a b))))
(aeq 'rest nil (rest nil))
(aeq 'caaar 'a (caaar '(((a)))))
(aeq 'caaar 'nil (caaar nil))
(aeq 'caadr 'b (caadr '(a (b))))
(aeq 'caadr 'nil (caadr nil))
(aeq 'caar 'a (caar '((a))))
(aeq 'caar 'nil (caar nil))
(aeq 'cadar 'c (cadar '((a c) (b))))
(aeq 'cadar 'nil (cadar nil))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'cadr 'b (cadr '(a b)))
(aeq 'second 'nil (second '(a)))
(aeq 'second 'b (second '(a b)))
(aeq 'cadr 'nil (cadr '(a)))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'third 'c (third '(a b c)))
(aeq 'third 'nil (third nil))
(aeq 'cdaar 'b (car (cdaar '(((a b)) b c))))
(aeq 'cdaar 'nil (cdaar nil))
(aeq 'cdadr 'c (car (cdadr '(a (b c)))))
(aeq 'cdadr 'nil (cdadr nil))
(aeq 'cdar 'b (car (cdar '((a b c)))))
(aeq 'cdar 'nil (cdar nil))
(aeq 'cddar 'c (car (cddar '((a b c)))))
(aeq 'cddar 'nil (cddar nil))
(aeq 'cdddr 'd (car (cdddr '(a b c d))))
(aeq 'cdddr nil (car (cdddr '(a b c))))
(aeq 'cddr 'c (car (cddr '(a b c))))
(aeq 'cddr 'nil (cddr '(a)))
#| List operations |#
(aeq 'cons 'a (car (cons 'a 'b)))
(aeq 'cons nil (car (cons nil 'b)))
(aeq 'append 6 (length (append '(a b c) '(d e f))))
(aeq 'append nil (append nil nil))
(aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6)))
(aeq 'list nil (car (list nil)))
(aeq 'list 'a (car (list 'a 'b 'c)))
(aeq 'reverse 'c (car (reverse '(a b c))))
(aeq 'reverse nil (reverse nil))
(aeq 'length 0 (length nil))
(aeq 'length 4 (length '(a b c d)))
(aeq 'length 2 (length '(nil nil)))
(aeq 'assoc nil (assoc 'b nil))
(aeq 'assoc nil (assoc 'b '(nil nil)))
(aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12))))
(aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12))))
(aeq 'assoc '(b) (assoc 'b '((a . 10) (b))))
(aeq 'mapc 2 (cadr (mapc + '(1 2 3 4))))
(aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x))
(aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5)))
(aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6)))
(aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4)))
(aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11)))
(aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4))))
(aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4))))
#| let/let*/lambda |#
(aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y)))
(aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y)))
(aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3))
(aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4))
(aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2))
(aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3))
(aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3))
(aeq 'lambda 123 ((lambda (list) list) 123))
#| loops and control |#
(aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x))))
(aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y)))))
(aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y)))))
(aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y)))))
(aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y)))))
(aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x))))
(aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x))))
#| conditions |#
(aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4)))
(aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4)))
(aeq 'if 4 (let ((a 3)) (if (= a 3) 4)))
(aeq 'if nil (let ((a 4)) (if (= a 3) 4)))
(aeq 'when 4 (let ((a 3)) (when (= a 3) 4)))
(aeq 'when nil (let ((a 2)) (when (= a 3) 4)))
(aeq 'unless nil (let ((a 3)) (unless (= a 3) 4)))
(aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4)))
(aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9))))
(aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9))))
(aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8))))
(aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4))))))
(aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
#| eval/funcall/apply |#
(aeq 'funcall 10 (funcall + 1 2 3 4))
(aeq 'funcall 'a (funcall car '(a b c d)))
(aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x))
(aeq 'apply 10 (apply + '(1 2 3 4)))
(aeq 'apply 13 (apply + 1 2 '(1 2 3 4)))
(aeq 'eval 10 (eval (list + 1 2 3 4)))
(aeq 'eval nil (eval nil))
(aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2)))
(aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3))))
#| in-place operations |#
(aeq 'incf 6 (let ((x 0)) (+ (incf x) (incf x) (incf x))))
(aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2))))
(aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1)))))
(aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b)))
(aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a)))
(aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a)))
(aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a)))
#| recursion |#
(aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10)))
(aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7)))
(aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a))
#| streams |#
(aeq 'stream "<string-stream 0>" (with-output-to-string (s) (princ s s)))
(aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34)))
(aeq 'pprint 8313 (let ((n 0) (st (with-output-to-string (str) (pprint aeq str)))) (dotimes (i (length st) n) (incf n (char-code (char st i))))))
#| printing |#
(aeq 'princ "hello" (princ-to-string "hello"))
(aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\""))
(aeq 'prin1 "\"hello\"" (prin1-to-string "hello"))
(aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\""))
#| format |#
(aeq 'format "hello" (format nil "hello"))
(aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23))
(aeq 'format " 17" (format nil "~5x" 23))
(aeq 'format " 10111" (format nil "~6b" 23))
(aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23))
(aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23))
(aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7))
(aeq 'format "Hello42" (format nil "Hello~a" 42))
(aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3)))
(aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil))
#| strings |#
(aeq 'stringp t (stringp "hello"))
(aeq 'stringp nil (stringp 5))
(aeq 'stringp nil (stringp '(a b)))
(aeq 'numberp nil (numberp "hello"))
(aeq 'atom t (atom "hello"))
(aeq 'consp nil (consp "hello"))
(aeq 'eq nil (eq "hello" "hello"))
(aeq 'eq t (let ((a "hello")) (eq a a)))
(aeq 'length 0 (length ""))
(aeq 'length 5 (length "hello"))
(aeq 'subseq "hello" (subseq "hellofromdavid" 0 5))
(aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5))
(aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB"))
(aeq 'concatenate 3 (length (concatenate 'string "A" "BC")))
(aeq 'concatenate 0 (length (concatenate 'string)))
(aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD"))
(aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE"))
(aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE"))
(aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF"))
(aeq 'string< nil (string< "cat" "cat"))
(aeq 'string< t (string< "cat" "cat "))
(aeq 'string< t (string< "fish" "fish "))
(aeq 'string> nil (string> "cat" "cat"))
(aeq 'string> t (string> "cat " "cat"))
(aeq 'string "albatross" (string "albatross"))
(aeq 'string "x" (string #\x))
(aeq 'string "cat" (string 'cat))
(aeq 'string "albatross" (string 'albatross))
#| characters |#
(aeq 'char-code 97 (char-code #\a))
(aeq 'char-code 13 (char-code #\return))
(aeq 'char-code 255 (char-code #\255))
(aeq 'code-char #\return (code-char 13))
(aeq 'code-char #\a (code-char 97))
(aeq 'code-char #\255 (code-char 255))
(aeq 'eq t (eq #\b #\b))
(aeq 'eq nil (eq #\b #\B))
(aeq 'numberp nil (numberp #\b))
(aeq 'characterp t (characterp #\b))
(aeq 'char #\o (char "hello" 4))
(aeq 'char #\h (char "hello" 0))
(aeq 'char "A" (princ-to-string (code-char 65)))
(aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7)))
(aeq 'char "[#\\Return]" (format nil "[~s]" #\return))
(aeq 'char "[#\\127]" (format nil "[~s]" #\127))
(aeq 'char "[#\\255]" (format nil "[~s]" #\255))
#| read-from-string |#
(aeq 'read-from-string 123 (read-from-string "123"))
(aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)")))
(aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)")))
(aeq 'read-from-string nil (read-from-string "()"))
#| closures |#
(aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn))))))
(aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1)))
(aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x))
(aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x))
(aeq 'closure '(8 10 13 17) (let ((x 0) (clo (lambda () (let ((x 7)) (lambda (y) (incf x y)))))) (mapcar (funcall clo) '(1 2 3 4))))
(aeq 'closure 3 (let ((y 0) (tst (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (tst (+ x 2))) (incf y x))))
#| repl |#
(aeq 'repl 23 (read-from-string "23(2)"))
(aeq 'repl nil (read-from-string "()23"))
(aeq 'repl 23 (read-from-string "23\"Hi\""))
(aeq 'repl "Hi" (read-from-string "\"Hi\"23"))
(aeq 'repl #\1 (read-from-string " #\\1\"Hi\""))
(aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101")))
#| subseq/equal |#
(aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2))
(aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3))
(aeq 'subseq nil (subseq '() 0))
(aeq 'equal t (equal '(1 2 3) '(1 2 3)))
(aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3)))
(aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3)))
(aeq 'equal t (equal "cat" "cat"))
(aeq 'equal nil (equal "cat" "Cat"))
(aeq 'equal t (equal 'cat 'Cat))
(aeq 'equal t (equal 2 (+ 1 1)))
#| keywords |#
(aeq 'keywordp t (keywordp :led-builtin))
(aeq 'keywordp nil (keywordp print))
(aeq 'keywordp nil (keywordp nil))
(aeq 'keywordp nil (keywordp 12))
"#)
(defun run-tests (&optional (usb 1411)) ; "/dev/cu.usbserial-A104OVGT")) ;
(let ((name (cond
((numberp usb) (format nil "/dev/cu.usbmodem~a" usb))
((eq usb :badge) "/dev/cu.usbserial-A104OVGT") ; "/dev/cu.usbserial-A602TRZF"
((eq usb :star) "/dev/cu.usbserial-A10JYSPG")
(t usb)))
(speed 0.5))
(flet ((serial-write-exp (string stream)
(write-string string stream)
(write-char #\newline stream))
;;
(echo (s)
(sleep speed)
(loop
(let ((c (read-char-no-hang s)))
(unless c (return))
(unless (eq c #\return) (write-char c))))
(format t "~%"))
;;
(read-serial (s)
(sleep speed)
(let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
(loop
(let ((c (read-char-no-hang s)))
(unless c (return string))
(vector-push-extend c string))))))
;;
(with-open-stream (s (make-instance 'serial-stream :name name))
(echo s)
(echo s)
(serial-write-exp "(defvar ers 0)" s)
(echo s)
(serial-write-exp
"(defun aeq (tst x y)
(unless (equal x y)
(incf ers)
(format t \"~a=~a/~a~%\" tst x y)))"
s)
(echo s)
;;
;; tests
;;
(with-input-from-string (str *tests*)
(loop
(let ((line (read-line str nil nil)))
(unless line (return))
(serial-write-exp line s)
(let ((output (read-serial s)))
(let* ((m1 (position #\return output))
(m2 (when m1 (position #\return output :start (+ 2 m1)))))
(cond
((null m2) (format t "~a~%" output))
((string= (subseq output (+ 2 m1) m2) "nil") nil)
(t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1)))))))))))))

700
builder/Test Suites/AutoTester AVR.lisp Normal file
View File

@ -0,0 +1,700 @@
; uLisp Auto Tester
; Sharp-double-quote
(defun sharp-double-quote-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let (chars)
(do ((prev (read-char stream) curr)
(curr (read-char stream) (read-char stream)))
((and (char= prev #\") (char= curr #\#)))
(push prev chars))
(coerce (nreverse chars) 'string)))
(set-dispatch-macro-character
#\# #\" #'sharp-double-quote-reader)
; do (run-tests)
;;; ================================================================
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "serial-port"))
(cl:in-package "CL-USER")
;;; ================================================================
;;; Class SERIAL-STREAM
(defclass serial-stream (stream:fundamental-character-input-stream
stream:fundamental-character-output-stream)
((serial-port :initform nil
:initarg :serial-port
:accessor stream-serial-port)))
(defmethod initialize-instance :after ((stream serial-stream)
&key name (baud-rate 9600) (data-bits 8) (stop-bits 1) (parity :none)
&allow-other-keys)
(unless (stream-serial-port stream)
(check-type name string)
(setf (stream-serial-port stream)
(serial-port:open-serial-port name
:baud-rate baud-rate
:data-bits data-bits
:stop-bits stop-bits
:parity parity))))
(defmethod stream-element-type ((stream serial-stream))
'character)
(defmethod input-stream-p ((stream serial-stream))
t)
(defmethod output-stream-p ((stream serial-stream))
t)
;;; ================================================================
;;; Input
(defmethod stream:stream-read-char ((stream serial-stream))
(serial-port:read-serial-port-char (stream-serial-port stream)))
(defmethod stream:stream-read-char-no-hang ((stream serial-stream))
(when (stream:stream-listen stream)
(stream:stream-read-char stream)))
(defmethod stream:stream-listen ((stream serial-stream))
(serial-port:serial-port-input-available-p (stream-serial-port stream)))
(defmethod stream:stream-clear-input ((stream serial-stream))
(loop while (stream:stream-listen stream)
do (stream:stream-read-char stream))
nil)
;;; ================================================================
;;; Output
(defmethod stream:stream-write-char ((stream serial-stream) char)
(serial-port:write-serial-port-char char (stream-serial-port stream)))
(defmethod stream:stream-write-string ((stream serial-stream) string &optional (start 0) (end (length string)))
(serial-port:write-serial-port-string string (stream-serial-port stream) t :start start :end end))
(defmethod stream:stream-force-output ((stream serial-stream))
nil)
(defmethod stream:stream-finish-output ((stream serial-stream))
nil)
(defmethod stream:stream-clear-output ((stream serial-stream))
nil)
(defmethod close :after ((stream serial-stream) &key abort)
(declare (ignorable abort))
(serial-port:close-serial-port (stream-serial-port stream)))
;;; ================================================================
;;; Example
(defparameter *tests*
#"#| Symbols |#
(aeq 'let 123 (let ((cat 123)) cat))
(aeq 'let 79 (let ((ca% 79)) ca%))
(aeq 'let 83 (let ((1- 83)) 1-))
(aeq 'let 13 (let ((12a 13)) 12a))
(aeq 'let 17 (let ((-1- 17)) -1-))
(aeq 'let 66 (let ((abcdef 66)) abcdef))
(aeq 'let 77 (let ((abcdefg 77)) abcdefg))
(aeq 'let 88 (let ((abcdefgh 88)) abcdefgh))
(aeq 'let 99 (let ((abcdefghi 99)) abcdefghi))
(aeq 'let 1010 (let ((abcdefghij 1010)) abcdefghij))
(aeq 'let "ab9" (princ-to-string 'ab9))
(aeq 'let t (eq 'me 'me))
(aeq 'let t (eq 'fishcake 'fishcake))
(aeq 'let nil (eq 'fishcak 'fishca))
#| Arithmetic |#
(aeq '* 9 (* -3 -3))
(aeq '* 32580 (* 180 181))
(aeq '* 1 (*))
(aeq '+ 32767 (+ 32765 1 1))
(aeq '+ 0 (+))
(aeq '+ -2 (+ -1 -1))
(aeq '- -4 (- 4))
(aeq '- 0 (- 4 2 1 1))
(aeq '/ 2 (/ 60 10 3))
(aeq '1+ 2 (1+ 1))
(aeq '1+ 0 (1+ -1))
(aeq '1- 0 (1- 1))
#| Comparisons |#
(aeq '< t (< -32768 32767))
(aeq '< t (< -1 0))
(aeq '< t (< 1 2 3 4))
(aeq '< nil (< 1 2 2 4))
(aeq '< t (<= 1 2 2 4))
(aeq '< nil (<= 1 3 2 4))
(aeq '< t (> 4 3 2 1))
(aeq '< nil (> 4 2 2 1))
(aeq '< t (>= 4 2 2 1))
(aeq '< nil (>= 4 2 3 1))
(aeq '< t (< 1))
(aeq '< nil (< 1 3 2))
(aeq '< nil (< -1 -2))
(aeq '< nil (< 10 10))
(aeq '<= t (<= 10 10))
(aeq '= t (= 32767 32767))
(aeq '>= t (>= 10 10))
(aeq '>= nil (>= 9 10))
(aeq '/= t (/= 1))
(aeq '/= nil (/= 1 2 1))
(aeq '/= nil (/= 1 2 3 1))
(aeq '/= t (/= 1 2 3 4))
(aeq 'plusp t (plusp 1))
(aeq 'plusp nil (plusp 0))
(aeq 'plusp nil (plusp -1))
(aeq 'minusp nil (minusp 1))
(aeq 'minusp nil (minusp 0))
(aeq 'minusp t (minusp -1))
(aeq 'zerop nil (zerop 1))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop -1))
(aeq 'evenp nil (evenp 1))
(aeq 'evenp t (evenp 0))
(aeq 'evenp nil (evenp -1))
(aeq 'oddp t (oddp 1))
(aeq 'oddp nil (oddp 0))
(aeq 'oddp t (oddp -1))
#| Maths functions |#
(aeq 'abs 10 (abs 10))
(aeq 'abs 10 (abs -10))
(aeq 'max 45 (max 23 45))
(aeq 'max -23 (max -23 -45))
(aeq 'min 23 (min 23 45))
(aeq 'min -45 (min -23 -45))
(aeq 'zerop t (zerop 0))
(aeq 'zerop nil (zerop 32767))
(aeq 'mod 1 (mod 13 4))
(aeq 'mod 3 (mod -13 4))
(aeq 'mod -3 (mod 13 -4))
(aeq 'mod -1 (mod -13 -4))
#| Number entry |#
(aeq 'hex -1 #xFFFF)
(aeq 'hex 1 #x0001)
(aeq 'hex 4112 #x1010)
(aeq 'oct 511 #o777)
(aeq 'oct 1 #o1)
(aeq 'oct -1 #o177777)
(aeq 'bin -1 #b1111111111111111)
(aeq 'bin 10 #b1010)
(aeq 'bin 0 #b0)
(aeq 'hash 12 #'12)
(aeq 'hash 6 (funcall #'(lambda (x) (+ x 2)) 4))
#| Boolean |#
(aeq 'and 7 (and t t 7))
(aeq 'and nil (and t nil 7))
(aeq 'or t (or t nil 7))
(aeq 'or 1 (or 1 2 3))
(aeq 'or nil (or nil nil nil))
(aeq 'or 'a (or 'a 'b 'c))
(aeq 'or 1 (let ((x 0)) (or (incf x)) x))
#| Bitwise |#
(aeq 'logand -1 (logand))
(aeq 'logand 170 (logand #xAA))
(aeq 'logand 0 (logand #xAAAA #x5555))
(aeq 'logior 0 (logior))
(aeq 'logior 170 (logior #xAA))
(aeq 'logior #xFFFF (logior #xAAAA #x5555))
(aeq 'logxor 0 (logxor))
(aeq 'logxor 170 (logior #xAA))
(aeq 'logxor 255 (logxor #xAAAA #xAA55))
(aeq 'lognot #x5555 (lognot #xAAAA))
(aeq 'ash 492 (ash 123 2))
(aeq 'ash #xFFFF (ash #xFFFF 0))
(aeq 'ash #xFFFF (ash #xFFFF -2))
(aeq 'ash -4 (ash #xFFFF 2))
(aeq 'ash 8191 (ash #x7FFF -2))
(aeq 'logbitp t (logbitp 0 1))
(aeq 'logbitp t (logbitp 1000 -1))
(aeq 'logbitp nil (logbitp 1000 0))
#| Tests |#
(aeq 'atom t (atom nil))
(aeq 'atom t (atom t))
(aeq 'atom nil (atom '(1 2)))
(aeq 'consp nil (consp 'b))
(aeq 'consp t (consp '(a b)))
(aeq 'consp nil (consp nil))
(aeq 'listp nil (listp 'b))
(aeq 'listp t (listp '(a b)))
(aeq 'listp t (listp nil))
(aeq 'numberp t (numberp (+ 1 2)))
(aeq 'numberp nil (numberp 'b))
(aeq 'numberp nil (numberp nil))
(aeq 'symbolp t (symbolp 'b))
(aeq 'symbolp nil (symbolp 3))
(aeq 'symbolp t (symbolp nil))
(aeq 'streamp nil (streamp 'b))
(aeq 'streamp nil (streamp nil))
(aeq 'boundp t (let (x) (boundp 'x)))
(aeq 'boundp nil (let (x) (boundp 'y)))
#| cxr operations |#
(aeq 'car 'a (car '(a b c)))
(aeq 'car nil (car nil))
(aeq 'first 'a (first '(a b c)))
(aeq 'first nil (first nil))
(aeq 'cdr 'b (cdr '(a . b)))
(aeq 'cdr 'b (car (cdr '(a b))))
(aeq 'cdr nil (cdr nil))
(aeq 'rest 'b (rest '(a . b)))
(aeq 'rest 'b (car (rest '(a b))))
(aeq 'rest nil (rest nil))
(aeq 'caaar 'a (caaar '(((a)))))
(aeq 'caaar 'nil (caaar nil))
(aeq 'caadr 'b (caadr '(a (b))))
(aeq 'caadr 'nil (caadr nil))
(aeq 'caar 'a (caar '((a))))
(aeq 'caar 'nil (caar nil))
(aeq 'cadar 'c (cadar '((a c) (b))))
(aeq 'cadar 'nil (cadar nil))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'cadr 'b (cadr '(a b)))
(aeq 'second 'nil (second '(a)))
(aeq 'second 'b (second '(a b)))
(aeq 'cadr 'nil (cadr '(a)))
(aeq 'caddr 'c (caddr '(a b c)))
(aeq 'caddr 'nil (caddr nil))
(aeq 'third 'c (third '(a b c)))
(aeq 'third 'nil (third nil))
(aeq 'cdaar 'b (car (cdaar '(((a b)) b c))))
(aeq 'cdaar 'nil (cdaar nil))
(aeq 'cdadr 'c (car (cdadr '(a (b c)))))
(aeq 'cdadr 'nil (cdadr nil))
(aeq 'cdar 'b (car (cdar '((a b c)))))
(aeq 'cdar 'nil (cdar nil))
(aeq 'cddar 'c (car (cddar '((a b c)))))
(aeq 'cddar 'nil (cddar nil))
(aeq 'cdddr 'd (car (cdddr '(a b c d))))
(aeq 'cdddr nil (car (cdddr '(a b c))))
(aeq 'cddr 'c (car (cddr '(a b c))))
(aeq 'cddr 'nil (cddr '(a)))
#| List operations |#
(aeq 'cons 'a (car (cons 'a 'b)))
(aeq 'cons nil (car (cons nil 'b)))
(aeq 'append 6 (length (append '(a b c) '(d e f))))
(aeq 'append nil (append nil nil))
(aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6)))
(aeq 'list nil (car (list nil)))
(aeq 'list 'a (car (list 'a 'b 'c)))
(aeq 'reverse 'c (car (reverse '(a b c))))
(aeq 'reverse nil (reverse nil))
(aeq 'length 0 (length nil))
(aeq 'length 4 (length '(a b c d)))
(aeq 'length 2 (length '(nil nil)))
(aeq 'assoc nil (assoc 'b nil))
(aeq 'assoc nil (assoc 'b '(nil nil)))
(aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12))))
(aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12))))
(aeq 'assoc '(b) (assoc 'b '((a . 10) (b))))
(aeq 'assoc '("three" . 3) (assoc "three" '(("one" . 1) ("two" . 2) ("three" . 3)) :test string=))
(aeq 'member '(3 4) (member 3 '(1 2 3 4)))
(aeq 'member nil (member 5 '(1 2 3 4)))
(aeq 'member '(3 4) (member 3 '(1 2 3 4) :test eq))
(aeq 'member '("three" "four") (member "three" '("one" "two" "three" "four") :test string=))
(aeq 'member '("two" "three" "four") (member "three" '("one" "two" "three" "four") :test string<))
#| map operations |#
(aeq 'mapc 2 (cadr (mapc + '(1 2 3 4))))
(aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x))
(aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4)))
(aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5)))
(aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6)))
(aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4)))
(aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11)))
(aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4))))
(aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4))))
(aeq 'maplist '(((1 2 3) 6 7 8) ((2 3) 7 8) ((3) 8)) (maplist #'cons '(1 2 3) '(6 7 8)))
(aeq 'maplist '(1 2 3) (mapl #'cons '(1 2 3) '(6 7 8)))
(aeq 'mapcan '(3 7 11) (mapcon (lambda (x) (when (eq (first x) (second x)) (list (car x)))) '(1 2 3 3 5 7 7 8 9 11 11)))
#| let/let*/lambda |#
(aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y)))
(aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y)))
(aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z))))
(aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3))
(aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4))
(aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2))
(aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3))
(aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3))
(aeq 'lambda 123 ((lambda (list) list) 123))
#| loops and control |#
(aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x))))
(aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y)))))
(aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y)))))
(aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y)))))
(aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y)))))
(aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y)))))
(aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x))))
(aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x))))
(aeq 'return 'a (let ((a 7)) (loop (progn (return 'a)))))
(aeq 'return nil (loop (return)))
(aeq 'return 'a (let ((a 7)) (loop (progn (return 'a) nil))))
(aeq 'do 2 (do* ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x)))
(aeq 'do 3 (do ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x)))
(aeq 'do 720 (do* ((n 6) (f 1 (* j f)) (j n (- j 1))) ((= j 0) f)))
(aeq 'do 720 (let ((n 6)) (do ((f 1 (* j f)) (j n (- j 1)) ) ((= j 0) f))))
(aeq 'do 10 (do (a (b 1 (1+ b))) ((> b 10) a) (setq a b)))
#| conditions |#
(aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4)))
(aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4)))
(aeq 'if 4 (let ((a 3)) (if (= a 3) 4)))
(aeq 'if nil (let ((a 4)) (if (= a 3) 4)))
(aeq 'when 4 (let ((a 3)) (when (= a 3) 4)))
(aeq 'when nil (let ((a 2)) (when (= a 3) 4)))
(aeq 'unless nil (let ((a 3)) (unless (= a 3) 4)))
(aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4)))
(aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9))))
(aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9))))
(aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8))))
(aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4))))))
(aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
(aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444))))
#| eval/funcall/apply |#
(aeq 'funcall 10 (funcall + 1 2 3 4))
(aeq 'funcall 'a (funcall car '(a b c d)))
(aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x))
(aeq 'apply 10 (apply + '(1 2 3 4)))
(aeq 'apply 13 (apply + 1 2 '(1 2 3 4)))
(aeq 'eval 10 (eval (list + 1 2 3 4)))
(aeq 'eval nil (eval nil))
(aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2)))
(aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2)))
(aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3))))
#| in-place operations |#
(aeq 'incf 5 (let ((x 0)) (+ (incf x) (incf x 2) (incf x -2))))
(aeq 'decf -5 (let ((x 0)) (+ (decf x) (decf x 2) (decf x -2))))
(aeq 'incf 6 (let ((x 0)) (+ (incf x) (incf x) (incf x))))
(aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2))))
(aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1)))))
(aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b)))
(aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a)))
(aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a)))
(aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a)))
#| recursion |#
(aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10)))
(aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7)))
(aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a))
#| streams |#
(aeq 'stream "<string-stream 0>" (with-output-to-string (s) (princ s s)))
(aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34)))
#| features |#
(aeq 'features nil (member :floating-point *features*))
(aeq 'features ":arrays" (princ-to-string (first (member :arrays *features*))))
#| printing |#
(aeq 'princ "hello" (princ-to-string "hello"))
(aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\""))
(aeq 'prin1 "\"hello\"" (prin1-to-string "hello"))
(aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\""))
#| prettyprinting |#
(aeq 'princ "hello" (princ-to-string "hello"))
(aeq 'pprint 8313 (let ((n 0) (st (with-output-to-string (str) (pprint aeq str)))) (dotimes (i (length st) n) (incf n (char-code (char st i))))))
#| documentation |#
(aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list 'pro))
(aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list "pro"))
(aeq 'documentation 7397 (let ((n 0)) (let ((st (documentation '?))) (dotimes (i (length st) n) (incf n (char-code (char st i)))))))
#| format |#
(aeq 'format "hello" (format nil "hello"))
(aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23))
(aeq 'format " 17" (format nil "~5x" 23))
(aeq 'format " 10111" (format nil "~6b" 23))
(aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23))
(aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23))
(aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7))
(aeq 'format "Hello42" (format nil "Hello~a" 42))
(aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3)))
(aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil))
#| strings |#
(aeq 'stringp t (stringp "hello"))
(aeq 'stringp nil (stringp 5))
(aeq 'stringp nil (stringp '(a b)))
(aeq 'numberp nil (numberp "hello"))
(aeq 'atom t (atom "hello"))
(aeq 'consp nil (consp "hello"))
(aeq 'eq nil (eq "hello" "hello"))
(aeq 'eq t (let ((a "hello")) (eq a a)))
(aeq 'length 0 (length ""))
(aeq 'length 5 (length "hello"))
(aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB"))
(aeq 'concatenate 3 (length (concatenate 'string "A" "BC")))
(aeq 'concatenate 0 (length (concatenate 'string)))
(aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD"))
(aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE"))
(aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE"))
(aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF"))
(aeq 'string= nil (string= "cat" "cat "))
(aeq 'string= t (string= "cat" "cat"))
(aeq 'string/= 3 (string/= "cat" "catx"))
(aeq 'string/= nil (string/= "cat" "cat"))
(aeq 'string/= nil (string/= "catt" "catt"))
(aeq 'string< nil (string< "cat" "cat"))
(aeq 'string<= 3 (string<= "cat" "cat"))
(aeq 'string< 3 (string< "cat" "cat "))
(aeq 'string< 4 (string< "fish" "fish "))
(aeq 'string> nil (string> "cat" "cat"))
(aeq 'string>= 3 (string>= "cat" "cat"))
(aeq 'string>= 5 (string>= "cattx" "cattx"))
(aeq 'string> 0 (string> "c" "a"))
(aeq 'string> 1 (string> "fc" "fa"))
(aeq 'string> 2 (string> "ffc" "ffa"))
(aeq 'string> 3 (string> "fffc" "fffa"))
(aeq 'string> 4 (string> "ffffc" "ffffa"))
(aeq 'string> 5 (string> "fffffc" "fffffa"))
(aeq 'string> nil (string< "fffffc" "fffffa"))
(aeq 'string "albatross" (string "albatross"))
(aeq 'string "x" (string #\x))
(aeq 'string "cat" (string 'cat))
(aeq 'string "albatross" (string 'albatross))
#| subseq and search |#
(aeq 'subseq "hello" (subseq "hellofromdavid" 0 5))
(aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5))
(aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2))
(aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3))
(aeq 'subseq nil (subseq '() 0))
(aeq 'search 4 (search "cat" "the cat sat on the mat"))
(aeq 'search 19 (search "mat" "the cat sat on the mat"))
(aeq 'search nil (search "hat" "the cat sat on the mat"))
(aeq 'search 1 (search '(1 2) '( 0 1 2 3 4)))
(aeq 'search nil (search '(2 1 2 3 4 5) '(2 1 2 3 4)))
#| characters |#
(aeq 'char-code 97 (char-code #\a))
(aeq 'char-code 13 (char-code #\return))
(aeq 'char-code 255 (char-code #\255))
(aeq 'code-char #\return (code-char 13))
(aeq 'code-char #\a (code-char 97))
(aeq 'code-char #\255 (code-char 255))
(aeq 'eq t (eq #\b #\b))
(aeq 'eq nil (eq #\b #\B))
(aeq 'numberp nil (numberp #\b))
(aeq 'characterp t (characterp #\b))
(aeq 'char #\o (char "hello" 4))
(aeq 'char #\h (char "hello" 0))
(aeq 'char "A" (princ-to-string (code-char 65)))
(aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7)))
(aeq 'char "[#\\Return]" (format nil "[~s]" #\return))
(aeq 'char "[#\\127]" (format nil "[~s]" #\127))
(aeq 'char "[#\\255]" (format nil "[~s]" #\255))
#| read-from-string |#
(aeq 'read-from-string 123 (read-from-string "123"))
(aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)")))
(aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)")))
(aeq 'read-from-string nil (read-from-string "()"))
#| closures |#
(aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn))))))
(aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1)))
(aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x))
(aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x))
(aeq 'closure '(8 10 13 17) (let ((x 0) (clo (lambda () (let ((x 7)) (lambda (y) (incf x y)))))) (mapcar (funcall clo) '(1 2 3 4))))
(aeq 'closure 3 (let ((y 0) (test (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (test (+ x 2))) (incf y x))))
#| arrays |#
(aeq 'array '(0 0) (array-dimensions #2a()))
(aeq 'array '(1 0) (array-dimensions #2a(())))
(aeq 'array '(2 0) (array-dimensions #2a(() ())))
(aeq 'array '(0) (array-dimensions (make-array '(0))))
(aeq 'array '(0) (array-dimensions (make-array 0)))
(aeq 'array 1 (let ((a (make-array 3 :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array '(3) :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array '(2 3) :initial-element 0))) (incf (aref a 1 (+ 1 1))) (aref a 1 2)))
(aeq 'array 1 (let ((a (make-array '(2 3 2 2) :initial-element 0))) (incf (aref a 1 (+ 1 1) 1 1)) (aref a 1 2 1 1)))
(aeq 'array 10 (length (make-array 10 :initial-element 1)))
#| bit arrays |#
(aeq 'array '(0) (array-dimensions (make-array '(0) :element-type 'bit)))
(aeq 'array '(1 1) (array-dimensions (make-array '(1 1) :element-type 'bit)))
(aeq 'array 10 (length (make-array '(10) :element-type 'bit)))
(aeq 'array 10 (length (make-array 10 :element-type 'bit)))
(aeq 'array 1 (let ((a (make-array 3 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 1 (let ((a (make-array 3 :initial-element 0 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2)))
(aeq 'array 0 (let ((a (make-array 10 :element-type 'bit :initial-element 1))) (decf (aref a 4)) (aref a 4)))
(aeq 'array 1 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (aref a 39)))
(aeq 'array 0 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (decf (aref a 39)) (aref a 39)))
#| repl |#
(aeq 'repl 23 (read-from-string "23(2)"))
(aeq 'repl nil (read-from-string "()23"))
(aeq 'repl 23 (read-from-string "23\"Hi\""))
(aeq 'repl "Hi" (read-from-string "\"Hi\"23"))
(aeq 'repl #\1 (read-from-string " #\\1\"Hi\""))
(aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101")))
#| equal |#
(aeq 'equal t (equal '(1 2 3) '(1 2 3)))
(aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3)))
(aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3)))
(aeq 'equal t (equal "cat" "cat"))
(aeq 'equal nil (equal "cat" "Cat"))
(aeq 'equal t (equal 'cat 'Cat))
(aeq 'equal t (equal 2 (+ 1 1)))
(aeq 'equal t (equal '("cat" "dog") '("cat" "dog")))
(aeq 'equal nil (equal '("cat" "dog") '("cat" "dig")))
#| keywords |#
(aeq 'keywordp t (keywordp :led-builtin))
(aeq 'keywordp nil (keywordp print))
(aeq 'keywordp nil (keywordp nil))
(aeq 'keywordp nil (keywordp 12))
(aeq 'keywordp t (keywordp :fred))
(aeq 'keywordp t (keywordp :initial-element))
(aeq 'keywordp t (keywordp :element-type))
#| errors |#
(aeq 'error 7 (let ((x 7)) (ignore-errors (setq x (/ 1 0))) x))
(aeq 'error 5 (unwind-protect (+ 2 3) 13))
#| Place |#
(aeq 'setf "hellx" (let ((s "hello")) (setf (char s 4) #\x) s))
#| error checks |#
(aeq 'dolist nothing (ignore-errors (dolist 12 (print x))))
(aeq 'dolist nothing (ignore-errors (dolist () (print x))))
(aeq 'dolist nothing (ignore-errors (dolist (x) (print x))))
(aeq 'dolist nothing (ignore-errors (dolist (x nil x x) (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes 12 (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes () (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes (x) (print x))))
(aeq 'dotimes nothing (ignore-errors (dotimes (x 1 x x) (print x))))
(aeq 'for-millis nothing (ignore-errors (for-millis 12 (print 12))))
(aeq 'for-millis nothing (ignore-errors (for-millis (12 12) (print 12))))
(aeq 'push nothing (ignore-errors (let ((a #*00000000)) (push 1 (aref a 1)) a)))
(aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 5) #\x) s)))
(aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 20) #\x) s)))
#| errors |#
(aeq 'errors 0 ers)
"#)
(defun run-tests (&optional (usb 1411)) ; "/dev/cu.usbserial-A104OVGT")) ;
(let ((name (cond
((numberp usb) (format nil "/dev/cu.usbmodem~a" usb))
((eq usb :badge2) "/dev/cu.usbserial-A104OVGT")
((eq usb :badge) "/dev/cu.usbserial-A10L2FSQ") ; "/dev/cu.usbserial-A602TRZF"
((eq usb :avrfeather) "/dev/cu.SLAB_USBtoUART")
(t usb)))
(speed 0.5))
(flet ((serial-write-exp (string stream)
(write-string string stream)
(write-char #\newline stream))
;;
(echo (s)
(sleep speed)
(loop
(let ((c (read-char-no-hang s)))
(unless c (return))
(unless (eq c #\return) (write-char c))))
(format t "~%"))
;;
(read-serial (s)
(sleep speed)
(let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
(loop
(let ((c (read-char-no-hang s)))
(unless c (return string))
(vector-push-extend c string))))))
;;
(with-open-stream (s (make-instance 'serial-stream :name name))
(sleep 5)
(echo s)
(echo s)
(serial-write-exp "(defvar ers 0)" s)
(echo s)
(serial-write-exp
"(defun aeq (tst x y)
(unless (equal x y)
(incf ers)
(format t \"~a=~a/~a~%\" tst x y)))"
s)
(echo s)
;;
;; tests
;;
(with-input-from-string (str *tests*)
(loop
(let ((line (read-line str nil nil)))
(unless line (return))
(serial-write-exp line s)
(let ((output (read-serial s)))
(let* ((m1 (position #\return output))
(m2 (when m1 (position #\return output :start (+ 2 m1)))))
(cond
((null m2) (format t "~a~%" output))
((string= (subseq output (+ 2 m1) m2) "nil") nil)
(t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1)))))))))))))

630
builder/arm.lisp Normal file
View File

@ -0,0 +1,630 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; Arm
(defparameter *title-arm*
#"/* uLisp ARM Release ~a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - ~a
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/"#)
(defparameter *header-arm* #"
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define gfxsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// #define extensions
// Includes
// #include "LispLibrary.h"
#include <setjmp.h>
#include <SPI.h>
#include <Wire.h>
#include <limits.h>
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 720
#else
#define SDSIZE 0
#endif"#)
(defparameter *workspace-arm* #"
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 36 // Number of bits+4
#define RAMFUNC __attribute__ ((section (".ramfunctions")))
#define MEMBANK
// ATSAMD21 boards ***************************************************************
#if defined(ARDUINO_GEMMA_M0) || defined(ARDUINO_SEEED_XIAO_M0) || defined(ARDUINO_QTPY_M0)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 4
#define CPU_ATSAMD21
#elif defined(ADAFRUIT_FEATHER_M0) /* Feather M0 without DataFlash */
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 4
#define CPU_ATSAMD21
#elif defined(ARDUINO_SAMD_MKRZERO)
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 840
#define CPU_ATSAMD21
#elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define CPUFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD21
// ATSAMD51 boards ***************************************************************
#elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4)
#define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD51
#elif defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4)
#define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define SDCARD_SS_PIN 10
#define CPU_ATSAMD51
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0, TFT_BACKLIGHT = 47;
#include <Adafruit_GFX.h> // Core graphics library
#include <Adafruit_ST7735.h> // Hardware-specific library for ST7735
Adafruit_ST7735 tft = Adafruit_ST7735(44, 45, 41, 42, 46);
#endif
#elif defined(ARDUINO_WIO_TERMINAL)
#define WORKSPACESIZE (20480-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define CPU_ATSAMD51
#define EXTERNAL_FLASH_USE_QSPI
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <TFT_eSPI.h> // Hardware-specific library
TFT_eSPI tft = TFT_eSPI();
#endif
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
#define WORKSPACESIZE (28800-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 8192000 /* 8 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 440
#define CPU_ATSAMD51
// nRF51 boards ***************************************************************
#elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_SINOBIT)
#define WORKSPACESIZE 1344 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
#elif defined(ARDUINO_CALLIOPE_MINI)
#define WORKSPACESIZE 3392 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
// nRF52 boards ***************************************************************
#elif defined(ARDUINO_BBC_MICROBIT_V2)
#define WORKSPACESIZE 12928 /* Objects (8*bytes) */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF52833
#elif defined(ARDUINO_NRF52840_ITSYBITSY) || defined(ARDUINO_Seeed_XIAO_nRF52840) \
|| defined(ARDUINO_Seeed_XIAO_nRF52840_Sense) || defined(ARDUINO_NRF52840_CIRCUITPLAY)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 8
#define CPU_NRF52840
#elif defined(ARDUINO_NRF52840_CLUE)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 8
#define CPU_NRF52840
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <Adafruit_GFX.h>
#include <Adafruit_ST7789.h>
Adafruit_ST7789 tft = Adafruit_ST7789(&SPI1, PIN_TFT_CS, PIN_TFT_DC, PIN_TFT_RST);
#endif
// MAX32620 boards ***************************************************************
#elif defined(MAX32620)
#define WORKSPACESIZE (24704-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 320
#define CPU_MAX32620
#define Wire1 Wire2
// iMXRT1062 boards ***************************************************************
#elif defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define WORKSPACESIZE 60000 /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 15000
#define LITTLEFS (960 * 1024)
#include <LittleFS.h>
LittleFS_Program LittleFS;
#define FS_FILE_WRITE FILE_WRITE_BEGIN
#define FS_FILE_READ FILE_READ
#define CPU_iMXRT1062
#define SDCARD_SS_PIN BUILTIN_SDCARD
#define BitOrder uint8_t
#undef RAMFUNC
#define RAMFUNC FASTRUN
#undef MEMBANK
#define MEMBANK DMAMEM
// RP2040 boards ***************************************************************
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040)
#define WORKSPACESIZE (23000-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2040
#if defined(gfxsupport)
const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0;
#include <Adafruit_GFX.h> // Core graphics library
#include <Adafruit_ST7789.h> // Hardware-specific library for ST7789
Adafruit_ST7789 tft = Adafruit_ST7789(5, 1, 3, 2, 0); // TTGO RP2040 TFT
#define TFT_BACKLIGHT 4
#define TFT_I2C_POWER 22
#endif
#elif defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER)
#define WORKSPACESIZE 23000 /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define SDCARD_SS_PIN 23
#define CPU_RP2040
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
#define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 480
#define LITTLEFS
#include <WiFi.h>
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2040
// RP2350 boards ***************************************************************
#elif defined(ARDUINO_RASPBERRY_PI_PICO_2)
#if defined(__riscv)
#define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2350
#elif defined(ARDUINO_PIMORONI_PICO_PLUS_2)
//#define BOARD_HAS_PSRAM /* Uncomment to use PSRAM */
#if defined(BOARD_HAS_PSRAM)
#undef MEMBANK
#define MEMBANK PSRAM
#define WORKSPACESIZE 1000000 /* Objects (8*bytes) */
#define STACKDIFF 580
#elif defined(__riscv)
#define WORKSPACESIZE (42000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (46500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define SDCARD_SS_PIN 10
#define CPU_RP2350
#elif defined(ARDUINO_PIMORONI_TINY2350)
#if defined(__riscv)
#define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 580
#else
#define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */
#define STACKDIFF 520
#endif
#define CODESIZE 256 /* Bytes */
#define LITTLEFS
#include <LittleFS.h>
#define FS_FILE_WRITE "w"
#define FS_FILE_READ "r"
#define CPU_RP2350
// RA4M1 boards ***************************************************************
#elif defined(ARDUINO_MINIMA)
#define WORKSPACESIZE (2032-SDSIZE) /* Objects (8*bytes) */
#include <EEPROM.h>
#define EEPROMFLASH
#define FLASHSIZE 8192 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define eAnalogReference ar_aref
#define CPU_RA4M1
#define SDCARD_SS_PIN 10
#elif defined(ARDUINO_UNOWIFIR4)
#define WORKSPACESIZE (1610-SDSIZE) /* Objects (8*bytes) */
#include <EEPROM.h>
#include "WiFiS3.h"
#define EEPROMFLASH
#define FLASHSIZE 8192 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define eAnalogReference ar_aref
#define CPU_RA4M1
#define SDCARD_SS_PIN 10
#else
#error "Board not supported!"
#endif"#)
(defparameter *check-pins-arm* #"
// Check pins - these are board-specific not processor-specific
void checkanalogread (int pin) {
#if defined(ARDUINO_SAM_DUE)
if (!(pin>=54 && pin<=65)) error(invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_ZERO)
if (!(pin>=14 && pin<=19)) error(invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_MKRZERO)
if (!(pin>=15 && pin<=21)) error(invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M0)
if (!(pin>=14 && pin<=25)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NEOTRINKEY_M0)
if (!(pin==1 || pin==2 || pin==6)) error(invalidpin, number(pin));
#elif defined(ARDUINO_GEMMA_M0)
if (!(pin>=8 && pin<=10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_QTPY_M0)
if (!((pin>=0 && pin<=3) || (pin>=6 && pin<=10))) error(invalidpin, number(pin));
#elif defined(ARDUINO_SEEED_XIAO_M0)
if (!(pin>=0 && pin<=10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_METRO_M4)
if (!(pin>=14 && pin<=21)) error(invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4)
if (!(pin>=14 && pin<=20)) error(invalidpin, number(pin));
#elif defined(ARDUINO_PYBADGE_M4)
if (!(pin>=14 && pin<=23)) error(invalidpin, number(pin));
#elif defined(ARDUINO_PYGAMER_M4)
if (!(pin>=14 && pin<=25)) error(invalidpin, number(pin));
#elif defined(ARDUINO_WIO_TERMINAL)
if (!((pin>=0 && pin<=8))) error(invalidpin, number(pin));
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
if (!((pin>=67 && pin<=74) || (pin>=54 && pin<=61))) error(invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_SINOBIT)
if (!((pin>=0 && pin<=4) || pin==10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT_V2)
if (!((pin>=0 && pin<=4) || pin==10 || pin==29)) error(invalidpin, number(pin));
#elif defined(ARDUINO_CALLIOPE_MINI)
if (!(pin==1 || pin==2 || (pin>=4 && pin<=6) || pin==21)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_ITSYBITSY)
if (!(pin>=14 && pin<=20)) error(invalidpin, number(pin));
#elif defined(ARDUINO_Seeed_XIAO_nRF52840) || defined(ARDUINO_Seeed_XIAO_nRF52840_Sense)
if (!(pin>=0 && pin<=5)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CLUE)
if (!((pin>=0 && pin<=4) || pin==10 || pin==12 || pin==16)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CIRCUITPLAY)
if (!(pin==0 || (pin>=2 && pin<=3) || pin==6 || (pin>=9 && pin<=10) || (pin>=22 && pin<=23))) error(invalidpin, number(pin));
#elif defined(MAX32620)
if (!(pin>=49 && pin<=52)) error(invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY40)
if (!((pin>=14 && pin<=27))) error(invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY41)
if (!((pin>=14 && pin<=27) || (pin>=38 && pin<=41))) error(invalidpin, number(pin));
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) \
|| defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040) \
|| defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2)
if (!(pin>=26 && pin<=29)) error(invalidpin, number(pin));
#elif defined(ARDUINO_MINIMA) || defined(ARDUINO_UNOWIFIR4)
if (!((pin>=14 && pin<=21))) error(invalidpin, number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(ARDUINO_SAM_DUE)
if (!((pin>=2 && pin<=13) || pin==66 || pin==67)) error(invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_ZERO)
if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || pin==14)) error(invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_MKRZERO)
if (!((pin>=0 && pin<=8) || pin==10 || pin==18 || pin==19)) error(invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M0)
if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || (pin>=15 && pin<=16) || (pin>=22 && pin<=25))) error(invalidpin, number(pin));
#elif defined(ARDUINO_NEOTRINKEY_M0)
error2("not supported");
#elif defined(ARDUINO_GEMMA_M0)
if (!(pin==0 || pin==2 || pin==9 || pin==10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_QTPY_M0)
if (!(pin==0 || (pin>=2 && pin<=10))) error(invalidpin, number(pin));
#elif defined(ARDUINO_SEEED_XIAO_M0)
if (!(pin>=0 && pin<=10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_METRO_M4)
if (!(pin>=0 && pin<=15)) error(invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M4)
if (!(pin==0 || pin==1 || pin==4 || pin==5 || pin==7 || (pin>=9 && pin<=15) || pin==21 || pin==22)) error(invalidpin, number(pin));
#elif defined(ARDUINO_FEATHER_M4)
if (!(pin==0 || pin==1 || (pin>=4 && pin<=6) || (pin>=9 && pin<=13) || pin==14 || pin==15 || pin==17 || pin==21 || pin==22)) error(invalidpin, number(pin));
#elif defined(ARDUINO_PYBADGE_M4)
if (!(pin==4 || pin==7 || pin==9 || (pin>=12 && pin<=13) || (pin>=24 && pin<=25) || (pin>=46 && pin<=47))) error(invalidpin, number(pin));
#elif defined(ARDUINO_PYGAMER_M4)
if (!(pin==4 || pin==7 || pin==9 || (pin>=12 && pin<=13) || (pin>=26 && pin<=27) || (pin>=46 && pin<=47))) error(invalidpin, number(pin));
#elif defined(ARDUINO_WIO_TERMINAL)
if (!((pin>=0 && pin<=2) || pin==6 || pin==8 || (pin>=12 && pin<=20) || pin==24)) error(invalidpin, number(pin));
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
if (!((pin>=2 && pin<=9) || pin==11 || (pin>=13 && pin<=45) || pin==48 || (pin>=50 && pin<=53) || pin==58 || pin==61 || pin==68 || pin==69)) error(invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_BBC_MICROBIT_V2) || defined(ARDUINO_SINOBIT)
if (!(pin>=0 && pin<=32)) error(invalidpin, number(pin));
#elif defined(ARDUINO_CALLIOPE_MINI)
if (!(pin>=0 && pin<=30)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_ITSYBITSY)
if (!(pin>=0 && pin<=25)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CLUE)
if (!(pin>=0 && pin<=46)) error(invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CIRCUITPLAY)
if (!(pin>=0 && pin<=35)) error(invalidpin, number(pin));
#elif defined(MAX32620)
if (!((pin>=20 && pin<=29) || pin==32 || (pin>=40 && pin<=48))) error(invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY40)
if (!((pin>=0 && pin<=15) || (pin>=18 && pin<=19) || (pin>=22 && pin<=25) || (pin>=28 && pin<=29) || (pin>=33 && pin<=39))) error(invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY41)
if (!((pin>=0 && pin<=15) || (pin>=18 && pin<=19) || (pin>=22 && pin<=25) || (pin>=28 && pin<=29) || pin==33 || (pin>=36 && pin<=37))) error(invalidpin, number(pin));
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \
|| defined(ARDUINO_SEEED_XIAO_RP2040) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \
|| defined(ARDUINO_PIMORONI_PICO_PLUS_2)
if (!(pin>=0 && pin<=29)) error(invalidpin, number(pin));
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
if (!((pin>=0 && pin<=29) || pin == 32)) error(invalidpin, number(pin));
#elif defined(ARDUINO_MINIMA) || defined(ARDUINO_UNOWIFIR4)
if (!((pin>=0 && pin<=21))) error(invalidpin, number(pin));
#endif
}"#)
(defparameter *note-arm* #"
// Note
const int scale[] = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
void playnote (int pin, int note, int octave) {
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_NRF52840_CIRCUITPLAY) \
|| defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) \
|| defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_WIO_TERMINAL) \
|| defined(ARDUINO_SEEED_XIAO_RP2040) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \
|| defined(ARDUINO_PIMORONI_PICO_PLUS_2)
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error("octave out of range", number(oct));
tone(pin, scale[note%12]>>prescaler);
#else
(void) pin, (void) note, (void) octave;
#endif
}
void nonote (int pin) {
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_NRF52840_CIRCUITPLAY) \
|| defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \
|| defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \
|| defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \
|| defined(ARDUINO_WIO_TERMINAL) || defined(ARDUINO_SEEED_XIAO_RP2040) \
|| defined(ARDUINO_PIMORONI_PICO_PLUS_2)
noTone(pin);
#else
(void) pin;
#endif
}"#)
(defparameter *sleep-arm* #"
// Sleep
#if defined(CPU_ATSAMD21)
void WDT_Handler(void) {
// ISR for watchdog early warning
WDT->CTRL.bit.ENABLE = 0; // Disable watchdog
while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write
WDT->INTFLAG.bit.EW = 1; // Clear interrupt flag
}
#endif
void initsleep () {
#if defined(CPU_ATSAMD21)
// One-time initialization of watchdog timer.
// Generic clock generator 2, divisor = 32 (2^(DIV+1))
GCLK->GENDIV.reg = GCLK_GENDIV_ID(2) | GCLK_GENDIV_DIV(4);
// Enable clock generator 2 using low-power 32KHz oscillator.
// With /32 divisor above, this yields 1024Hz clock.
GCLK->GENCTRL.reg = GCLK_GENCTRL_ID(2) |
GCLK_GENCTRL_GENEN |
GCLK_GENCTRL_SRC_OSCULP32K |
GCLK_GENCTRL_DIVSEL;
while(GCLK->STATUS.bit.SYNCBUSY);
// WDT clock = clock gen 2
GCLK->CLKCTRL.reg = GCLK_CLKCTRL_ID_WDT |
GCLK_CLKCTRL_CLKEN |
GCLK_CLKCTRL_GEN_GCLK2;
// Enable WDT early-warning interrupt
NVIC_DisableIRQ(WDT_IRQn);
NVIC_ClearPendingIRQ(WDT_IRQn);
NVIC_SetPriority(WDT_IRQn, 0); // Top priority
NVIC_EnableIRQ(WDT_IRQn);
#endif
}
void doze (int secs) {
#if defined(CPU_ATSAMD21)
WDT->CTRL.reg = 0; // Disable watchdog for config
while(WDT->STATUS.bit.SYNCBUSY);
WDT->INTENSET.bit.EW = 1; // Enable early warning interrupt
WDT->CONFIG.bit.PER = 0xB; // Period = max
WDT->CONFIG.bit.WINDOW = 0x7; // Set time of interrupt = 1024 cycles = 1 sec
WDT->CTRL.bit.WEN = 1; // Enable window mode
while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write
SysTick->CTRL = 0; // Stop SysTick interrupts
while (secs > 0) {
WDT->CLEAR.reg = WDT_CLEAR_CLEAR_KEY;// Clear watchdog interval
while(WDT->STATUS.bit.SYNCBUSY);
WDT->CTRL.bit.ENABLE = 1; // Start watchdog now!
while(WDT->STATUS.bit.SYNCBUSY);
SCB->SCR |= SCB_SCR_SLEEPDEEP_Msk; // Deepest sleep
__DSB();
__WFI(); // Wait for interrupt
secs--;
}
SysTick->CTRL = 7; // Restart SysTick interrupts
#else
delay(1000*secs);
#endif
}"#)
(defparameter *keywords-arm*
'((nil
((NIL LED_BUILTIN)
(DIGITALWRITE HIGH LOW)))
("CPU_ATSAMD21"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(ANALOGREFERENCE AR_DEFAULT AR_INTERNAL1V0 AR_INTERNAL1V65 AR_INTERNAL2V23 AR_EXTERNAL)
(REGISTER (PA_DIR "PORT->Group[0].DIR.reg") (PA_DIRCLR "PORT->Group[0].DIRCLR.reg") (PA_DIRSET "PORT->Group[0].DIRSET.reg")
(PA_DIRTGL "PORT->Group[0].DIRTGL.reg") (PA_OUT "PORT->Group[0].OUT.reg") (PA_OUTCLR "PORT->Group[0].OUTCLR.reg")
(PA_OUTSET "PORT->Group[0].OUTSET.reg") (PA_OUTTGL "PORT->Group[0].OUTTGL.reg") (PA_IN "PORT->Group[0].IN.reg")
(PB_DIR "PORT->Group[1].DIR.reg") (PB_DIRCLR "PORT->Group[1].DIRCLR.reg") (PB_DIRSET "PORT->Group[1].DIRSET.reg")
(PB_DIRTGL "PORT->Group[1].DIRTGL.reg") (PB_OUT "PORT->Group[1].OUT.reg") (PB_OUTCLR "PORT->Group[1].OUTCLR.reg")
(PB_OUTSET "PORT->Group[1].OUTSET.reg") (PB_OUTTGL "PORT->Group[1].OUTTGL.reg") (PB_IN "PORT->Group[1].IN.reg"))))
("CPU_ATSAMD51"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(ANALOGREFERENCE AR_DEFAULT AR_INTERNAL1V0 AR_INTERNAL1V1 AR_INTERNAL1V2 AR_INTERNAL1V25 AR_INTERNAL1V65 AR_INTERNAL2V0
AR_INTERNAL2V2 AR_INTERNAL2V23 AR_INTERNAL2V4 AR_INTERNAL2V5 AR_EXTERNAL)
(REGISTER (PA_DIR "PORT->Group[0].DIR.reg") (PA_DIRCLR "PORT->Group[0].DIRCLR.reg") (PA_DIRSET "PORT->Group[0].DIRSET.reg")
(PA_DIRTGL "PORT->Group[0].DIRTGL.reg") (PA_OUT "PORT->Group[0].OUT.reg") (PA_OUTCLR "PORT->Group[0].OUTCLR.reg")
(PA_OUTSET "PORT->Group[0].OUTSET.reg") (PA_OUTTGL "PORT->Group[0].OUTTGL.reg") (PA_IN "PORT->Group[0].IN.reg")
(PB_DIR "PORT->Group[1].DIR.reg") (PB_DIRCLR "PORT->Group[1].DIRCLR.reg") (PB_DIRSET "PORT->Group[1].DIRSET.reg")
(PB_DIRTGL "PORT->Group[1].DIRTGL.reg") (PB_OUT "PORT->Group[1].OUT.reg") (PB_OUTCLR "PORT->Group[1].OUTCLR.reg")
(PB_OUTSET "PORT->Group[1].OUTSET.reg") (PB_OUTTGL "PORT->Group[1].OUTTGL.reg") (PB_IN "PORT->Group[1].IN.reg"))))
("CPU_NRF51822"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(ANALOGREFERENCE AR_DEFAULT AR_VBG AR_SUPPLY_ONE_HALF AR_SUPPLY_ONE_THIRD AR_EXT0 AR_EXT1)
(REGISTER (P0_OUT "NRF_GPIO->OUT") (P0_OUTSET "NRF_GPIO->OUTSET") (P0_OUTCLR "NRF_GPIO->OUTCLR") (P0_IN "NRF_GPIO->IN")
(P0_DIR "NRF_GPIO->DIR") (P0_DIRSET "NRF_GPIO->DIRSET") (P0_DIRCLR "NRF_GPIO->DIRCLR"))))
("CPU_NRF52840"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_INTERNAL_3_0 AR_INTERNAL_2_4 AR_INTERNAL_1_8 AR_INTERNAL_1_2 AR_VDD4)
(REGISTER (P0_OUT "NRF_P0->OUT") (P0_OUTSET "NRF_P0->OUTSET") (P0_OUTCLR "NRF_P0->OUTCLR") (P0_IN "NRF_P0->IN")
(P0_DIR "NRF_P0->DIR") (P0_DIRSET "NRF_P0->DIRSET") (P0_DIRCLR "NRF_P0->DIRCLR")
(P1_OUT "NRF_P1->OUT") (P1_OUTSET "NRF_P1->OUTSET") (P1_OUTCLR "NRF_P1->OUTCLR") (P1_IN "NRF_P1->IN")
(P1_DIR "NRF_P1->DIR") (P1_DIRSET "NRF_P1->DIRSET") (P1_DIRCLR "NRF_P1->DIRCLR"))))
("CPU_NRF52833"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_VDD4)
(REGISTER (P0_OUT "NRF_P0->OUT") (P0_OUTSET "NRF_P0->OUTSET") (P0_OUTCLR "NRF_P0->OUTCLR") (P0_IN "NRF_P0->IN")
(P0_DIR "NRF_P0->DIR") (P0_DIRSET "NRF_P0->DIRSET") (P0_DIRCLR "NRF_P0->DIRCLR")
(P1_OUT "NRF_P1->OUT") (P1_OUTSET "NRF_P1->OUTSET") (P1_OUTCLR "NRF_P1->OUTCLR") (P1_IN "NRF_P1->IN")
(P1_DIR "NRF_P1->DIR") (P1_DIRSET "NRF_P1->DIRSET") (P1_DIRCLR "NRF_P1->DIRCLR"))))
("CPU_iMXRT1062"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT OUTPUT_OPENDRAIN)))
("CPU_MAX32620"
((PINMODE INPUT INPUT_PULLUP OUTPUT)
(ANALOGREFERENCE DEFAULT EXTERNAL)))
("CPU_RP2040"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(REGISTER (GPIO_IN "(SIO_BASE+SIO_GPIO_IN_OFFSET)") (GPIO_OUT "(SIO_BASE+SIO_GPIO_OUT_OFFSET)")
(GPIO_OUT_SET "(SIO_BASE+SIO_GPIO_OUT_SET_OFFSET)") (GPIO_OUT_CLR "(SIO_BASE+SIO_GPIO_OUT_CLR_OFFSET)")
(GPIO_OUT_XOR "(SIO_BASE+SIO_GPIO_OUT_XOR_OFFSET)") (GPIO_OE "(SIO_BASE+SIO_GPIO_OE_OFFSET)")
(GPIO_OE_SET "(SIO_BASE+SIO_GPIO_OE_SET_OFFSET)") (GPIO_OE_CLR "(SIO_BASE+SIO_GPIO_OE_CLR_OFFSET)")
(GPIO_OE_XOR "(SIO_BASE+SIO_GPIO_OE_XOR_OFFSET)"))))
("CPU_RP2350"
((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)
(REGISTER (GPIO_IN "(SIO_BASE+SIO_GPIO_IN_OFFSET)") (GPIO_OUT "(SIO_BASE+SIO_GPIO_OUT_OFFSET)")
(GPIO_OUT_SET "(SIO_BASE+SIO_GPIO_OUT_SET_OFFSET)") (GPIO_OUT_CLR "(SIO_BASE+SIO_GPIO_OUT_CLR_OFFSET)")
(GPIO_OUT_XOR "(SIO_BASE+SIO_GPIO_OUT_XOR_OFFSET)") (GPIO_OE "(SIO_BASE+SIO_GPIO_OE_OFFSET)")
(GPIO_OE_SET "(SIO_BASE+SIO_GPIO_OE_SET_OFFSET)") (GPIO_OE_CLR "(SIO_BASE+SIO_GPIO_OE_CLR_OFFSET)")
(GPIO_OE_XOR "(SIO_BASE+SIO_GPIO_OE_XOR_OFFSET)"))))
("CPU_RA4M1"
((PINMODE INPUT INPUT_PULLUP OUTPUT OUTPUT_OPENDRAIN)
(ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_EXTERNAL)))))

210
builder/assembler.lisp Normal file
View File

@ -0,0 +1,210 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
(defparameter *assembler*
'(
#+avr
#"
// Assembler
#if defined(CPU_ATmega1284P)
#define CODE_ADDRESS 0x1bb00
#elif defined(CPU_AVR128DX48)
#define CODE_ADDRESS 0x1be00
#endif
object *call (int entry, int nargs, object *args, object *env) {
#if defined(CODESIZE)
(void) env;
int param[4];
for (int i=0; i<nargs; i++) {
object *arg = first(args);
if (integerp(arg)) param[i] = arg->integer;
else param[i] = (uintptr_t)arg;
args = cdr(args);
}
uint32_t address = (CODE_ADDRESS + entry)>>1; // Code addresses are word addresses on AVR
int w = ((intfn_ptr_type)address)(param[0], param[1], param[2], param[3]);
return number(w);
#else
return nil;
#endif
}"#
#+arm
#"
// Assembler
object *call (int entry, int nargs, object *args, object *env) {
#if defined(CODESIZE)
(void) env;
int param[4];
for (int i=0; i<nargs; i++) {
object *arg = first(args);
if (integerp(arg)) param[i] = arg->integer;
else param[i] = (uintptr_t)arg;
args = cdr(args);
}
int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]);
return number(w);
#else
return nil;
#endif
}"#
#+riscv
#"
// Assembler
object *call (int entry, int nargs, object *args, object *env) {
#if defined(CODESIZE)
(void) env;
int param[4];
for (int i=0; i<nargs; i++) {
object *arg = first(args);
if (integerp(arg)) param[i] = arg->integer;
else param[i] = (uintptr_t)arg;
args = cdr(args);
}
asm("fence.i");
int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]);
return number(w);
#else
return nil;
#endif
}"#
#+avr
#"
void putcode (object *arg, int origin, int pc) {
#if defined(CODESIZE)
int code = checkinteger(arg);
uint8_t hi = (code>>8) & 0xff;
uint8_t lo = code & 0xff;
MyCode[origin+pc] = lo; // Little-endian
MyCode[origin+pc+1] = hi;
#if defined(assemblerlist)
printhex2(pc>>8, pserial); printhex2(pc, pserial); pserial(' ');
printhex2(lo, pserial); pserial(' '); printhex2(hi, pserial); pserial(' ');
#endif
#endif
}"#
#+(or arm riscv)
#"
void putcode (object *arg, int origin, int pc) {
#if defined(CODESIZE)
int code = checkinteger(arg);
MyCode[origin+pc] = code & 0xff;
MyCode[origin+pc+1] = (code>>8) & 0xff;
#if defined(assemblerlist)
printhex4(pc, pserial);
printhex4(code, pserial);
#endif
#endif
}"#
#+avr
#"
int assemble (int pass, int origin, object *entries, object *env, object *pcpair) {
int pc = 0; cdr(pcpair) = number(pc);
while (entries != NULL) {
object *arg = first(entries);
if (symbolp(arg)) {
if (pass == 2) {
#if defined(assemblerlist)
printhex2(pc>>8, pserial); printhex2(pc, pserial);
indent(7, ' ', pserial);
printobject(arg, pserial); pln(pserial);
#endif
} else {
object *pair = findvalue(arg, env);
cdr(pair) = number(pc);
}
} else {
object *argval = eval(arg, env);
if (listp(argval)) {
object *arglist = argval;
while (arglist != NULL) {
if (pass == 2) {
putcode(first(arglist), origin, pc);
#if defined(assemblerlist)
if (arglist == argval) superprint(arg, 0, pserial);
pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
arglist = cdr(arglist);
}
} else if (integerp(argval)) {
if (pass == 2) {
putcode(argval, origin, pc);
#if defined(assemblerlist)
superprint(arg, 0, pserial); pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
} else error(PSTR("illegal entry"), arg);
}
entries = cdr(entries);
}
// Round up to multiple of 2 to give code size
if (pc%2 != 0) pc = pc + 2 - pc%2;
return pc;
}"#
#+(or arm riscv)
#"
int assemble (int pass, int origin, object *entries, object *env, object *pcpair) {
int pc = 0; cdr(pcpair) = number(pc);
while (entries != NULL) {
object *arg = first(entries);
if (symbolp(arg)) {
if (pass == 2) {
#if defined(assemblerlist)
printhex4(pc, pserial);
indent(5, ' ', pserial);
printobject(arg, pserial); pln(pserial);
#endif
} else {
object *pair = findvalue(arg, env);
cdr(pair) = number(pc);
}
} else {
object *argval = eval(arg, env);
if (listp(argval)) {
object *arglist = argval;
while (arglist != NULL) {
if (pass == 2) {
putcode(first(arglist), origin, pc);
#if defined(assemblerlist)
if (arglist == argval) superprint(arg, 0, pserial);
pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
arglist = cdr(arglist);
}
} else if (integerp(argval)) {
if (pass == 2) {
putcode(argval, origin, pc);
#if defined(assemblerlist)
superprint(arg, 0, pserial); pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
} else error(PSTR("illegal entry"), arg);
}
entries = cdr(entries);
}
// Round up to multiple of 4 to give code size
if (pc%4 != 0) pc = pc + 4 - pc%4;
return pc;
}"#))

288
builder/avr-nano.lisp Normal file
View File

@ -0,0 +1,288 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; AVR
(defparameter *title-avr-nano*
#"/* uLisp AVR-Nano Release ~a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - ~a
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/"#)
(defparameter *header-avr-nano* #"
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
#define checkoverflow
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// Includes
// #include "LispLibrary.h"
#include <avr/sleep.h>
#include <setjmp.h>
#include <SPI.h>
#include <limits.h>
#include <EEPROM.h>
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 172
#else
#define SDSIZE 0
#endif"#)
(defparameter *workspace-avr-nano* #"
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (2)))
#define OBJECTALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 22 /* longest builtin name + 1 */
#if defined(ARDUINO_AVR_UNO)
#define WORKSPACESIZE (320-SDSIZE) /* Objects (4*bytes) */
#define EEPROMSIZE 1024 /* Bytes */
#define STACKDIFF 1
#define CPU_ATmega328P
#elif defined(ARDUINO_AVR_NANO_EVERY)
#define WORKSPACESIZE (1060-SDSIZE) /* Objects (4*bytes) */
#define EEPROMSIZE 256 /* Bytes */
#define STACKDIFF 160
#define CPU_ATmega4809
#elif defined(ARDUINO_AVR_ATmega4809) /* Curiosity Nano using MegaCoreX */
#define Serial Serial3
#define WORKSPACESIZE (1065-SDSIZE) /* Objects (4*bytes) */
#define EEPROMSIZE 256 /* Bytes */
#define STACKDIFF 320
#define CPU_ATmega4809
#elif defined(ARDUINO_AVR_ATtiny3227)
#define WORKSPACESIZE (514-SDSIZE) /* Objects (4*bytes) */
// #define EEPROMSIZE 256 /* Bytes */
#define STACKDIFF 1
#define CPU_ATtiny3227
#elif defined(__AVR_AVR64DD28__)
#include <Flash.h>
#define WORKSPACESIZE (1440-SDSIZE) /* Objects (4*bytes) */
#define FLASHWRITESIZE 6144 /* Bytes */
#define STACKDIFF 1
#define CPU_AVR64DD28
#else
#error "Board not supported!"
#endif"#)
(defparameter *watchdog-avr-nano* #"
// Watchdog
void watchdogenable (int interval) {
int i = 5;
while (interval) { interval = interval>>1; i++; }
wdt_enable(i);
}
void watchdogreset () {
wdt_reset();
}"#)
(defparameter *check-pins-avr-nano* #"
// Check pins - these are board-specific not processor-specific
void checkanalogread (int pin) {
#if defined(ARDUINO_AVR_UNO)
if (!(pin>=0 && pin<=5)) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_NANO_EVERY)
if (!((pin>=14 && pin<=21))) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_ATmega4809) /* MegaCoreX core */
if (!((pin>=22 && pin<=33) || (pin>=36 && pin<=39))) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_ATtiny3227)
if (!((pin>=0 && pin<=3) || (pin>=6 && pin<=7) || (pin>=10 && pin<=11) || pin==18)) error(invalidpin, number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(ARDUINO_AVR_UNO)
if (!(pin==3 || pin==5 || pin==6 || (pin>=9 && pin<=11))) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_NANO_EVERY)
if (!(pin==3 || pin==5 || pin==6 || pin==9 || pin==10)) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_ATmega4809) /* MegaCoreX core */
if (!((pin>=16 && pin<=19) || (pin>=38 && pin<=39))) error(invalidpin, number(pin));
#elif defined(ARDUINO_AVR_ATtiny3227)
if (!((pin>=0 && pin<=1) || (pin>=9 && pin<=11) || pin==20)) error(invalidpin, number(pin));
#endif
}"#)
(defparameter *note-avr-nano* #"
// Note
#if defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
#else
const uint8_t scale[] PROGMEM = {239,226,213,201,190,179,169,160,151,142,134,127};
#endif
void playnote (int pin, int note, int octave) {
#if defined(CPU_ATmega328P)
if (pin == 3) {
DDRD = DDRD | 1<<DDD3; // PD3 (Arduino D3) as output
TCCR2A = 0<<COM2A0 | 1<<COM2B0 | 2<<WGM20; // Toggle OC2B on match
} else if (pin == 11) {
DDRB = DDRB | 1<<DDB3; // PB3 (Arduino D11) as output
TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
} else error(PSTR("only pins 3 and 11 supported"), number(pin));
int oct = octave + note/12;
int prescaler = 9 - oct;
if (prescaler<3 || prescaler>6) error(PSTR("octave out of range"), number(oct));
OCR2A = pgm_read_byte(&scale[note%12]) - 1;
TCCR2B = 0<<WGM22 | prescaler<<CS20;
#elif defined(CPU_ATmega4809) || defined(CPU_ATtiny3227)
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct));
tone(pin, scale[note%12]>>prescaler);
#elif defined(CPU_AVR64DD28)
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct));
tone(pin, pgm_read_word(&scale[note%12])>>prescaler);
#endif
}
void nonote (int pin) {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
noTone(pin);
#else
(void) pin;
TCCR2B = 0<<WGM22 | 0<<CS20;
#endif
}"#)
(defparameter *sleep-avr-nano* #"
// Sleep
#if defined(CPU_ATmega328P)
// Interrupt vector for sleep watchdog
ISR(WDT_vect) {
WDTCSR |= 1<<WDIE;
}
#endif
void initsleep () {
set_sleep_mode(SLEEP_MODE_PWR_DOWN);
}
void sleep () {
#if defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
ADC0.CTRLA = ADC0.CTRLA & ~1; // Turn off ADC
delay(100); // Give serial time to settle
sleep_enable();
sleep_cpu();
ADC0.CTRLA = ADC0.CTRLA | 1; // Turn on ADC
#elif defined(CPU_ATmega328P)
ADCSRA = ADCSRA & ~(1<<ADEN); // Turn off ADC
delay(100); // Give serial time to settle
sleep_enable();
sleep_cpu();
ADCSRA = ADCSRA | 1<<ADEN; // Turn on ADC
#endif
}
void doze (int secs) {
#if defined(CPU_ATmega328P)
// Set up Watchdog timer for 1 Hz interrupt
WDTCSR = 1<<WDCE | 1<<WDE;
WDTCSR = 1<<WDIE | 6<<WDP0; // 1 sec interrupt
while (secs > 0) { sleep(); secs--; }
WDTCSR = 1<<WDCE | 1<<WDE; // Disable watchdog
WDTCSR = 0;
#else
delay(1000*secs);
#endif
}"#)
(defparameter *interrupts-avr-nano* #"
// Interrupts
#if defined(CPU_ATmega328P)
#define NINTERRUPTS 2+1
#elif defined(CPU_ATmega2560)
#define NINTERRUPTS 8+1
#elif defined(CPU_ATmega1284P)
#define NINTERRUPTS 3+1
#endif
unsigned int InterruptCount[NINTERRUPTS];
void handleInterrupts () {
if (tstflag(BUSY)) return;
object *nullenv = NULL;
setflag(BUSY);
int ints, flag;
cli(); flag = tstflag(INTERRUPT); clrflag(INTERRUPT); sei();
if (flag) {
for (int i=0; i<NINTERRUPTS; i++) {
cli(); ints = InterruptCount[i]; InterruptCount[i] = 0; sei();
if (ints) {
object *pair = assoc(number(i),Events);
object *arg = cons(number(ints), NULL);
push(arg, GCStack);
if (pair != NULL) apply(cdr(pair), arg, &nullenv);
pop(GCStack);
}
}
}
clrflag(BUSY);
}
void interrupt (int n) {
setflag(INTERRUPT);
if (InterruptCount[n] < 0xFFFF) InterruptCount[n]++;
}
//ISR(TIMER1_OVF_vect) { interrupt(0); }
ISR(INT0_vect) { interrupt(0); }
ISR(INT1_vect) { interrupt(1); }
#if defined(CPU_ATmega1284P)
ISR(INT2_vect) { interrupt(2); }
#elif defined(CPU_ATmega2560)
ISR(INT2_vect) { interrupt(2); }
ISR(INT3_vect) { interrupt(3); }
ISR(INT4_vect) { interrupt(4); }
ISR(INT5_vect) { interrupt(5); }
ISR(INT6_vect) { interrupt(6); }
ISR(INT7_vect) { interrupt(7); }
#endif"#)
(defparameter *keywords-avr-nano*
'((nil
((NIL LED_BUILTIN)
(DIGITALWRITE HIGH LOW)
(PINMODE INPUT INPUT_PULLUP OUTPUT)))
("CPU_ATmega328P"
((ANALOGREFERENCE DEFAULT INTERNAL EXTERNAL)
(REGISTER PORTB DDRB PINB PORTC DDRC PINC PORTD DDRD PIND)))
("CPU_ATmega4809"
((ANALOGREFERENCE DEFAULT INTERNAL VDD INTERNAL0V55 INTERNAL1V1 INTERNAL1V5 INTERNAL2V5 INTERNAL4V3 EXTERNAL)
(REGISTER PORTA_DIR PORTA_OUT PORTA_IN PORTB_DIR PORTB_OUT PORTB_IN PORTC_DIR PORTC_OUT PORTC_IN
PORTD_DIR PORTD_OUT PORTD_IN PORTE_DIR PORTE_OUT PORTE_IN PORTF_DIR PORTF_OUT PORTF_IN)))
("CPU_ATtiny3227"
((REGISTER FLAG)))
("CPU_AVR64DD28"
((REGISTER FLAG)))))

291
builder/avr.lisp Normal file
View File

@ -0,0 +1,291 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; AVR
(defparameter *title-avr*
#"/* uLisp AVR Release ~a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - ~a
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/"#)
(defparameter *header-avr* #"
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
#define checkoverflow
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// #define extensions
// Includes
// #include "LispLibrary.h"
#include <avr/sleep.h>
#include <setjmp.h>
#include <SPI.h>
#include <limits.h>
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 172
#else
#define SDSIZE 0
#endif"#)
(defparameter *workspace-avr* #"
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (2)))
#define OBJECTALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 22 /* longest builtin name + 1 */
#if defined(ARDUINO_AVR_MEGA2560)
#include <EEPROM.h>
#define WORKSPACESIZE (1344-SDSIZE) /* Objects (4*bytes) */
#define EEPROMSIZE 4096 /* Bytes */
#define STACKDIFF 320
#define CPU_ATmega2560
#elif defined(__AVR_ATmega1284P__)
#include "optiboot.h"
#define WORKSPACESIZE (2944-SDSIZE) /* Objects (4*bytes) */
// #define EEPROMSIZE 4096 /* Bytes */
#define FLASHWRITESIZE 16384 /* Bytes */
#define CODESIZE 96 /* Bytes <= 256 */
#define STACKDIFF 320
#define CPU_ATmega1284P
#elif defined(__AVR_AVR128DA48__)
#include <Flash.h>
#define Serial Serial1
#define WORKSPACESIZE (2920-SDSIZE) /* Objects (4*bytes) */
#define FLASHWRITESIZE 15872 /* Bytes */
#define CODESIZE 96 /* Bytes <= 512 */
#define STACKDIFF 320
#define CPU_AVR128DX48
#define LED_BUILTIN 20
#elif defined(__AVR_AVR128DB48__)
#include <Flash.h>
#define Serial Serial3
#define WORKSPACESIZE (2920-SDSIZE) /* Objects (4*bytes) */
#define FLASHWRITESIZE 15872 /* Bytes */
#define CODESIZE 96 /* Bytes <= 512 */
#define STACKDIFF 320
#define CPU_AVR128DX48
#define LED_BUILTIN 20
#else
#error "Board not supported!"
#endif"#)
(defparameter *watchdog-avr* #"
// Watchdog
void watchdogenable (int interval) {
int i = 5;
while (interval) { interval = interval>>1; i++; }
wdt_enable(i);
}
void watchdogreset () {
wdt_reset();
}"#)
(defparameter *check-pins-avr* #"
// Check pins - these are board-specific not processor-specific
void checkanalogread (int pin) {
#if defined(ARDUINO_AVR_MEGA2560)
if (!(pin>=0 && pin<=15)) error(invalidpin, number(pin));
#elif defined(__AVR_ATmega1284P__)
if (!(pin>=0 && pin<=7)) error(invalidpin, number(pin));
#elif defined(__AVR_AVR128DA48__)
if (!(pin>=22 && pin<=39)) error(invalidpin, number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(ARDUINO_AVR_MEGA2560)
if (!((pin>=2 && pin<=13) || (pin>=44 && pin<=46))) error(invalidpin, number(pin));
#elif defined(__AVR_ATmega1284P__)
if (!(pin==3 || pin==4 || pin==6 || pin==7 || (pin>=12 && pin<=15))) error(invalidpin, number(pin));
#elif defined(__AVR_AVR128DA48__)
if (!((pin>=4 && pin<=5) || (pin>=8 && pin<=19) || (pin>=38 && pin<=39))) error(invalidpin, number(pin));
#endif
}"#)
(defparameter *note-avr* #"
// Note
#if defined(CPU_AVR128DX48)
const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
#else
const uint8_t scale[] PROGMEM = {239,226,213,201,190,179,169,160,151,142,134,127};
#endif
void playnote (int pin, int note, int octave) {
#if defined(CPU_ATmega2560)
if (pin == 9) {
DDRH = DDRH | 1<<DDH6; // PH6 (Arduino D9) as output
TCCR2A = 0<<COM2A0 | 1<<COM2B0 | 2<<WGM20; // Toggle OC2B on match
} else if (pin == 10) {
DDRB = DDRB | 1<<DDB4; // PB4 (Arduino D10) as output
TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
} else error(PSTR("only pins 9 and 10 supported"), number(pin));
int oct = octave + note/12;
int prescaler = 9 - oct;
if (prescaler<3 || prescaler>6) error(PSTR("octave out of range"), number(oct));
OCR2A = pgm_read_byte(&scale[note%12]) - 1;
TCCR2B = 0<<WGM22 | prescaler<<CS20;
#elif defined(CPU_ATmega1284P)
if (pin == 14) {
DDRD = DDRD | 1<<DDD6; // PD6 (Arduino D14) as output
TCCR2A = 0<<COM2A0 | 1<<COM2B0 | 2<<WGM20; // Toggle OC2B on match
} else if (pin == 15) {
DDRD = DDRD | 1<<DDD7; // PD7 (Arduino D15) as output
TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
} else error(PSTR("only pins 14 and 15 supported"), number(pin));
int oct = octave + note/12;
int prescaler = 9 - oct;
if (prescaler<3 || prescaler>6) error(PSTR("octave out of range"), number(oct));
OCR2A = pgm_read_byte(&scale[note%12]) - 1;
TCCR2B = 0<<WGM22 | prescaler<<CS20;
#elif defined(CPU_AVR128DX48)
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct));
tone(pin, pgm_read_word(&scale[note%12])>>prescaler);
#endif
}
void nonote (int pin) {
#if defined(CPU_AVR128DX48)
noTone(pin);
#else
(void) pin;
TCCR2B = 0<<WGM22 | 0<<CS20;
#endif
}"#)
(defparameter *sleep-avr* #"
// Sleep
#if defined(CPU_ATmega2560) || defined(CPU_ATmega1284P)
// Interrupt vector for sleep watchdog
ISR(WDT_vect) {
WDTCSR |= 1<<WDIE;
}
#endif
void initsleep () {
set_sleep_mode(SLEEP_MODE_PWR_DOWN);
}
void sleep () {
#if defined(CPU_ATmega2560) || defined(CPU_ATmega1284P)
ADCSRA = ADCSRA & ~(1<<ADEN); // Turn off ADC
delay(100); // Give serial time to settle
PRR0 = PRR0 | 1<<PRTIM0; // Turn off Timer/Counter0
sleep_enable();
sleep_cpu();
PRR0 = PRR0 & ~(1<<PRTIM0); // Turn on Timer/Counter0
ADCSRA = ADCSRA | 1<<ADEN; // Turn on ADC
#endif
}
void doze (int secs) {
#if defined(CPU_ATmega2560) || defined(CPU_ATmega1284P)
// Set up Watchdog timer for 1 Hz interrupt
WDTCSR = 1<<WDCE | 1<<WDE;
WDTCSR = 1<<WDIE | 6<<WDP0; // 1 sec interrupt
while (secs > 0) { sleep(); secs--; }
WDTCSR = 1<<WDCE | 1<<WDE; // Disable watchdog
WDTCSR = 0;
#else
delay(1000*secs);
#endif
}"#)
(defparameter *interrupts-avr* #"
// Interrupts
#if defined(CPU_ATmega2560)
#define NINTERRUPTS 8+1
#elif defined(CPU_ATmega1284P)
#define NINTERRUPTS 3+1
#endif
unsigned int InterruptCount[NINTERRUPTS];
void handleInterrupts () {
if (tstflag(BUSY)) return;
object *nullenv = NULL;
setflag(BUSY);
int ints, flag;
cli(); flag = tstflag(INTERRUPT); clrflag(INTERRUPT); sei();
if (flag) {
for (int i=0; i<NINTERRUPTS; i++) {
cli(); ints = InterruptCount[i]; InterruptCount[i] = 0; sei();
if (ints) {
object *pair = assoc(number(i),Events);
object *arg = cons(number(ints), NULL);
push(arg, GCStack);
if (pair != NULL) apply(cdr(pair), arg, &nullenv);
pop(GCStack);
}
}
}
clrflag(BUSY);
}
void interrupt (int n) {
setflag(INTERRUPT);
if (InterruptCount[n] < 0xFFFF) InterruptCount[n]++;
}
//ISR(TIMER1_OVF_vect) { interrupt(0); }
ISR(INT0_vect) { interrupt(0); }
ISR(INT1_vect) { interrupt(1); }
#if defined(CPU_ATmega1284P)
ISR(INT2_vect) { interrupt(2); }
#elif defined(CPU_ATmega2560)
ISR(INT2_vect) { interrupt(2); }
ISR(INT3_vect) { interrupt(3); }
ISR(INT4_vect) { interrupt(4); }
ISR(INT5_vect) { interrupt(5); }
ISR(INT6_vect) { interrupt(6); }
ISR(INT7_vect) { interrupt(7); }
#endif"#)
(defparameter *keywords-avr*
'((nil
((NIL LED_BUILTIN)
(DIGITALWRITE HIGH LOW)
(PINMODE INPUT INPUT_PULLUP OUTPUT)))
("CPU_ATmega1284P"
((ANALOGREFERENCE DEFAULT INTERNAL1V1 INTERNAL2V56 EXTERNAL)
(REGISTER PORTA DDRA PINA PORTB DDRB PINB PORTC DDRC PINC PORTD DDRD PIND)))
("CPU_ATmega2560"
((ANALOGREFERENCE DEFAULT INTERNAL1V1 INTERNAL2V56 EXTERNAL)
(REGISTER PORTA DDRA PINA PORTB DDRB PINB PORTC DDRC PINC PORTD DDRD PIND
PORTE DDRE PINE PORTF DDRF PINF PORTG DDRG PING PORTJ DDRJ PINJ)))
("CPU_AVR128DX48"
((ANALOGREFERENCE DEFAULT VDD INTERNAL1V024 INTERNAL2V048 INTERNAL4V096 INTERNAL2V5 EXTERNAL)
(ANALOGREAD ADC_DAC0 ADC_TEMPERATURE)
(REGISTER PORTA_DIR PORTA_OUT PORTA_IN PORTB_DIR PORTB_OUT PORTB_IN PORTC_DIR PORTC_OUT PORTC_IN
PORTD_DIR PORTD_OUT PORTD_IN PORTE_DIR PORTE_OUT PORTE_IN PORTF_DIR PORTF_OUT PORTF_IN)))))

333
builder/build.lisp Normal file
View File

@ -0,0 +1,333 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
;; Generate *********************************************************************************************
; PSTR(), PGM_P, and PROGRAM are unnecessary on ARM.
(defun process-text (stream string platform comments)
(when (or (eq platform :arm) (eq platform :esp) (eq platform :riscv))
(setq string (strip-pstr string))
(setq string (global-replace "PGM_P " "const char *" string))
(setq string (global-replace "PROGMEM " "" string)))
(write-no-comments stream string comments))
(defun write-no-comments (stream string comments)
(cond
(comments
(write-string string stream)
(terpri stream))
(t
(let ((start 0))
(loop
(let* ((com (search "/*" string :start2 start))
(ment (when com (search "*/" string :start2 com))))
(cond
((and com ment (char= (char string (+ com 2)) #\newline)) (write-string string stream :start start :end com) ; 32
(setq start (+ ment 3))) ; Swallow return too
(t (write-string string stream :start start)
(terpri stream)
(return)))))))))
(defun strip-pstr (string)
(let ((start 0) (result ""))
(loop
(let* ((pstr (search "PSTR(\"" string :start2 start))
(term (when pstr (search "\")" string :start2 (+ pstr 6)))))
(cond
((and pstr term)
(setq result (concatenate 'string result (subseq string start pstr) (subseq string (+ pstr 5) (+ term 1))))
(setq start (+ term 2)))
(t
(setq result (concatenate 'string result (subseq string start)))
(return result)))))))
(defun global-replace (target replace string)
(let ((start 0) (result "") (span (length target)))
(loop
(let ((pgmp (search target string :start2 start)))
(cond
(pgmp
(setq result (concatenate 'string result (subseq string start pgmp) replace))
(setq start (+ pgmp span)))
(t
(setq result (concatenate 'string result (subseq string start)))
(return result)))))))
(defun definition-p (string)
(cond
((null string) nil)
((stringp string)
(let* ((com (search "/*" string :start2 0))
(ment (when com (search "*/" string :start2 com))))
(not (and com ment (= com 1) (= ment (- (length string) 2))))))
(t t)))
(defun mappend (fn &rest lsts)
"maps elements in list and finally appends all resulted lists."
(apply #'append (apply #'mapcar fn lsts)))
;; (wildcards (if wildcard (reduce #'+ (map 'list #'(lambda (x) (1- (length x))) (cadar keywords))) 0))
#|
(defun do-keyword-enums (str keywords)
(let* ((wildcard (null (caar keywords)))
(only-wildcard (and wildcard (null (cdr keywords)))))
(dotimes (n (length keywords))
(destructuring-bind (cpu lists) (nth n keywords)
(let ((klist (mappend #'(lambda (x) (map 'list #'(lambda (y) (if (listp y) (car y) y)) (cdr x))) lists)))
(unless (and wildcard (zerop n)) (format str "#~[~:;el~]if defined(~a)~%" (if wildcard (1- n) n) cpu))
(format str "~{~a~%~}" (split-into-lines (format nil "~{K_~a,~^ ~}" klist))))))
(unless only-wildcard (format str "#endif~%"))))
|#
(defun do-keyword-progmems (str keywords i progmem)
(let* ((wildcard (null (caar keywords)))
(only-wildcard (and wildcard (null (cdr keywords))))
(j i))
(dotimes (n (length keywords))
(destructuring-bind (cpu lists) (nth n keywords)
(let ((klist (mappend #'(lambda (x) (cdr x)) lists)))
(when cpu
(setq j i)
(format str "#~[~:;el~]if defined(~a)~%" (if wildcard (1- n) n) cpu))
(dolist (k klist)
(format str "const char string~a[] ~a= \":~a\";~%" j progmem
(substitute #\- #\_ (string-downcase (if (consp k) (car k) k))))
(incf j)))
(unless cpu (setq i j))))
(if only-wildcard nil (format str "#endif~%"))))
(defun needs-&-prefix (a b)
(or
(and (eq a 'register) (listp b) (stringp (second b)) (char/= (char (second b) 0) #\())
(and (eq a 'register) (atom b))))
(defun docstring (definition enum string)
(cond
((null definition) nil)
((stringp definition)
(let* ((com (search "/*" definition :start2 0))
(ment (when com (search "*/" definition :start2 com))))
(when (and com ment) (subseq definition (+ com 3) (- ment 1)))))
((keywordp definition) nil)
((symbolp definition)
(let* ((definition (with-output-to-string (str) (funcall definition str enum string t)))
(com (search "/*" definition :start2 0))
(ment (when com (search "*/" definition :start2 com))))
(when (and com ment) (subseq definition (+ com 3) (- ment 1)))))
(t nil)))
(defun replace-linebreaks (string)
(let ((result "")
(start 0))
(loop
(let ((cr (position #\newline string :start start)))
(when (not cr) (return (concatenate 'string result (string-trim '(#\space) (subseq string start)))))
(setq result
(concatenate 'string result (string-trim '(#\space) (subseq string start cr)) "\\n\"" (string #\newline) "\""))
(setq start (+ 1 cr))))))
(defun do-keyword-table (str keywords i documentation)
(let* ((wildcard (null (caar keywords)))
(only-wildcard (and wildcard (null (cdr keywords))))
(docstring nil)
(j i))
(dotimes (n (length keywords))
(destructuring-bind (cpu lists) (nth n keywords)
(let ((klist (mappend #'(lambda (x) (mapcar #'(lambda (y) (cons (car x) y)) (cdr x))) lists)))
(when cpu
(setq j i)
(format str "#~[~:;el~]if defined(~a)~%" (if wildcard (1- n) n) cpu))
(dolist (k klist)
(destructuring-bind (a . b) k
(if documentation
(format str " { string~a, (fn_ptr_type)~:[~;&~]~a, ~a, ~:[NULL~;doc~a~] },~%"
j (needs-&-prefix a b) (if (listp b) (second b) b) (or a 0) docstring j)
(format str " { string~a, (fn_ptr_type)~:[~;&~]~a, ~a },~%"
j (needs-&-prefix a b) (if (listp b) (second b) b) (or a 0)))
(incf j))))
(unless cpu (setq i j))))
(if only-wildcard nil
(format str "#endif~%"))))
(defparameter *enums* '(NIL TEE NOTHING OPTIONAL FEATURES INITIALELEMENT ELEMENTTYPE TEST COLONA COLONB COLONC BIT AMPREST LAMBDA LET
LETSTAR CLOSURE PSTAR QUOTE CAR FIRST CDR REST NTH EQ CHAR DEFUN DEFVAR DEFCODE AREF STRINGFN FORMAT
PINMODE DIGITALWRITE ANALOGREAD REGISTER ANALOGREFERENCE))
(defun build (&optional (platform :avr) (comments nil) (documentation (find :doc *features*)))
(let* ((maxsymbol 0)
(definitions *definitions*)
(progmem (if (or (eq platform :arm) (eq platform :esp) (eq platform :riscv)) "" "PROGMEM "))
(keywords (eval (intern (format nil "*KEYWORDS-~a*" platform) :cl-user))))
(flet ((include (section str)
(let ((special (intern (format nil "*~a-~a*" section platform) :cl-user))
(default (intern (format nil "*~a*" section) :cl-user)))
(cond
((boundp special)
(let ((inc (eval special)))
(cond
((listp inc) (map nil #'(lambda (x) (process-text str x platform comments)) inc))
(t (process-text str inc platform comments)))))
((boundp default)
(let ((inc (eval default)))
(cond
((listp inc) (map nil #'(lambda (x) (process-text str x platform comments)) inc))
(t (process-text str inc platform comments)))))
(t nil)))))
;;
(with-open-file (str (capi:prompt-for-file "Output File" :operation :save :pathname "/Users/david/Desktop/") :direction :output)
;; Write preamble
; (include :header str)
(format str (eval (intern (format nil "*~a-~a*" :title platform) :cl-user)) *release* *date*)
(terpri str)
(include :header str)
(include :workspace str)
(include :macros str)
(include :constants str)
(include :typedefs str)
;; Collect enums we need to use in the C functions
(let (enumlist)
(dolist (section definitions)
(destructuring-bind (comment defs &optional prefix) section
(declare (ignore comment prefix))
(dolist (item defs)
(destructuring-bind (enum string min max definition) item
(declare (ignore string min max definition))
(when (member enum *enums*) (push enum enumlist))))))
;; Write enum declarations
(let ((enums (split-into-lines (format nil "~{~a, ~}" (reverse enumlist)) 12)))
(format str "~%enum builtins: builtin_t { ~{~a~%~} };~%" enums)))
;;
(include :global-variables str)
(include :error-handling str)
(include :setup-workspace str)
(include :make-objects str)
;; Write utilities
(include :feature-list str)
(include :garbage-collection str)
(include :compactimage str)
(include :make-filename str)
(include :saveimage str)
(include :tracing str)
(include :helper-functions str)
(include :association-lists str)
(include :array-utilities str)
(include :string-utilities str)
(include :closures str)
(include :in-place str)
(include :i2c-interface str)
(include :stream-interface str)
; (include :watchdog str)
(include :check-pins str)
(include :note str)
(include :sleep str)
(include :prettyprint str)
(include :assembler str)
#+interrupts
(include :interrupts str)
;; Write function definitions
(dolist (section definitions)
(destructuring-bind (comment defs &optional prefix) section
(declare (ignore prefix))
(when comment (format str "~%// ~a~%" comment))
(dolist (item defs)
(destructuring-bind (enum string min max definition) item
(declare (ignore min max))
(cond
((null (definition-p definition)) nil)
((stringp definition)
(process-text str definition platform comments))
((keywordp definition) nil)
((symbolp definition)
(funcall definition str enum string comments)
(format str "~%"))
(t nil))))))
;; Write symbol names
(format str "~%// Built-in symbol names~%")
(let ((i 0))
(dotimes (pass 2)
(dolist (section definitions)
(destructuring-bind (comment defs &optional prefix) section
(declare (ignore comment prefix))
(dolist (item defs)
(destructuring-bind (enum string min max definition) item
(declare (ignore definition min max))
(when (eq (plusp pass) (not (member enum *enums*)))
(let ((lower (string-downcase enum)))
(format str "const char string~a[] ~a= \"~a\";~%" i progmem (or string lower))
(setq maxsymbol (max maxsymbol (length (or string lower))))
(incf i))))))))
;; Do keywords
(do-keyword-progmems str keywords i progmem))
;; Write documentation strings
(when documentation
(format str "~%// Documentation strings~%")
(let ((i 0))
(dotimes (pass 2)
(dolist (section definitions)
(destructuring-bind (comment defs &optional prefix) section
(declare (ignore comment prefix))
(dolist (item defs)
(destructuring-bind (enum string min max definition) item
(declare (ignore min max))
(when (eq (plusp pass) (not (member enum *enums*)))
(let ((docstring (docstring definition enum string)))
(when docstring
(format str "const char doc~a[] ~a= \"~a\";~%" i progmem (replace-linebreaks docstring)))
(incf i))))))))))
;; Write table
(format str "~%// Built-in symbol lookup table~%")
(flet ((minmax (prefix min max)
(let ((pre (cond
((string= prefix "fn") 2)
((string= prefix "sp") 3)
((string= prefix "tf") 1)
(t 0))))
(+ (ash pre 6) (ash min 3) (min max 7)))))
(let ((i 0))
(format str "const tbl_entry_t lookup_table[] ~a= {~%" progmem)
(dotimes (pass 2)
(dolist (section definitions)
(destructuring-bind (comment defs &optional (prefix "fn")) section
(declare (ignore comment))
(dolist (item defs)
(destructuring-bind (enum string min max definition) item
(when (eq (plusp pass) (not (member enum *enums*)))
(let ((docstring (docstring definition enum string))
(lower (cond
((consp definition) (string-downcase (car definition)))
((keywordp definition) definition)
(t (string-downcase enum)))))
(if documentation
(format str " { string~a, ~:[NULL~2*~;~a_~a~], 0~3,'0o, ~:[NULL~;doc~a~] },~%"
i (definition-p definition) prefix lower (minmax prefix min max) docstring i)
(format str " { string~a, ~:[NULL~2*~;~a_~a~], 0~3,'0o },~%"
i (definition-p definition) prefix lower (minmax prefix min max)))
(incf i))))))))
; Do keywords
(do-keyword-table str keywords i documentation)
(format str "};~%")))
;; Write rest
(include :table str)
(include :eval str)
(include :print-functions str)
(include :read-functions str)
(when (eq platform :badge) (write-string *lisp-badge* str))
(include :setup1 str)
(format str (eval (intern (format nil "*~a*" :setup2) :cl-user)) *release*)
(terpri str)
(include :repl str)
(include :loop str)
maxsymbol))))

1
builder/builder defsys.lisp Executable file
View File

@ -0,0 +1 @@
;;;-*- Mode: Lisp; Package: CL-USER -*- (setf (logical-pathname-translations "builder") `(("**;*.*.*" ,(merge-pathnames "**/*.*" (truename (pathname-location (current-pathname))))))) ; Packages ***** (defpackage builder (:use :common-lisp)) (defsystem builder (:object-pathname (current-pathname "fasls/") :package builder) :members ("extras" "functions" "preface" "utilities" "streams" "saveload" "prettyprint" "assembler" "postscript" "avr" "avr-nano" "arm" "esp" "riscv" "build") :rules ((:in-order-to :compile :all (:requires (:load :previous)))))

307
builder/esp.lisp Normal file
View File

@ -0,0 +1,307 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; ESP
(defparameter *title-esp*
#"/* uLisp ESP Release ~a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - ~a
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/"#)
(defparameter *header-esp* #"
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define gfxsupport
// #define lisplibrary
// #define lineeditor
// #define vt100
// #define extensions
// Includes
// #include "LispLibrary.h"
#include <setjmp.h>
#include <SPI.h>
#include <Wire.h>
#include <limits.h>
#include <WiFi.h>
#if defined(gfxsupport)
#define COLOR_WHITE ST77XX_WHITE
#define COLOR_BLACK ST77XX_BLACK
#include <Adafruit_GFX.h> // Core graphics library
#include <Adafruit_ST7789.h> // Hardware-specific library for ST7789
#if defined(ARDUINO_ESP32_DEV)
Adafruit_ST7789 tft = Adafruit_ST7789(5, 16, 19, 18);
#define TFT_BACKLITE 4
#else
Adafruit_ST7789 tft = Adafruit_ST7789(TFT_CS, TFT_DC, MOSI, SCK, TFT_RST);
#endif
#endif
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 172
#else
#define SDSIZE 0
#endif"#)
(defparameter *workspace-esp* #"
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 36 // Number of bits+4
// ESP32 boards ***************************************************************
#if defined(ARDUINO_ESP32_DEV) /* For TTGO T-Display etc. */
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 260000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */
#endif
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX6
#elif defined(ARDUINO_FEATHER_ESP32)
#define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define CPU_LX6
#elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 250000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define CPU_LX6
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO) || defined(ARDUINO_ESP32_PICO)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 250000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX6
// ESP32-S2 boards ***************************************************************
#elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 250000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (6500-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define CPU_LX7
#elif defined(ARDUINO_FEATHERS2) /* UM FeatherS2 */
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 1000000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (8160-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX7
#elif defined(ARDUINO_ESP32S2_DEV)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 260000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (8160-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX7
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 260000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (7232-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX7
// ESP32-S3 boards ***************************************************************
#elif defined(ARDUINO_ESP32S3_DEV)
#define WORKSPACESIZE (25000-SDSIZE) /* Objects (8*bytes) */
#define MAX_STACK 6500
#define LITTLEFS
#include <LittleFS.h>
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX7
#elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S3_TFT)
#if defined(BOARD_HAS_PSRAM)
#define WORKSPACESIZE 250000 /* Objects (8*bytes) */
#else
#define WORKSPACESIZE (22000-SDSIZE) /* Objects (8*bytes) */
#endif
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX7
// ESP32-C3 boards ***************************************************************
#elif defined(ARDUINO_ESP32C3_DEV)
#define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */
#define MAX_STACK 7500
#define LITTLEFS
#include <LittleFS.h>
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_RISC_V
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3)
#define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */
#define MAX_STACK 8000
#define LITTLEFS
#include <LittleFS.h>
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_RISC_V
// Legacy boards ***************************************************************
#elif defined(ESP32) /* Generic ESP32 board */
#define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */
#define MAX_STACK 7000
#define LITTLEFS
#include <LittleFS.h>
#define analogWrite(x,y) dacWrite((x),(y))
#define SDCARD_SS_PIN 13
#define LED_BUILTIN 13
#define CPU_LX6
#else
#error "Board not supported!"
#endif"#)
(defparameter *check-pins-esp* #"
// Check pins
void checkanalogread (int pin) {
#if defined(ESP32) || defined(ARDUINO_ESP32_DEV)
if (!(pin==0 || pin==2 || pin==4 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=36) || pin==39))
error("invalid pin", number(pin));
#elif defined(ARDUINO_FEATHER_ESP32) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2)
if (!(pin==4 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=36) || pin==39)) error("invalid pin", number(pin));
#elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT)
if (!(pin==8 || (pin>=14 && pin<=18))) error("invalid pin", number(pin));
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO)
if (!(pin==4 || pin==7 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=33))) error("invalid pin", number(pin));
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2)
if (!((pin>=5 && pin<=9) || (pin>=16 && pin<=18))) error("invalid pin", number(pin));
#elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3)
if (!((pin>=0 && pin<=1) || (pin>=3 && pin<=5))) error("invalid pin", number(pin));
#elif defined(ARDUINO_FEATHERS2) || defined(ARDUINO_ESP32S2_DEV)
if (!((pin>=1 && pin<=20))) error("invalid pin", number(pin));
#elif defined(ARDUINO_ESP32C3_DEV)
if (!((pin>=0 && pin<=5))) error("invalid pin", number(pin));
#elif defined(ARDUINO_ESP32S3_DEV)
if (!((pin>=1 && pin<=20))) error("invalid pin", number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(ESP32) || defined(ARDUINO_FEATHER_ESP32) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2) || defined(ARDUINO_ESP32_DEV) \
|| defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO)
if (!(pin>=25 && pin<=26)) error("invalid pin", number(pin));
#elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT) || defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2) \
|| defined(ARDUINO_FEATHERS2) || defined(ARDUINO_ESP32S2_DEV)
if (!(pin>=17 && pin<=18)) error("invalid pin", number(pin));
#elif defined(ARDUINO_ESP32C3_DEV) || defined(ARDUINO_ESP32S3_DEV) || defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3)
error2(ANALOGWRITE, "not supported");
#endif
}"#)
(defparameter *note-esp* #"
// Note
void tone (int pin, int note) {
(void) pin, (void) note;
}
void noTone (int pin) {
(void) pin;
}
const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
void playnote (int pin, int note, int octave) {
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct));
tone(pin, scale[note%12]>>prescaler);
}
void nonote (int pin) {
noTone(pin);
}"#)
(defparameter *sleep-esp* #"
// Sleep
void initsleep () { }
void doze (int secs) {
delay(1000 * secs);
}"#)
(defparameter *keywords-esp*
'((nil
((NIL LED_BUILTIN)
(DIGITALWRITE HIGH LOW)
(PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)))))

125
builder/extras.lisp Normal file
View File

@ -0,0 +1,125 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; To run do (build)
; Sharp-double-quote
(defun sharp-double-quote-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let (chars)
(do ((prev (read-char stream) curr)
(curr (read-char stream) (read-char stream)))
((and (char= prev #\") (char= curr #\#)))
(push prev chars))
(coerce (nreverse chars) 'string)))
(set-dispatch-macro-character
#\# #\" #'sharp-double-quote-reader)
; Code generation functions
(defun float-function (str enum string comments)
(declare (ignore string))
(format str "
~:[~2*~;/*
(~a number)
Returns ~a(number).
*/
~]object *fn_~a (object *args, object *env) {
(void) env;
return makefloat(~a(checkintfloat(first(args))));
}"
comments
(string-downcase enum)
(string-downcase enum)
(string-downcase enum)
(string-downcase enum)))
(defun truncate-function (str enum string comments)
(declare (ignore string))
(format str "
~:[~2*~;/*
(~a number [divisor])
Returns ~a(number/divisor). If omitted, divisor is 1.
*/
~]object *fn_~a (object *args, object *env) {
(void) env;
object *arg = first(args);
args = cdr(args);
if (args != NULL) return number(~a(checkintfloat(arg) / checkintfloat(first(args))));
else return number(~a(checkintfloat(arg)));
}"
comments
(string-downcase enum)
(cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))
(string-downcase enum)
(cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))
(cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round"))))))
#|
(defun numeric1 (str enum string comments)
(declare (ignore string))
(format str "
object *fn_~a (object *args, object *env) {
(void) env;
int arg = checkinteger(~a, first(args));
return number(~a(arg));
}" (string-downcase enum) enum (string-downcase enum)))
|#
(defun bitwise (str enum string comments)
(declare (ignore string))
(format str "
~:[~2*~;/*
(~a [value*])
Returns the bitwise ~a of the values.
*/
~]object *fn_~a (object *args, object *env) {
(void) env;
int result = ~a;
while (args != NULL) {
result = result ~a checkinteger(first(args));
args = cdr(args);
}
return number(result);
}"
comments
(string-downcase enum)
(cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^"))))
(string-downcase enum)
(cdr (assoc enum '((LOGAND . "-1") (LOGIOR . "0") (LOGXOR . "0"))))
(cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^"))))))
#|
; For max or min
(defun numeric2 (str enum string comments)
(declare (ignore string))
(format str "
object *fn_~a (object *args, object *env) {
(void) env;
int result = integer(first(args));
args = cdr(args);
while (args != NULL) {
result = ~a(result,integer(car(args)));
args = cdr(args);
}
return number(result);
}" (string-downcase enum) (string-downcase enum)))
|#
(defun split-into-lines (string &optional (indent 0))
(let* ((linelen 106)
(start 0)
(end (- linelen indent))
(length (length string))
result)
(loop
(when (>= end length)
(push (subseq string start) result)
(return (reverse result)))
(let ((comma (position #\, string :start start :end end :from-end t)))
(push (subseq string start (1+ comma)) result)
(setq start (+ comma 2) end (+ comma 2 linelen))))))

6200
builder/functions.lisp Normal file
View File

File diff suppressed because it is too large Load Diff

2507
builder/postscript.lisp Normal file
View File

File diff suppressed because it is too large Load Diff

677
builder/preface.lisp Normal file
View File

@ -0,0 +1,677 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
(defparameter *macros* '(
#+avr-nano
#"
// C Macros
#define nil NULL
#define car(x) (((object *) (x))->car)
#define cdr(x) (((object *) (x))->cdr)
#define first(x) car(x)
#define rest(x) cdr(x)
#define second(x) first(rest(x))
#define cddr(x) cdr(cdr(x))
#define third(x) first(cddr(x))
#define push(x, y) ((y) = cons((x),(y)))
#define pop(y) ((y) = cdr(y))
#define protect(y) push((y), GCStack)
#define unprotect() pop(GCStack)
#define integerp(x) ((x) != NULL && (x)->type == NUMBER)
#define symbolp(x) ((x) != NULL && (x)->type == SYMBOL)
#define stringp(x) ((x) != NULL && (x)->type == STRING)
#define characterp(x) ((x) != NULL && (x)->type == CHARACTER)
#define streamp(x) ((x) != NULL && (x)->type == STREAM)
#define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT))
#define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT))
#define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0)
#define MARKBIT 1
#define setflag(x) (Flags = Flags | 1<<(x))
#define clrflag(x) (Flags = Flags & ~(1<<(x)))
#define tstflag(x) (Flags & 1<<(x))
#define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t')
#define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'')
#define fntype(x) (getminmax((uint16_t)(x))>>6)
#define longsymbolp(x) (((x)->name & 0x03) == 0)
#define longnamep(x) (((x) & 0x03) == 0)
#define twist(x) ((uint16_t)((x)<<2) | (((x) & 0xC000)>>14))
#define untwist(x) (((x)>>2 & 0x3FFF) | ((x) & 0x03)<<14)
#define arraysize(x) (sizeof(x) / sizeof(x[0]))
#define stringifyX(x) #x
#define stringify(x) stringifyX(x)
#define PACKEDS 17600
#define BUILTINS 64000
#define ENDFUNCTIONS 1536
#define SDCARD_SS_PIN 10
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227)
#define PROGMEM
#define PSTR(s) (s)
#endif"#
#+avr
#"
// C Macros
#define nil NULL
#define car(x) (((object *) (x))->car)
#define cdr(x) (((object *) (x))->cdr)
#define first(x) car(x)
#define rest(x) cdr(x)
#define second(x) first(rest(x))
#define cddr(x) cdr(cdr(x))
#define third(x) first(cddr(x))
#define push(x, y) ((y) = cons((x),(y)))
#define pop(y) ((y) = cdr(y))
#define protect(y) push((y), GCStack)
#define unprotect() pop(GCStack)
#define integerp(x) ((x) != NULL && (x)->type == NUMBER)
#define symbolp(x) ((x) != NULL && (x)->type == SYMBOL)
#define stringp(x) ((x) != NULL && (x)->type == STRING)
#define characterp(x) ((x) != NULL && (x)->type == CHARACTER)
#define arrayp(x) ((x) != NULL && (x)->type == ARRAY)
#define streamp(x) ((x) != NULL && (x)->type == STREAM)
#define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT))
#define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT))
#define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0)
#define MARKBIT 1
#define setflag(x) (Flags = Flags | 1<<(x))
#define clrflag(x) (Flags = Flags & ~(1<<(x)))
#define tstflag(x) (Flags & 1<<(x))
#define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t')
#define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'')
#define fntype(x) (getminmax((uint16_t)(x))>>6)
#define longsymbolp(x) (((x)->name & 0x03) == 0)
#define longnamep(x) (((x) & 0x03) == 0)
#define twist(x) ((uint16_t)((x)<<2) | (((x) & 0xC000)>>14))
#define untwist(x) (((x)>>2 & 0x3FFF) | ((x) & 0x03)<<14)
#define arraysize(x) (sizeof(x) / sizeof(x[0]))
#define stringifyX(x) #x
#define stringify(x) stringifyX(x)
#define PACKEDS 17600
#define BUILTINS 64000
#define ENDFUNCTIONS 1536
// Code marker stores start and end of code block (max 256 bytes)
#define startblock(x) ((x->integer) & 0xFF)
#define endblock(x) ((x->integer) >> 8 & 0xFF)
#define SDCARD_SS_PIN 10"#
#+(or arm riscv esp)
#"
// C Macros
#define nil NULL
#define car(x) (((object *) (x))->car)
#define cdr(x) (((object *) (x))->cdr)
#define first(x) car(x)
#define rest(x) cdr(x)
#define second(x) first(rest(x))
#define cddr(x) cdr(cdr(x))
#define third(x) first(cddr(x))
#define push(x, y) ((y) = cons((x),(y)))
#define pop(y) ((y) = cdr(y))
#define protect(y) push((y), GCStack)
#define unprotect() pop(GCStack)
#define integerp(x) ((x) != NULL && (x)->type == NUMBER)
#define floatp(x) ((x) != NULL && (x)->type == FLOAT)
#define symbolp(x) ((x) != NULL && (x)->type == SYMBOL)
#define stringp(x) ((x) != NULL && (x)->type == STRING)
#define characterp(x) ((x) != NULL && (x)->type == CHARACTER)
#define arrayp(x) ((x) != NULL && (x)->type == ARRAY)
#define streamp(x) ((x) != NULL && (x)->type == STREAM)
#define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT))
#define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT))
#define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0)
#define MARKBIT 1
#define setflag(x) (Flags = Flags | 1<<(x))
#define clrflag(x) (Flags = Flags & ~(1<<(x)))
#define tstflag(x) (Flags & 1<<(x))
#define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t')
#define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'')
#define fntype(x) (getminmax((uint16_t)(x))>>6)
#define longsymbolp(x) (((x)->name & 0x03) == 0)
#define longnamep(x) (((x) & 0x03) == 0)
#define twist(x) ((uint32_t)((x)<<2) | (((x) & 0xC0000000)>>30))
#define untwist(x) (((x)>>2 & 0x3FFFFFFF) | ((x) & 0x03)<<30)
#define arraysize(x) (sizeof(x) / sizeof(x[0]))
#define stringifyX(x) #x
#define stringify(x) stringifyX(x)
#define PACKEDS 0x43238000
#define BUILTINS 0xF4240000
#define ENDFUNCTIONS 0x0BDC0000"#
#+(or arm riscv)
#"
// Code marker stores start and end of code block
#define startblock(x) ((x->integer) & 0xFFFF)
#define endblock(x) ((x->integer) >> 16 & 0xFFFF)"#))
(defparameter *constants*
'(
#+avr-nano
#"
// Constants
const int TRACEMAX = 3; // Number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, STRING=12, PAIR=14 }; // STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char stringstream[] PROGMEM = "string";
PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream};"#
#+avr
#"
// Constants
#define TRACEMAX 3 // Maximum number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, ARRAY=12, STRING=14, PAIR=16 }; // ARRAY STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char stringstream[] PROGMEM = "string";
PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream};"#
#+arm
#"
// Constants
#define TRACEMAX 3 // Maximum number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, FLOAT=12, ARRAY=14, STRING=16, PAIR=18 }; // ARRAY STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, WIFISTREAM, STRINGSTREAM, GFXSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char wifistream[] PROGMEM = "wifi";
const char stringstream[] PROGMEM = "string";
const char gfxstream[] PROGMEM = "gfx";
const char *const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, wifistream, stringstream, gfxstream};"#
#+esp
#"
// Constants
#define TRACEMAX 3 // Maximum number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, FLOAT=12, ARRAY=14, STRING=16, PAIR=18 }; // ARRAY STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, WIFISTREAM, STRINGSTREAM, GFXSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char wifistream[] PROGMEM = "wifi";
const char stringstream[] PROGMEM = "string";
const char gfxstream[] PROGMEM = "gfx";
PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, wifistream, stringstream, gfxstream};"#
#+riscv
#"
// Constants
#define TRACEMAX 3 // Maximum number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, FLOAT=12, ARRAY=14, STRING=16, PAIR=18 }; // STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM, GFXSTREAM };
enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char stringstream[] PROGMEM = "string";
const char gfxstream[] PROGMEM = "gfx";
const char *const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream, gfxstream};"#))
#+avr-nano
(defparameter *typedefs* #"
// Typedefs
typedef uint16_t symbol_t;
typedef uint16_t builtin_t;
typedef uint16_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);"#)
#+avr
(defparameter *typedefs* #"
// Typedefs
typedef uint16_t symbol_t;
typedef uint16_t builtin_t;
typedef uint16_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);"#)
#+msp430
(defparameter *typedefs* #"
// Typedefs
typedef unsigned int symbol_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
int chars; // For strings
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef const struct {
PGM_P string;
fn_ptr_type fptr;
uint8_t funtype: 2;
uint8_t minargs: 3;
uint8_t maxargs: 3;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);
typedef uint16_t builtin_t;"#)
#+arm
(defparameter *typedefs* #"
// Typedefs
typedef uint32_t symbol_t;
typedef uint32_t builtin_t;
typedef uint32_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
float single_float;
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);"#)
#+riscv
(defparameter *typedefs* #"
// Typedefs
typedef uint32_t symbol_t;
typedef uint32_t builtin_t;
typedef uint32_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
uintptr_t type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
float single_float;
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);
typedef int PinMode;"#)
#+esp
(defparameter *typedefs* #"
// Typedefs
typedef uint32_t symbol_t;
typedef uint32_t builtin_t;
typedef uint32_t chars_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
chars_t chars; // For strings
float single_float;
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef const struct {
PGM_P string;
fn_ptr_type fptr;
uint8_t minmax;
const char *doc;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);"#)
(defparameter *global-variables*
'(
#+avr-nano
#"
// Global variables
uint8_t FLAG __attribute__ ((section (".noinit")));
object Workspace[WORKSPACESIZE] OBJECTALIGNED;"#
#+avr
#"
// Global variables
uint8_t FLAG __attribute__ ((section (".noinit")));
object Workspace[WORKSPACESIZE] OBJECTALIGNED;
#if defined(CODESIZE)
uint8_t MyCode[CODESIZE] WORDALIGNED; // Must be even
#endif"#
#+arm
#"
// Global variables
object Workspace[WORKSPACESIZE] WORDALIGNED MEMBANK;
#if defined(CODESIZE)
RAMFUNC uint8_t MyCode[CODESIZE] WORDALIGNED;
#endif"#
#+esp
#"
// Global variables
#if defined(BOARD_HAS_PSRAM)
object *Workspace WORDALIGNED;
#else
object Workspace[WORKSPACESIZE] WORDALIGNED;
#endif"#
#+riscv
#"
// Global variables
#if (WORKSPACESIZE > 80000)
object *Workspace WORDALIGNED;
#else
object Workspace[WORKSPACESIZE] WORDALIGNED;
#endif
uint8_t MyCode[CODESIZE] WORDALIGNED;"#
#+avr-nano
#"
jmp_buf exception;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2Ccount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
builtin_t Context;
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;
uint16_t RandomSeed;"#
#+avr
#"
jmp_buf toplevel_handler;
jmp_buf *handler = &toplevel_handler;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2Ccount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
builtin_t Context;
#define BACKTRACESIZE 8
uint8_t TraceStart = 0, TraceTop = 0;
symbol_t Backtrace[BACKTRACESIZE];
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;
uint16_t RandomSeed;"#
#+(or arm riscv)
#"
jmp_buf toplevel_handler;
jmp_buf *handler = &toplevel_handler;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2Ccount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
builtin_t Context;
#define BACKTRACESIZE 8
uint8_t TraceStart = 0, TraceTop = 0;
symbol_t Backtrace[BACKTRACESIZE];
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;"#
#+esp
#"
jmp_buf toplevel_handler;
jmp_buf *handler = &toplevel_handler;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2Ccount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
builtin_t Context;
#define BACKTRACESIZE 8
uint8_t TraceStart = 0, TraceTop = 0;
symbol_t Backtrace[BACKTRACESIZE];
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;
void* StackBottom;"#
#-errors
#"
// Flags
enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED, NOESC, NOECHO, BACKTRACE };
typedef uint8_t flags_t;
volatile flags_t Flags = 1<<PRINTREADABLY; // Set by default"#
#+errors
#"
// Flags
enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED, NOESC, NOECHO, MUFFLEERRORS, BACKTRACE };
typedef uint16_t flags_t;
volatile flags_t Flags = 1<<PRINTREADABLY; // Set by default"#
#"
// Forward references
object *tee;
void pfstring (PGM_P s, pfun_t pfun);"#))

182
builder/prettyprint.lisp Normal file
View File

@ -0,0 +1,182 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
;; Prettyprinter and tree editor
(defparameter *prettyprint*
'(
#"
// Prettyprint"#
#-(or badge gfx)
#"
const int PPINDENT = 2;
const int PPWIDTH = 80;"#
#+badge
#"
const int PPINDENT = 2;
const int PPWIDTH = 42;"#
#+gfx
#"
const int PPINDENT = 2;
const int PPWIDTH = 80;
const int GFXPPWIDTH = 52; // 320 pixel wide screen
int ppwidth = PPWIDTH;"#
#"
void pcount (char c) {
if (c == '\n') PrintCount++;
PrintCount++;
}
/*
atomwidth - calculates the character width of an atom
*/
uint8_t atomwidth (object *obj) {
PrintCount = 0;
printobject(obj, pcount);
return PrintCount;
}
/*
basewidth - calculates the character width of an integer printed in a given base
*/
uint8_t basewidth (object *obj, uint8_t base) {
PrintCount = 0;
pintbase(obj->integer, base, pcount);
return PrintCount;
}
/*
quoted - tests whether an object is quoted
*/
bool quoted (object *obj) {
return (consp(obj) && car(obj) != NULL && car(obj)->name == sym(QUOTE) && consp(cdr(obj)) && cddr(obj) == NULL);
}
/*
subwidth - returns the space left from w after printing object
*/
int subwidth (object *obj, int w) {
if (atom(obj)) return w - atomwidth(obj);
if (quoted(obj)) obj = car(cdr(obj));
return subwidthlist(obj, w - 1);
}
/*
subwidth - returns the space left from w after printing a list
*/
int subwidthlist (object *form, int w) {
while (form != NULL && w >= 0) {
if (atom(form)) return w - (2 + atomwidth(form));
w = subwidth(car(form), w - 1);
form = cdr(form);
}
return w;
}"#
#-gfx
#"
/*
superprint - handles pretty-printing
*/
void superprint (object *form, int lm, pfun_t pfun) {
if (atom(form)) {
if (isbuiltin(form, NOTHING)) printsymbol(form, pfun);
else printobject(form, pfun);
} else if (quoted(form)) {
pfun('\'');
superprint(car(cdr(form)), lm + 1, pfun);
} else {
lm = lm + PPINDENT;
bool fits = (subwidth(form, PPWIDTH - lm - PPINDENT) >= 0);
int special = 0, extra = 0; bool separate = true;
object *arg = car(form);
if (symbolp(arg) && builtinp(arg->name)) {
uint8_t minmax = getminmax(builtin(arg->name));
if (minmax == 0327 || minmax == 0313) special = 2; // defun, setq, setf, defvar
else if (minmax == 0317 || minmax == 0017 || minmax == 0117 || minmax == 0123) special = 1;
}
while (form != NULL) {
if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; }
else if (separate) {
pfun('(');
separate = false;
} else if (special) {
pfun(' ');
special--;
} else if (fits) {
pfun(' ');
} else { pln(pfun); indent(lm, ' ', pfun); }
superprint(car(form), lm+extra, pfun);
form = cdr(form);
}
pfun(')');
}
}"#
#+gfx
#"
/*
superprint - handles pretty-printing
*/
void superprint (object *form, int lm, pfun_t pfun) {
if (atom(form)) {
if (isbuiltin(form, NOTHING)) printsymbol(form, pfun);
else printobject(form, pfun);
} else if (quoted(form)) {
pfun('\'');
superprint(car(cdr(form)), lm + 1, pfun);
} else {
lm = lm + PPINDENT;
bool fits = (subwidth(form, ppwidth - lm - PPINDENT) >= 0);
int special = 0, extra = 0; bool separate = true;
object *arg = car(form);
if (symbolp(arg) && builtinp(arg->name)) {
uint8_t minmax = getminmax(builtin(arg->name));
if (minmax == 0327 || minmax == 0313) special = 2; // defun, setq, setf, defvar
else if (minmax == 0317 || minmax == 0017 || minmax == 0117 || minmax == 0123) special = 1;
}
while (form != NULL) {
if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; }
else if (separate) {
pfun('(');
separate = false;
} else if (special) {
pfun(' ');
special--;
} else if (fits) {
pfun(' ');
} else { pln(pfun); indent(lm, ' ', pfun); }
superprint(car(form), lm+extra, pfun);
form = cdr(form);
}
pfun(')');
}
}"#
#"
/*
edit - the Lisp tree editor
Steps through a function definition, editing it a bit at a time, using single-key editing commands.
*/
object *edit (object *fun) {
while (1) {
if (tstflag(EXITEDITOR)) return fun;
char c = gserial();
if (c == 'q') setflag(EXITEDITOR);
else if (c == 'b') return fun;
else if (c == 'r') fun = read(gserial);
else if (c == '\n') { pfl(pserial); superprint(fun, 0, pserial); pln(pserial); }
else if (c == 'c') fun = cons(read(gserial), fun);
else if (atom(fun)) pserial('!');
else if (c == 'd') fun = cons(car(fun), edit(cdr(fun)));
else if (c == 'a') fun = cons(edit(car(fun)), cdr(fun));
else if (c == 'x') fun = cdr(fun);
else pserial('?');
}
}"#))

133
builder/riscv.lisp Normal file
View File

@ -0,0 +1,133 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
; RISC-V
(defparameter *title-riscv*
#"/* uLisp RISC-V Release ~a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - ~a
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/"#)
(defparameter *header-riscv* #"
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
// #define gfxsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// #define extensions
// Includes
// #include "LispLibrary.h"
#include <setjmp.h>
#include <SPI.h>
#include <Wire.h>
#include <limits.h>
#if defined(gfxsupport)
#include <Sipeed_ST7789.h>
SPIClass spi_(SPI0); // MUST be SPI0 for Maix series on board LCD
Sipeed_ST7789 tft(320, 240, spi_);
#endif
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 172
#else
#define SDSIZE 0
#endif"#)
(defparameter *workspace-riscv* #"
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (8)))
#define BUFFERSIZE 36 // Number of bits+4
#define RAMFUNC __attribute__ ((section (".ramfunctions")))
#if defined(BOARD_SIPEED_MAIX_DUINO)
#define WORKSPACESIZE 500000 /* Objects (16*bytes) */
#define CODESIZE 512 /* Bytes */
#define STACKDIFF 4096
#define CPU_K210
#elif defined(BOARD_SIPEED_MAIX_BIT)
#define WORKSPACESIZE 500000 /* Objects (16*bytes) */
#define CODESIZE 512 /* Bytes */
#define STACKDIFF 4096
#define CPU_K210
#elif defined(BOARD_SIPEED_MAIX_ONE_DOCK)
#define WORKSPACESIZE 500000 /* Objects (16*bytes) */
#define CODESIZE 512 /* Bytes */
#define STACKDIFF 4096
#define CPU_K210
#else
#error "Board not supported!"
#endif"#)
(defparameter *check-pins-riscv* #"
// Check pins
void checkanalogread (int pin) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
if (!((pin>=32 && pin<=36) || pin==39)) error(invalidpin, number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
if (!(pin>=0 && pin<=13)) error(invalidpin, number(pin));
#elif defined(BOARD_SIPEED_MAIX_BIT)
if (!(pin>=0 && pin<=35)) error(invalidpin, number(pin));
#elif defined(BOARD_SIPEED_MAIX_ONE_DOCK)
if (!(pin>=0 && pin<=47)) error(invalidpin, number(pin));
#endif
}"#)
(defparameter *note-riscv* #"
// Note
const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
void playnote (int pin, int note, int octave) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
int oct = octave + note/12;
int prescaler = 8 - oct;
if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct));
tone(pin, scale[note%12]>>prescaler);
#endif
}
void nonote (int pin) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
noTone(pin);
#endif
}"#)
(defparameter *sleep-riscv* #"
// Sleep
void initsleep () { }
void doze (int secs) {
delay(1000 * secs);
}"#)
(defparameter *keywords-riscv*
'((nil
((NIL LED_BUILTIN)
(DIGITALWRITE HIGH LOW)
(PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT)))))

1582
builder/saveload.lisp Normal file
View File

File diff suppressed because it is too large Load Diff

984
builder/streams.lisp Normal file
View File

@ -0,0 +1,984 @@
;;;-*- Mode: Lisp; Package: cl-user -*-
(in-package :cl-user)
(defparameter *i2c-interface* '(
#+avr-nano
#"
// I2C interface for AVR platforms, uses much less RAM than Arduino Wire
#if defined(CPU_ATmega328P)
uint8_t const TWI_SDA_PIN = 18;
uint8_t const TWI_SCL_PIN = 19;
#elif defined(CPU_ATmega1280) || defined(CPU_ATmega2560)
uint8_t const TWI_SDA_PIN = 20;
uint8_t const TWI_SCL_PIN = 21;
#elif defined(CPU_ATmega644P) || defined(CPU_ATmega1284P)
uint8_t const TWI_SDA_PIN = 17;
uint8_t const TWI_SCL_PIN = 16;
#elif defined(CPU_ATmega32U4)
uint8_t const TWI_SDA_PIN = 6;
uint8_t const TWI_SCL_PIN = 5;
#endif
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
uint32_t const FREQUENCY = 400000L; // Hardware I2C clock in Hz
uint32_t const T_RISE = 300L; // Rise time
#else
uint32_t const F_TWI = 400000L; // Hardware I2C clock in Hz
uint8_t const TWSR_MTX_DATA_ACK = 0x28;
uint8_t const TWSR_MTX_ADR_ACK = 0x18;
uint8_t const TWSR_MRX_ADR_ACK = 0x40;
uint8_t const TWSR_START = 0x08;
uint8_t const TWSR_REP_START = 0x10;
uint8_t const I2C_READ = 1;
uint8_t const I2C_WRITE = 0;
#endif
void I2Cinit (bool enablePullup) {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
#if defined(CPU_ATmega4809)
if (enablePullup) {
pinMode(SDA, INPUT_PULLUP);
pinMode(SCL, INPUT_PULLUP);
}
#else
(void) enablePullup;
#endif
uint32_t baud = ((F_CPU/FREQUENCY) - (((F_CPU*T_RISE)/1000)/1000)/1000 - 10)/2;
TWI0.MBAUD = (uint8_t)baud;
TWI0.MCTRLA = TWI_ENABLE_bm; // Enable as master, no interrupts
TWI0.MSTATUS = TWI_BUSSTATE_IDLE_gc;
#else
TWSR = 0; // no prescaler
TWBR = (F_CPU/F_TWI - 16)/2; // set bit rate factor
if (enablePullup) {
digitalWrite(SDA, HIGH);
digitalWrite(SCL, HIGH);
}
#endif
}
int I2Cread () {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
if (I2Ccount != 0) I2Ccount--;
while (!(TWI0.MSTATUS & TWI_RIF_bm)); // Wait for read interrupt flag
uint8_t data = TWI0.MDATA;
// Check slave sent ACK?
if (I2Ccount != 0) TWI0.MCTRLB = TWI_MCMD_RECVTRANS_gc; // ACK = more bytes to read
else TWI0.MCTRLB = TWI_ACKACT_NACK_gc; // Send NAK
return data;
#else
if (I2Ccount != 0) I2Ccount--;
TWCR = 1<<TWINT | 1<<TWEN | ((I2Ccount == 0) ? 0 : (1<<TWEA));
while (!(TWCR & 1<<TWINT));
return TWDR;
#endif
}
bool I2Cwrite (uint8_t data) {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
TWI0.MCTRLB = TWI_MCMD_RECVTRANS_gc; // Prime transaction
TWI0.MDATA = data; // Send data
while (!(TWI0.MSTATUS & TWI_WIF_bm)); // Wait for write to complete
if (TWI0.MSTATUS & (TWI_ARBLOST_bm | TWI_BUSERR_bm)) return false; // Fails if bus error or arblost
return !(TWI0.MSTATUS & TWI_RXACK_bm); // Returns true if slave gave an ACK
#else
TWDR = data;
TWCR = 1<<TWINT | 1 << TWEN;
while (!(TWCR & 1<<TWINT));
return (TWSR & 0xF8) == TWSR_MTX_DATA_ACK;
#endif
}
bool I2Cstart (uint8_t address, uint8_t read) {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
TWI0.MADDR = address<<1 | read; // Send START condition
while (!(TWI0.MSTATUS & (TWI_WIF_bm | TWI_RIF_bm))); // Wait for write or read interrupt flag
if (TWI0.MSTATUS & TWI_ARBLOST_bm) { // Arbitration lost or bus error
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
return false;
} else if (TWI0.MSTATUS & TWI_RXACK_bm) { // Address not acknowledged by client
TWI0.MCTRLB |= TWI_MCMD_STOP_gc; // Send stop condition
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
return false;
}
return true; // Return true if slave gave an ACK
#else
uint8_t addressRW = address<<1 | read;
TWCR = 1<<TWINT | 1<<TWSTA | 1<<TWEN; // Send START condition
while (!(TWCR & 1<<TWINT));
if ((TWSR & 0xF8) != TWSR_START && (TWSR & 0xF8) != TWSR_REP_START) return false;
TWDR = addressRW; // send device address and direction
TWCR = 1<<TWINT | 1<<TWEN;
while (!(TWCR & 1<<TWINT));
if (addressRW & I2C_READ) return (TWSR & 0xF8) == TWSR_MRX_ADR_ACK;
else return (TWSR & 0xF8) == TWSR_MTX_ADR_ACK;
#endif
}
bool I2Crestart (uint8_t address, uint8_t read) {
return I2Cstart(address, read);
}
void I2Cstop (uint8_t read) {
#if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28)
(void) read;
TWI0.MCTRLB |= TWI_MCMD_STOP_gc; // Send STOP
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
#else
(void) read;
TWCR = 1<<TWINT | 1<<TWEN | 1<<TWSTO;
while (TWCR & 1<<TWSTO); // wait until stop and bus released
#endif
}"#
#+avr
#"
// I2C interface for AVR platforms, uses much less RAM than Arduino Wire
#if defined(CPU_AVR128DX48)
uint32_t const FREQUENCY = 400000L; // Hardware I2C clock in Hz
uint32_t const T_RISE = 300L; // Rise time
#else
uint32_t const F_TWI = 400000L; // Hardware I2C clock in Hz
uint8_t const TWSR_MTX_DATA_ACK = 0x28;
uint8_t const TWSR_MTX_ADR_ACK = 0x18;
uint8_t const TWSR_MRX_ADR_ACK = 0x40;
uint8_t const TWSR_START = 0x08;
uint8_t const TWSR_REP_START = 0x10;
uint8_t const I2C_READ = 1;
uint8_t const I2C_WRITE = 0;
#endif
void I2Cinit (bool enablePullup) {
#if defined(CPU_AVR128DX48)
#if defined(CPU_ATmega4809)
if (enablePullup) {
pinMode(SDA, INPUT_PULLUP);
pinMode(SCL, INPUT_PULLUP);
}
#else
(void) enablePullup;
#endif
uint32_t baud = ((F_CPU/FREQUENCY) - (((F_CPU*T_RISE)/1000)/1000)/1000 - 10)/2;
TWI0.MBAUD = (uint8_t)baud;
TWI0.MCTRLA = TWI_ENABLE_bm; // Enable as master, no interrupts
TWI0.MSTATUS = TWI_BUSSTATE_IDLE_gc;
#else
TWSR = 0; // no prescaler
TWBR = (F_CPU/F_TWI - 16)/2; // set bit rate factor
if (enablePullup) {
digitalWrite(SDA, HIGH);
digitalWrite(SCL, HIGH);
}
#endif
}
int I2Cread () {
#if defined(CPU_AVR128DX48)
if (I2Ccount != 0) I2Ccount--;
while (!(TWI0.MSTATUS & TWI_RIF_bm)); // Wait for read interrupt flag
uint8_t data = TWI0.MDATA;
// Check slave sent ACK?
if (I2Ccount != 0) TWI0.MCTRLB = TWI_MCMD_RECVTRANS_gc; // ACK = more bytes to read
else TWI0.MCTRLB = TWI_ACKACT_NACK_gc; // Send NAK
return data;
#else
if (I2Ccount != 0) I2Ccount--;
TWCR = 1<<TWINT | 1<<TWEN | ((I2Ccount == 0) ? 0 : (1<<TWEA));
while (!(TWCR & 1<<TWINT));
return TWDR;
#endif
}
bool I2Cwrite (uint8_t data) {
#if defined(CPU_AVR128DX48)
TWI0.MCTRLB = TWI_MCMD_RECVTRANS_gc; // Prime transaction
TWI0.MDATA = data; // Send data
while (!(TWI0.MSTATUS & TWI_WIF_bm)); // Wait for write to complete
if (TWI0.MSTATUS & (TWI_ARBLOST_bm | TWI_BUSERR_bm)) return false; // Fails if bus error or arblost
return !(TWI0.MSTATUS & TWI_RXACK_bm); // Returns true if slave gave an ACK
#else
TWDR = data;
TWCR = 1<<TWINT | 1 << TWEN;
while (!(TWCR & 1<<TWINT));
return (TWSR & 0xF8) == TWSR_MTX_DATA_ACK;
#endif
}
bool I2Cstart (uint8_t address, uint8_t read) {
#if defined(CPU_AVR128DX48)
TWI0.MADDR = address<<1 | read; // Send START condition
while (!(TWI0.MSTATUS & (TWI_WIF_bm | TWI_RIF_bm))); // Wait for write or read interrupt flag
if (TWI0.MSTATUS & TWI_ARBLOST_bm) { // Arbitration lost or bus error
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
return false;
} else if (TWI0.MSTATUS & TWI_RXACK_bm) { // Address not acknowledged by client
TWI0.MCTRLB |= TWI_MCMD_STOP_gc; // Send stop condition
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
return false;
}
return true; // Return true if slave gave an ACK
#else
uint8_t addressRW = address<<1 | read;
TWCR = 1<<TWINT | 1<<TWSTA | 1<<TWEN; // Send START condition
while (!(TWCR & 1<<TWINT));
if ((TWSR & 0xF8) != TWSR_START && (TWSR & 0xF8) != TWSR_REP_START) return false;
TWDR = addressRW; // send device address and direction
TWCR = 1<<TWINT | 1<<TWEN;
while (!(TWCR & 1<<TWINT));
if (addressRW & I2C_READ) return (TWSR & 0xF8) == TWSR_MRX_ADR_ACK;
else return (TWSR & 0xF8) == TWSR_MTX_ADR_ACK;
#endif
}
bool I2Crestart (uint8_t address, uint8_t read) {
return I2Cstart(address, read);
}
void I2Cstop (uint8_t read) {
#if defined(CPU_AVR128DX48)
(void) read;
TWI0.MCTRLB |= TWI_MCMD_STOP_gc; // Send STOP
while (!((TWI0.MSTATUS & TWI_BUSSTATE_gm) == TWI_BUSSTATE_IDLE_gc)); // Wait for bus to return to idle state
#else
(void) read;
TWCR = 1<<TWINT | 1<<TWEN | 1<<TWSTO;
while (TWCR & 1<<TWSTO); // wait until stop and bus released
#endif
}"#
#+(or arm esp)
#"
// I2C interface for up to two ports, using Arduino Wire
void I2Cinit (TwoWire *port, bool enablePullup) {
(void) enablePullup;
port->begin();
}
int I2Cread (TwoWire *port) {
return port->read();
}
void I2Cwrite (TwoWire *port, uint8_t data) {
port->write(data);
}
bool I2Cstart (TwoWire *port, uint8_t address, uint8_t read) {
int ok = true;
if (read == 0) {
port->beginTransmission(address);
ok = (port->endTransmission(true) == 0);
port->beginTransmission(address);
}
else port->requestFrom(address, I2Ccount);
return ok;
}
bool I2Crestart (TwoWire *port, uint8_t address, uint8_t read) {
int error = (port->endTransmission(false) != 0);
if (read == 0) port->beginTransmission(address);
else port->requestFrom(address, I2Ccount);
return error ? false : true;
}
void I2Cstop (TwoWire *port, uint8_t read) {
if (read == 0) port->endTransmission(); // Check for error?
// Release pins
port->end();
}"#
#-(or avr avr-nano badge arm esp)
#"
// I2C interface for one port, using Arduino Wire
void I2Cinit (bool enablePullup) {
(void) enablePullup;
Wire.begin();
}
int I2Cread () {
return Wire.read();
}
void I2Cwrite (uint8_t data) {
Wire.write(data);
}
bool I2Cstart (uint8_t address, uint8_t read) {
int ok = true;
if (read == 0) {
Wire.beginTransmission(address);
ok = (Wire.endTransmission(true) == 0);
Wire.beginTransmission(address);
}
else Wire.requestFrom(address, I2Ccount);
return ok;
}
bool I2Crestart (uint8_t address, uint8_t read) {
int error = (Wire.endTransmission(false) != 0);
if (read == 0) Wire.beginTransmission(address);
else Wire.requestFrom(address, I2Ccount);
return error ? false : true;
}
void I2Cstop (uint8_t read) {
if (read == 0) Wire.endTransmission(); // Check for error?
}"#
#+badge
#"
// I2C interface for AVR platforms, uses much less RAM than Arduino Wire
uint8_t const TWI_SDA_PIN = 17;
uint8_t const TWI_SCL_PIN = 16;
uint32_t const F_TWI = 400000L; // Hardware I2C clock in Hz
uint8_t const TWSR_MTX_DATA_ACK = 0x28;
uint8_t const TWSR_MTX_ADR_ACK = 0x18;
uint8_t const TWSR_MRX_ADR_ACK = 0x40;
uint8_t const TWSR_START = 0x08;
uint8_t const TWSR_REP_START = 0x10;
uint8_t const I2C_READ = 1;
uint8_t const I2C_WRITE = 0;
void I2Cinit (bool enablePullup) {
TWSR = 0; // no prescaler
TWBR = (F_CPU/F_TWI - 16)/2; // set bit rate factor
if (enablePullup) {
digitalWrite(TWI_SDA_PIN, HIGH);
digitalWrite(TWI_SCL_PIN, HIGH);
}
}
int I2Cread () {
if (I2Ccount != 0) I2Ccount--;
TWCR = 1<<TWINT | 1<<TWEN | ((I2Ccount == 0) ? 0 : (1<<TWEA));
while (!(TWCR & 1<<TWINT));
return TWDR;
}
bool I2Cwrite (uint8_t data) {
TWDR = data;
TWCR = 1<<TWINT | 1 << TWEN;
while (!(TWCR & 1<<TWINT));
return (TWSR & 0xF8) == TWSR_MTX_DATA_ACK;
}
bool I2Cstart (uint8_t address, uint8_t read) {
uint8_t addressRW = address<<1 | read;
TWCR = 1<<TWINT | 1<<TWSTA | 1<<TWEN; // Send START condition
while (!(TWCR & 1<<TWINT));
if ((TWSR & 0xF8) != TWSR_START && (TWSR & 0xF8) != TWSR_REP_START) return false;
TWDR = addressRW; // send device address and direction
TWCR = 1<<TWINT | 1<<TWEN;
while (!(TWCR & 1<<TWINT));
if (addressRW & I2C_READ) return (TWSR & 0xF8) == TWSR_MRX_ADR_ACK;
else return (TWSR & 0xF8) == TWSR_MTX_ADR_ACK;
}
bool I2Crestart (uint8_t address, uint8_t read) {
return I2Cstart(address, read);
}
void I2Cstop (uint8_t read) {
(void) read;
TWCR = 1<<TWINT | 1<<TWEN | 1<<TWSTO;
while (TWCR & 1<<TWSTO); // wait until stop and bus released
}"#))
(defparameter *stream-interface* '(
#+avr-nano
#"
// Streams
inline int spiread () { return SPI.transfer(0); }
#if defined(CPU_AVR64DD28)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
#endif
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
void serialbegin (int address, int baud) {
(void) address; (void) baud;
error(PSTR("port not supported"), number(address));
}"#
#+avr
#"
// Streams
inline int spiread () { return SPI.transfer(0); }
#if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
#elif defined(CPU_ATmega2560)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); }
inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); }
#endif
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
void serialbegin (int address, int baud) {
(void) address; (void) baud;
}"#
#+(or avr avr-nano)
#"
void serialend (int address) {
(void) address;
}
gfun_t gstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
gfun_t gfun = gserial;
if (args != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread;
else if (streamtype == SPISTREAM) gfun = spiread;
else if (streamtype == SERIALSTREAM) {
if (address == 0) gfun = gserial;
#if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48)
else if (address == 1) gfun = serial1read;
#elif defined(CPU_ATmega2560)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
else if (address == 3) gfun = serial3read;
#endif
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread;
#endif
else error2(unknownstreamtype);
return gfun;
}
inline void spiwrite (char c) { SPI.transfer(c); }
#if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48)
inline void serial1write (char c) { Serial1.write(c); }
#elif defined(CPU_ATmega2560)
inline void serial1write (char c) { Serial1.write(c); }
inline void serial2write (char c) { Serial2.write(c); }
inline void serial3write (char c) { Serial3.write(c); }
#endif
#if defined(sdcardsupport)
inline void SDwrite (char c) { int w = SDpfile.write(c); if (w != 1) { Context = NIL; error2(PSTR("failed to write to file")); } }
#endif
pfun_t pstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
pfun_t pfun = pserial;
if (args != NULL && first(args) != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite;
else if (streamtype == SPISTREAM) pfun = spiwrite;
else if (streamtype == SERIALSTREAM) {
if (address == 0) pfun = pserial;
#if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48)
else if (address == 1) pfun = serial1write;
#elif defined(CPU_ATmega2560)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
else if (address == 3) pfun = serial3write;
#endif
}
else if (streamtype == STRINGSTREAM) {
pfun = pstr;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite;
#endif
else error2(unknownstreamtype);
return pfun;
}"#
#+arm
#"
// Streams
// Simplify board differences
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) \
|| defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) || defined(ARDUINO_TEENSY40) \
|| defined(ARDUINO_TEENSY41) || defined(ARDUINO_RASPBERRY_PI_PICO) \
|| defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \
|| defined(ARDUINO_PIMORONI_PICO_PLUS_2)
#define ULISP_SPI1
#endif
#if defined(ARDUINO_WIO_TERMINAL) || defined(ARDUINO_BBC_MICROBIT_V2) \
|| defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) \
|| defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \
|| defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \
|| defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2) \
|| defined(ARDUINO_GRAND_CENTRAL_M4) || defined(ARDUINO_NRF52840_CIRCUITPLAY)
#define ULISP_I2C1
#endif
#if defined(ARDUINO_SAM_DUE) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define ULISP_SERIAL3
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \
|| defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2)
#define ULISP_SERIAL2
#elif !defined(CPU_NRF51822) && !defined(CPU_NRF52833) && !defined(ARDUINO_FEATHER_F405)
#define ULISP_SERIAL1
#endif
#if defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_UNOWIFIR4)
#define ULISP_WIFI
#endif
inline int spiread () { return SPI.transfer(0); }
#if defined(ULISP_SPI1)
inline int spi1read () { return SPI1.transfer(0); }
#endif
inline int i2cread () { return I2Cread(&Wire); }
#if defined(ULISP_I2C1)
inline int i2c1read () { return I2Cread(&Wire1); }
#endif
#if defined(ULISP_SERIAL3)
inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); }
#endif
#if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2)
inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); }
#endif
#if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2) || defined(ULISP_SERIAL1)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
#endif
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
#if defined(ULISP_WIFI)
WiFiClient client;
WiFiServer server(80);
inline int WiFiread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
while (!client.available()) testescape();
return client.read();
}
#endif
void serialbegin (int address, int baud) {
#if defined(ULISP_SERIAL3)
if (address == 1) Serial1.begin((long)baud*100);
else if (address == 2) Serial2.begin((long)baud*100);
else if (address == 3) Serial3.begin((long)baud*100);
#elif defined(ULISP_SERIAL2)
if (address == 1) Serial1.begin((long)baud*100);
else if (address == 2) Serial2.begin((long)baud*100);
#elif defined(ULISP_SERIAL1)
if (address == 1) Serial1.begin((long)baud*100);
#else
(void) baud;
if (false);
#endif
else error("port not supported", number(address));
}
void serialend (int address) {
#if defined(ULISP_SERIAL3)
if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) {Serial2.flush(); Serial2.end(); }
else if (address == 3) {Serial3.flush(); Serial3.end(); }
#elif defined(ULISP_SERIAL2)
if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) {Serial2.flush(); Serial2.end(); }
#elif defined(ULISP_SERIAL1)
if (address == 1) {Serial1.flush(); Serial1.end(); }
#else
if (false);
#endif
else error("port not supported", number(address));
}
gfun_t gstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
gfun_t gfun = gserial;
if (args != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) gfun = i2cread;
#if defined(ULISP_I2C1)
else gfun = i2c1read;
#endif
} else if (streamtype == SPISTREAM) {
if (address < 128) gfun = spiread;
#if defined(ULISP_SPI1)
else gfun = spi1read;
#endif
}
else if (streamtype == SERIALSTREAM) {
if (address == 0) gfun = gserial;
#if defined(ULISP_SERIAL3)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
else if (address == 3) gfun = serial3read;
#elif defined(ULISP_SERIAL2)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
#elif defined(ULISP_SERIAL1)
else if (address == 1) gfun = serial1read;
#endif
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread;
#endif
#if defined(ULISP_WIFI)
else if (streamtype == WIFISTREAM) gfun = (gfun_t)WiFiread;
#endif
else error2("unknown stream type");
return gfun;
}
inline void spiwrite (char c) { SPI.transfer(c); }
#if defined(ULISP_SPI1)
inline void spi1write (char c) { SPI1.transfer(c); }
#endif
inline void i2cwrite (char c) { I2Cwrite(&Wire, c); }
#if defined(ULISP_I2C1)
inline void i2c1write (char c) { I2Cwrite(&Wire1, c); }
#endif
#if defined(ULISP_SERIAL3)
inline void serial1write (char c) { Serial1.write(c); }
inline void serial2write (char c) { Serial2.write(c); }
inline void serial3write (char c) { Serial3.write(c); }
#elif defined(ULISP_SERIAL2)
inline void serial2write (char c) { Serial2.write(c); }
inline void serial1write (char c) { Serial1.write(c); }
#elif defined(ULISP_SERIAL1)
inline void serial1write (char c) { Serial1.write(c); }
#endif
#if defined(sdcardsupport)
inline void SDwrite (char c) { SDpfile.write(uint8_t(c)); } // Fix for RP2040
#endif
#if defined(ULISP_WIFI)
inline void WiFiwrite (char c) { client.write(c); }
#endif
#if defined(gfxsupport)
inline void gfxwrite (char c) { tft.write(c); }
#endif
pfun_t pstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
pfun_t pfun = pserial;
if (args != NULL && first(args) != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) pfun = i2cwrite;
#if defined(ULISP_I2C1)
else pfun = i2c1write;
#endif
} else if (streamtype == SPISTREAM) {
if (address < 128) pfun = spiwrite;
#if defined(ULISP_SPI1)
else pfun = spi1write;
#endif
} else if (streamtype == SERIALSTREAM) {
if (address == 0) pfun = pserial;
#if defined(ULISP_SERIAL3)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
else if (address == 3) pfun = serial3write;
#elif defined(ULISP_SERIAL2)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
#elif defined(ULISP_SERIAL1)
else if (address == 1) pfun = serial1write;
#endif
}
else if (streamtype == STRINGSTREAM) {
pfun = pstr;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite;
#endif
#if defined(gfxsupport)
else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite;
#endif
#if defined(ULISP_WIFI)
else if (streamtype == WIFISTREAM) pfun = (pfun_t)WiFiwrite;
#endif
else error2("unknown stream type");
return pfun;
}"#
#+esp
#"
// Streams
// Simplify board differences
#if defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2)
#define ULISP_I2C1
#endif
inline int spiread () { return SPI.transfer(0); }
inline int i2cread () { return I2Cread(&Wire); }
#if defined(ULISP_I2C1)
inline int i2c1read () { return I2Cread(&Wire1); }
#endif
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
WiFiClient client;
WiFiServer server(80);
inline int WiFiread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
while (!client.available()) testescape();
return client.read();
}
void serialbegin (int address, int baud) {
if (address == 1) Serial1.begin((long)baud*100);
else error(PSTR("port not supported"), number(address));
}
void serialend (int address) {
if (address == 1) {Serial1.flush(); Serial1.end(); }
else error(PSTR("port not supported"), number(address));
}
gfun_t gstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
gfun_t gfun = gserial;
if (args != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) gfun = i2cread;
#if defined(ULISP_I2C1)
else gfun = i2c1read;
#endif
} else if (streamtype == SPISTREAM) gfun = spiread;
else if (streamtype == SERIALSTREAM) {
if (address == 0) gfun = gserial;
else if (address == 1) gfun = serial1read;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread;
#endif
else if (streamtype == WIFISTREAM) gfun = (gfun_t)WiFiread;
else error2(PSTR("unknown stream type"));
return gfun;
}
inline void spiwrite (char c) { SPI.transfer(c); }
inline void i2cwrite (char c) { I2Cwrite(&Wire, c); }
#if defined(ULISP_I2C1)
inline void i2c1write (char c) { I2Cwrite(&Wire1, c); }
#endif
inline void serial1write (char c) { Serial1.write(c); }
inline void WiFiwrite (char c) { client.write(c); }
#if defined(sdcardsupport)
inline void SDwrite (char c) { SDpfile.write(c); }
#endif
#if defined(gfxsupport)
inline void gfxwrite (char c) { tft.write(c); }
#endif
pfun_t pstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
pfun_t pfun = pserial;
if (args != NULL && first(args) != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) pfun = i2cwrite;
#if defined(ULISP_I2C1)
else pfun = i2c1write;
#endif
} else if (streamtype == SPISTREAM) pfun = spiwrite;
else if (streamtype == SERIALSTREAM) {
if (address == 0) pfun = pserial;
else if (address == 1) pfun = serial1write;
}
else if (streamtype == STRINGSTREAM) {
pfun = pstr;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite;
#endif
#if defined(gfxsupport)
else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite;
#endif
else if (streamtype == WIFISTREAM) pfun = (pfun_t)WiFiwrite;
else error2(PSTR("unknown stream type"));
return pfun;
}"#
#+riscv
#"
// Streams
inline int spiread () { return SPI.transfer(0); }
#if defined(BOARD_SIPEED_MAIX_DUINO)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); }
inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); }
#endif
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
void serialbegin (int address, int baud) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
if (address == 1) Serial1.begin((long)baud*100);
else if (address == 2) Serial2.begin((long)baud*100);
else if (address == 3) Serial3.begin((long)baud*100);
else error(PSTR("port not supported"), number(address));
#endif
}
void serialend (int address) {
#if defined(BOARD_SIPEED_MAIX_DUINO)
if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) {Serial2.flush(); Serial2.end(); }
else if (address == 3) {Serial3.flush(); Serial3.end(); }
#endif
}
gfun_t gstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
gfun_t gfun = gserial;
if (args != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread;
else if (streamtype == SPISTREAM) {
if (address < 128) gfun = spiread;
}
else if (streamtype == SERIALSTREAM) {
if (address == 0) gfun = gserial;
#if defined(BOARD_SIPEED_MAIX_DUINO)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
else if (address == 3) gfun = serial3read;
#endif
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread;
#endif
else error2(PSTR("unknown stream type"));
return gfun;
}
inline void spiwrite (char c) { SPI.transfer(c); }
#if defined(BOARD_SIPEED_MAIX_DUINO)
inline void serial1write (char c) { Serial1.write(c); }
inline void serial2write (char c) { Serial2.write(c); }
inline void serial3write (char c) { Serial3.write(c); }
#endif
#if defined(sdcardsupport)
inline void SDwrite (char c) { SDpfile.write(c); }
#endif
#if defined(gfxsupport)
inline void gfxwrite (char c) { tft.write(c); }
#endif
pfun_t pstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
pfun_t pfun = pserial;
if (args != NULL && first(args) != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite;
else if (streamtype == SPISTREAM) {
if (address < 128) pfun = spiwrite;
}
else if (streamtype == SERIALSTREAM) {
if (address == 0) pfun = pserial;
#if defined(BOARD_SIPEED_MAIX_DUINO)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
else if (address == 3) pfun = serial3write;
#endif
}
else if (streamtype == STRINGSTREAM) {
pfun = pstr;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite;
#endif
#if defined(gfxsupport)
else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite;
#endif
else error2(PSTR("unknown stream type"));
return pfun;
}"#))

2633
builder/utilities.lisp Normal file
View File

File diff suppressed because it is too large Load Diff