├── Test Suites ├── .DS_Store ├── AutoTester AVR Nano.lisp ├── AutoTester AVR.lisp └── AutoTester 32-bit.lisp ├── README.md ├── Load Builder.lisp ├── LICENSE ├── riscv.lisp ├── extras.lisp ├── prettyprint.lisp ├── assembler.lisp ├── avr-nano.lisp ├── avr.lisp ├── esp.lisp ├── preface.lisp ├── arm.lisp └── streams.lisp /Test Suites/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/technoblogy/ulisp-builder/HEAD/Test Suites/.DS_Store -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # uLisp Builder 2 | Builds a version of uLisp for a particular platform from a common repository of source files. 3 | 4 | Currently updated to Version 4.7 for the AVR, AVR-Nano, ARM, ESP32, and RISC-V platforms. 5 | 6 | For information see http://www.ulisp.com/show?3F07. 7 | -------------------------------------------------------------------------------- /Load Builder.lisp: -------------------------------------------------------------------------------- 1 | ;; Options: :avr :avr-nano :arm :msp430 :esp :stm32 :badge :zero :riscv 2 | 3 | (push :avr-nano *features*) 4 | 5 | (defparameter *release* "4.7") 6 | (defparameter *date* "5th November 2024") 7 | 8 | ;*************************************** 9 | 10 | #+badge 11 | (push :avr *features*) 12 | 13 | #+(or arm esp stm32 riscv) 14 | (push :float *features*) 15 | 16 | #+(or arm esp stm32 riscv avr) 17 | (push :arrays *features*) 18 | 19 | #+(or arm esp) 20 | (push :wifi *features*) 21 | 22 | #+(or riscv arm esp) 23 | (push :gfx *features*) 24 | 25 | #+(or arm esp riscv avr) 26 | (push :doc *features*) 27 | 28 | #+(or arm esp riscv avr) 29 | (push :errors *features*) 30 | 31 | (load "/Users/david/Projects/Builder/builder defsys.lisp") 32 | 33 | (map nil #'delete-file (directory "/Users/david/Projects/Builder/fasls/*")) 34 | 35 | (compile-system "builder" :load t) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 David Johnson-Davies 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /riscv.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | ; RISC-V 6 | 7 | (defparameter *title-riscv* 8 | #"/* uLisp RISC-V Release ~a - www.ulisp.com 9 | David Johnson-Davies - www.technoblogy.com - ~a 10 | 11 | Licensed under the MIT license: https://opensource.org/licenses/MIT 12 | */"#) 13 | 14 | (defparameter *header-riscv* #" 15 | // Lisp Library 16 | const char LispLibrary[] PROGMEM = ""; 17 | 18 | // Compile options 19 | 20 | // #define resetautorun 21 | #define printfreespace 22 | // #define printgcs 23 | // #define sdcardsupport 24 | // #define gfxsupport 25 | // #define lisplibrary 26 | #define assemblerlist 27 | // #define lineeditor 28 | // #define vt100 29 | // #define extensions 30 | 31 | // Includes 32 | 33 | // #include "LispLibrary.h" 34 | #include 35 | #include 36 | #include 37 | #include 38 | 39 | #if defined(gfxsupport) 40 | #include 41 | SPIClass spi_(SPI0); // MUST be SPI0 for Maix series on board LCD 42 | Sipeed_ST7789 tft(320, 240, spi_); 43 | #endif 44 | 45 | #if defined(sdcardsupport) 46 | #include 47 | #define SDSIZE 172 48 | #else 49 | #define SDSIZE 0 50 | #endif"#) 51 | 52 | (defparameter *workspace-riscv* #" 53 | // Platform specific settings 54 | 55 | #define WORDALIGNED __attribute__((aligned (8))) 56 | #define BUFFERSIZE 36 // Number of bits+4 57 | #define RAMFUNC __attribute__ ((section (".ramfunctions"))) 58 | 59 | #if defined(BOARD_SIPEED_MAIX_DUINO) 60 | #define WORKSPACESIZE 500000 /* Objects (16*bytes) */ 61 | #define CODESIZE 512 /* Bytes */ 62 | #define STACKDIFF 4096 63 | #define CPU_K210 64 | 65 | #elif defined(BOARD_SIPEED_MAIX_BIT) 66 | #define WORKSPACESIZE 500000 /* Objects (16*bytes) */ 67 | #define CODESIZE 512 /* Bytes */ 68 | #define STACKDIFF 4096 69 | #define CPU_K210 70 | 71 | #elif defined(BOARD_SIPEED_MAIX_ONE_DOCK) 72 | #define WORKSPACESIZE 500000 /* Objects (16*bytes) */ 73 | #define CODESIZE 512 /* Bytes */ 74 | #define STACKDIFF 4096 75 | #define CPU_K210 76 | 77 | #else 78 | #error "Board not supported!" 79 | #endif"#) 80 | 81 | (defparameter *check-pins-riscv* #" 82 | // Check pins 83 | 84 | void checkanalogread (int pin) { 85 | #if defined(BOARD_SIPEED_MAIX_DUINO) 86 | if (!((pin>=32 && pin<=36) || pin==39)) error(invalidpin, number(pin)); 87 | #endif 88 | } 89 | 90 | void checkanalogwrite (int pin) { 91 | #if defined(BOARD_SIPEED_MAIX_DUINO) 92 | if (!(pin>=0 && pin<=13)) error(invalidpin, number(pin)); 93 | #elif defined(BOARD_SIPEED_MAIX_BIT) 94 | if (!(pin>=0 && pin<=35)) error(invalidpin, number(pin)); 95 | #elif defined(BOARD_SIPEED_MAIX_ONE_DOCK) 96 | if (!(pin>=0 && pin<=47)) error(invalidpin, number(pin)); 97 | #endif 98 | }"#) 99 | 100 | (defparameter *note-riscv* #" 101 | // Note 102 | 103 | const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; 104 | 105 | void playnote (int pin, int note, int octave) { 106 | #if defined(BOARD_SIPEED_MAIX_DUINO) 107 | int oct = octave + note/12; 108 | int prescaler = 8 - oct; 109 | if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct)); 110 | tone(pin, scale[note%12]>>prescaler); 111 | #endif 112 | } 113 | 114 | void nonote (int pin) { 115 | #if defined(BOARD_SIPEED_MAIX_DUINO) 116 | noTone(pin); 117 | #endif 118 | }"#) 119 | 120 | (defparameter *sleep-riscv* #" 121 | // Sleep 122 | 123 | void initsleep () { } 124 | 125 | void doze (int secs) { 126 | delay(1000 * secs); 127 | }"#) 128 | 129 | (defparameter *keywords-riscv* 130 | '((nil 131 | ((NIL LED_BUILTIN) 132 | (DIGITALWRITE HIGH LOW) 133 | (PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT))))) 134 | -------------------------------------------------------------------------------- /extras.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | ; To run do (build) 6 | 7 | ; Sharp-double-quote 8 | 9 | (defun sharp-double-quote-reader (stream sub-char numarg) 10 | (declare (ignore sub-char numarg)) 11 | (let (chars) 12 | (do ((prev (read-char stream) curr) 13 | (curr (read-char stream) (read-char stream))) 14 | ((and (char= prev #\") (char= curr #\#))) 15 | (push prev chars)) 16 | (coerce (nreverse chars) 'string))) 17 | 18 | (set-dispatch-macro-character 19 | #\# #\" #'sharp-double-quote-reader) 20 | 21 | ; Code generation functions 22 | 23 | (defun float-function (str enum string comments) 24 | (declare (ignore string)) 25 | (format str " 26 | ~:[~2*~;/* 27 | (~a number) 28 | Returns ~a(number). 29 | */ 30 | ~]object *fn_~a (object *args, object *env) { 31 | (void) env; 32 | return makefloat(~a(checkintfloat(first(args)))); 33 | }" 34 | comments 35 | (string-downcase enum) 36 | (string-downcase enum) 37 | (string-downcase enum) 38 | (string-downcase enum))) 39 | 40 | (defun truncate-function (str enum string comments) 41 | (declare (ignore string)) 42 | (format str " 43 | ~:[~2*~;/* 44 | (~a number [divisor]) 45 | Returns ~a(number/divisor). If omitted, divisor is 1. 46 | */ 47 | ~]object *fn_~a (object *args, object *env) { 48 | (void) env; 49 | object *arg = first(args); 50 | args = cdr(args); 51 | if (args != NULL) return number(~a(checkintfloat(arg) / checkintfloat(first(args)))); 52 | else return number(~a(checkintfloat(arg))); 53 | }" 54 | comments 55 | (string-downcase enum) 56 | (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round")))) 57 | (string-downcase enum) 58 | (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round")))) 59 | (cdr (assoc enum '((CEILING . "ceil") (FLOOR . "floor") (TRUNCATE . "trunc") (ROUND . "round")))))) 60 | 61 | #| 62 | (defun numeric1 (str enum string comments) 63 | (declare (ignore string)) 64 | (format str " 65 | object *fn_~a (object *args, object *env) { 66 | (void) env; 67 | int arg = checkinteger(~a, first(args)); 68 | return number(~a(arg)); 69 | }" (string-downcase enum) enum (string-downcase enum))) 70 | |# 71 | 72 | (defun bitwise (str enum string comments) 73 | (declare (ignore string)) 74 | (format str " 75 | ~:[~2*~;/* 76 | (~a [value*]) 77 | Returns the bitwise ~a of the values. 78 | */ 79 | ~]object *fn_~a (object *args, object *env) { 80 | (void) env; 81 | int result = ~a; 82 | while (args != NULL) { 83 | result = result ~a checkinteger(first(args)); 84 | args = cdr(args); 85 | } 86 | return number(result); 87 | }" 88 | comments 89 | (string-downcase enum) 90 | (cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^")))) 91 | (string-downcase enum) 92 | (cdr (assoc enum '((LOGAND . "-1") (LOGIOR . "0") (LOGXOR . "0")))) 93 | (cdr (assoc enum '((LOGAND . "&") (LOGIOR . "|") (LOGXOR . "^")))))) 94 | 95 | #| 96 | ; For max or min 97 | 98 | (defun numeric2 (str enum string comments) 99 | (declare (ignore string)) 100 | (format str " 101 | object *fn_~a (object *args, object *env) { 102 | (void) env; 103 | int result = integer(first(args)); 104 | args = cdr(args); 105 | while (args != NULL) { 106 | result = ~a(result,integer(car(args))); 107 | args = cdr(args); 108 | } 109 | return number(result); 110 | }" (string-downcase enum) (string-downcase enum))) 111 | |# 112 | 113 | (defun split-into-lines (string &optional (indent 0)) 114 | (let* ((linelen 106) 115 | (start 0) 116 | (end (- linelen indent)) 117 | (length (length string)) 118 | result) 119 | (loop 120 | (when (>= end length) 121 | (push (subseq string start) result) 122 | (return (reverse result))) 123 | (let ((comma (position #\, string :start start :end end :from-end t))) 124 | (push (subseq string start (1+ comma)) result) 125 | (setq start (+ comma 2) end (+ comma 2 linelen)))))) -------------------------------------------------------------------------------- /prettyprint.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | ;; Prettyprinter and tree editor 6 | 7 | (defparameter *prettyprint* 8 | '( 9 | #" 10 | // Prettyprint"# 11 | 12 | #-(or badge gfx) 13 | #" 14 | const int PPINDENT = 2; 15 | const int PPWIDTH = 80;"# 16 | 17 | #+badge 18 | #" 19 | const int PPINDENT = 2; 20 | const int PPWIDTH = 42;"# 21 | 22 | #+gfx 23 | #" 24 | const int PPINDENT = 2; 25 | const int PPWIDTH = 80; 26 | const int GFXPPWIDTH = 52; // 320 pixel wide screen 27 | int ppwidth = PPWIDTH;"# 28 | 29 | #" 30 | void pcount (char c) { 31 | if (c == '\n') PrintCount++; 32 | PrintCount++; 33 | } 34 | 35 | /* 36 | atomwidth - calculates the character width of an atom 37 | */ 38 | uint8_t atomwidth (object *obj) { 39 | PrintCount = 0; 40 | printobject(obj, pcount); 41 | return PrintCount; 42 | } 43 | 44 | /* 45 | basewidth - calculates the character width of an integer printed in a given base 46 | */ 47 | uint8_t basewidth (object *obj, uint8_t base) { 48 | PrintCount = 0; 49 | pintbase(obj->integer, base, pcount); 50 | return PrintCount; 51 | } 52 | 53 | /* 54 | quoted - tests whether an object is quoted 55 | */ 56 | bool quoted (object *obj) { 57 | return (consp(obj) && car(obj) != NULL && car(obj)->name == sym(QUOTE) && consp(cdr(obj)) && cddr(obj) == NULL); 58 | } 59 | 60 | /* 61 | subwidth - returns the space left from w after printing object 62 | */ 63 | int subwidth (object *obj, int w) { 64 | if (atom(obj)) return w - atomwidth(obj); 65 | if (quoted(obj)) obj = car(cdr(obj)); 66 | return subwidthlist(obj, w - 1); 67 | } 68 | 69 | /* 70 | subwidth - returns the space left from w after printing a list 71 | */ 72 | int subwidthlist (object *form, int w) { 73 | while (form != NULL && w >= 0) { 74 | if (atom(form)) return w - (2 + atomwidth(form)); 75 | w = subwidth(car(form), w - 1); 76 | form = cdr(form); 77 | } 78 | return w; 79 | }"# 80 | 81 | #-gfx 82 | #" 83 | /* 84 | superprint - handles pretty-printing 85 | */ 86 | void superprint (object *form, int lm, pfun_t pfun) { 87 | if (atom(form)) { 88 | if (isbuiltin(form, NOTHING)) printsymbol(form, pfun); 89 | else printobject(form, pfun); 90 | } else if (quoted(form)) { 91 | pfun('\''); 92 | superprint(car(cdr(form)), lm + 1, pfun); 93 | } else { 94 | lm = lm + PPINDENT; 95 | bool fits = (subwidth(form, PPWIDTH - lm - PPINDENT) >= 0); 96 | int special = 0, extra = 0; bool separate = true; 97 | object *arg = car(form); 98 | if (symbolp(arg) && builtinp(arg->name)) { 99 | uint8_t minmax = getminmax(builtin(arg->name)); 100 | if (minmax == 0327 || minmax == 0313) special = 2; // defun, setq, setf, defvar 101 | else if (minmax == 0317 || minmax == 0017 || minmax == 0117 || minmax == 0123) special = 1; 102 | } 103 | while (form != NULL) { 104 | if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; } 105 | else if (separate) { 106 | pfun('('); 107 | separate = false; 108 | } else if (special) { 109 | pfun(' '); 110 | special--; 111 | } else if (fits) { 112 | pfun(' '); 113 | } else { pln(pfun); indent(lm, ' ', pfun); } 114 | superprint(car(form), lm+extra, pfun); 115 | form = cdr(form); 116 | } 117 | pfun(')'); 118 | } 119 | }"# 120 | 121 | #+gfx 122 | #" 123 | /* 124 | superprint - handles pretty-printing 125 | */ 126 | void superprint (object *form, int lm, pfun_t pfun) { 127 | if (atom(form)) { 128 | if (isbuiltin(form, NOTHING)) printsymbol(form, pfun); 129 | else printobject(form, pfun); 130 | } else if (quoted(form)) { 131 | pfun('\''); 132 | superprint(car(cdr(form)), lm + 1, pfun); 133 | } else { 134 | lm = lm + PPINDENT; 135 | bool fits = (subwidth(form, ppwidth - lm - PPINDENT) >= 0); 136 | int special = 0, extra = 0; bool separate = true; 137 | object *arg = car(form); 138 | if (symbolp(arg) && builtinp(arg->name)) { 139 | uint8_t minmax = getminmax(builtin(arg->name)); 140 | if (minmax == 0327 || minmax == 0313) special = 2; // defun, setq, setf, defvar 141 | else if (minmax == 0317 || minmax == 0017 || minmax == 0117 || minmax == 0123) special = 1; 142 | } 143 | while (form != NULL) { 144 | if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; } 145 | else if (separate) { 146 | pfun('('); 147 | separate = false; 148 | } else if (special) { 149 | pfun(' '); 150 | special--; 151 | } else if (fits) { 152 | pfun(' '); 153 | } else { pln(pfun); indent(lm, ' ', pfun); } 154 | superprint(car(form), lm+extra, pfun); 155 | form = cdr(form); 156 | } 157 | pfun(')'); 158 | } 159 | }"# 160 | 161 | #" 162 | /* 163 | edit - the Lisp tree editor 164 | Steps through a function definition, editing it a bit at a time, using single-key editing commands. 165 | */ 166 | object *edit (object *fun) { 167 | while (1) { 168 | if (tstflag(EXITEDITOR)) return fun; 169 | char c = gserial(); 170 | if (c == 'q') setflag(EXITEDITOR); 171 | else if (c == 'b') return fun; 172 | else if (c == 'r') fun = read(gserial); 173 | else if (c == '\n') { pfl(pserial); superprint(fun, 0, pserial); pln(pserial); } 174 | else if (c == 'c') fun = cons(read(gserial), fun); 175 | else if (atom(fun)) pserial('!'); 176 | else if (c == 'd') fun = cons(car(fun), edit(cdr(fun))); 177 | else if (c == 'a') fun = cons(edit(car(fun)), cdr(fun)); 178 | else if (c == 'x') fun = cdr(fun); 179 | else pserial('?'); 180 | } 181 | }"#)) 182 | -------------------------------------------------------------------------------- /assembler.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | (defparameter *assembler* 6 | '( 7 | 8 | #+avr 9 | #" 10 | // Assembler 11 | 12 | #if defined(CPU_ATmega1284P) 13 | #define CODE_ADDRESS 0x1bb00 14 | #elif defined(CPU_AVR128DX48) 15 | #define CODE_ADDRESS 0x1be00 16 | #endif 17 | 18 | object *call (int entry, int nargs, object *args, object *env) { 19 | #if defined(CODESIZE) 20 | (void) env; 21 | int param[4]; 22 | for (int i=0; iinteger; 25 | else param[i] = (uintptr_t)arg; 26 | args = cdr(args); 27 | } 28 | uint32_t address = (CODE_ADDRESS + entry)>>1; // Code addresses are word addresses on AVR 29 | int w = ((intfn_ptr_type)address)(param[0], param[1], param[2], param[3]); 30 | return number(w); 31 | #else 32 | return nil; 33 | #endif 34 | }"# 35 | 36 | #+arm 37 | #" 38 | // Assembler 39 | 40 | object *call (int entry, int nargs, object *args, object *env) { 41 | #if defined(CODESIZE) 42 | (void) env; 43 | int param[4]; 44 | for (int i=0; iinteger; 47 | else param[i] = (uintptr_t)arg; 48 | args = cdr(args); 49 | } 50 | int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]); 51 | return number(w); 52 | #else 53 | return nil; 54 | #endif 55 | }"# 56 | 57 | #+riscv 58 | #" 59 | // Assembler 60 | 61 | object *call (int entry, int nargs, object *args, object *env) { 62 | #if defined(CODESIZE) 63 | (void) env; 64 | int param[4]; 65 | for (int i=0; iinteger; 68 | else param[i] = (uintptr_t)arg; 69 | args = cdr(args); 70 | } 71 | asm("fence.i"); 72 | int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]); 73 | return number(w); 74 | #else 75 | return nil; 76 | #endif 77 | }"# 78 | 79 | #+avr 80 | #" 81 | void putcode (object *arg, int origin, int pc) { 82 | #if defined(CODESIZE) 83 | int code = checkinteger(arg); 84 | uint8_t hi = (code>>8) & 0xff; 85 | uint8_t lo = code & 0xff; 86 | MyCode[origin+pc] = lo; // Little-endian 87 | MyCode[origin+pc+1] = hi; 88 | #if defined(assemblerlist) 89 | printhex2(pc>>8, pserial); printhex2(pc, pserial); pserial(' '); 90 | printhex2(lo, pserial); pserial(' '); printhex2(hi, pserial); pserial(' '); 91 | #endif 92 | #endif 93 | }"# 94 | 95 | #+(or arm riscv) 96 | #" 97 | void putcode (object *arg, int origin, int pc) { 98 | #if defined(CODESIZE) 99 | int code = checkinteger(arg); 100 | MyCode[origin+pc] = code & 0xff; 101 | MyCode[origin+pc+1] = (code>>8) & 0xff; 102 | #if defined(assemblerlist) 103 | printhex4(pc, pserial); 104 | printhex4(code, pserial); 105 | #endif 106 | #endif 107 | }"# 108 | 109 | #+avr 110 | #" 111 | int assemble (int pass, int origin, object *entries, object *env, object *pcpair) { 112 | int pc = 0; cdr(pcpair) = number(pc); 113 | while (entries != NULL) { 114 | object *arg = first(entries); 115 | if (symbolp(arg)) { 116 | if (pass == 2) { 117 | #if defined(assemblerlist) 118 | printhex2(pc>>8, pserial); printhex2(pc, pserial); 119 | indent(7, ' ', pserial); 120 | printobject(arg, pserial); pln(pserial); 121 | #endif 122 | } else { 123 | object *pair = findvalue(arg, env); 124 | cdr(pair) = number(pc); 125 | } 126 | } else { 127 | object *argval = eval(arg, env); 128 | if (listp(argval)) { 129 | object *arglist = argval; 130 | while (arglist != NULL) { 131 | if (pass == 2) { 132 | putcode(first(arglist), origin, pc); 133 | #if defined(assemblerlist) 134 | if (arglist == argval) superprint(arg, 0, pserial); 135 | pln(pserial); 136 | #endif 137 | } 138 | pc = pc + 2; 139 | cdr(pcpair) = number(pc); 140 | arglist = cdr(arglist); 141 | } 142 | } else if (integerp(argval)) { 143 | if (pass == 2) { 144 | putcode(argval, origin, pc); 145 | #if defined(assemblerlist) 146 | superprint(arg, 0, pserial); pln(pserial); 147 | #endif 148 | } 149 | pc = pc + 2; 150 | cdr(pcpair) = number(pc); 151 | } else error(PSTR("illegal entry"), arg); 152 | } 153 | entries = cdr(entries); 154 | } 155 | // Round up to multiple of 2 to give code size 156 | if (pc%2 != 0) pc = pc + 2 - pc%2; 157 | return pc; 158 | }"# 159 | 160 | #+(or arm riscv) 161 | #" 162 | int assemble (int pass, int origin, object *entries, object *env, object *pcpair) { 163 | int pc = 0; cdr(pcpair) = number(pc); 164 | while (entries != NULL) { 165 | object *arg = first(entries); 166 | if (symbolp(arg)) { 167 | if (pass == 2) { 168 | #if defined(assemblerlist) 169 | printhex4(pc, pserial); 170 | indent(5, ' ', pserial); 171 | printobject(arg, pserial); pln(pserial); 172 | #endif 173 | } else { 174 | object *pair = findvalue(arg, env); 175 | cdr(pair) = number(pc); 176 | } 177 | } else { 178 | object *argval = eval(arg, env); 179 | if (listp(argval)) { 180 | object *arglist = argval; 181 | while (arglist != NULL) { 182 | if (pass == 2) { 183 | putcode(first(arglist), origin, pc); 184 | #if defined(assemblerlist) 185 | if (arglist == argval) superprint(arg, 0, pserial); 186 | pln(pserial); 187 | #endif 188 | } 189 | pc = pc + 2; 190 | cdr(pcpair) = number(pc); 191 | arglist = cdr(arglist); 192 | } 193 | } else if (integerp(argval)) { 194 | if (pass == 2) { 195 | putcode(argval, origin, pc); 196 | #if defined(assemblerlist) 197 | superprint(arg, 0, pserial); pln(pserial); 198 | #endif 199 | } 200 | pc = pc + 2; 201 | cdr(pcpair) = number(pc); 202 | } else error(PSTR("illegal entry"), arg); 203 | } 204 | entries = cdr(entries); 205 | } 206 | // Round up to multiple of 4 to give code size 207 | if (pc%4 != 0) pc = pc + 4 - pc%4; 208 | return pc; 209 | }"#)) 210 | -------------------------------------------------------------------------------- /avr-nano.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | ; AVR 6 | 7 | (defparameter *title-avr-nano* 8 | #"/* uLisp AVR-Nano Release ~a - www.ulisp.com 9 | David Johnson-Davies - www.technoblogy.com - ~a 10 | 11 | Licensed under the MIT license: https://opensource.org/licenses/MIT 12 | */"#) 13 | 14 | (defparameter *header-avr-nano* #" 15 | // Lisp Library 16 | const char LispLibrary[] PROGMEM = ""; 17 | 18 | // Compile options 19 | 20 | #define checkoverflow 21 | // #define resetautorun 22 | #define printfreespace 23 | // #define printgcs 24 | // #define sdcardsupport 25 | // #define lisplibrary 26 | #define assemblerlist 27 | // #define lineeditor 28 | // #define vt100 29 | 30 | // Includes 31 | 32 | // #include "LispLibrary.h" 33 | #include 34 | #include 35 | #include 36 | #include 37 | #include 38 | 39 | #if defined(sdcardsupport) 40 | #include 41 | #define SDSIZE 172 42 | #else 43 | #define SDSIZE 0 44 | #endif"#) 45 | 46 | (defparameter *workspace-avr-nano* #" 47 | // Platform specific settings 48 | 49 | #define WORDALIGNED __attribute__((aligned (2))) 50 | #define OBJECTALIGNED __attribute__((aligned (4))) 51 | #define BUFFERSIZE 22 /* longest builtin name + 1 */ 52 | 53 | #if defined(ARDUINO_AVR_UNO) 54 | #define WORKSPACESIZE (320-SDSIZE) /* Objects (4*bytes) */ 55 | #define EEPROMSIZE 1024 /* Bytes */ 56 | #define STACKDIFF 1 57 | #define CPU_ATmega328P 58 | 59 | #elif defined(ARDUINO_AVR_NANO_EVERY) 60 | #define WORKSPACESIZE (1060-SDSIZE) /* Objects (4*bytes) */ 61 | #define EEPROMSIZE 256 /* Bytes */ 62 | #define STACKDIFF 160 63 | #define CPU_ATmega4809 64 | 65 | #elif defined(ARDUINO_AVR_ATmega4809) /* Curiosity Nano using MegaCoreX */ 66 | #define Serial Serial3 67 | #define WORKSPACESIZE (1065-SDSIZE) /* Objects (4*bytes) */ 68 | #define EEPROMSIZE 256 /* Bytes */ 69 | #define STACKDIFF 320 70 | #define CPU_ATmega4809 71 | 72 | #elif defined(ARDUINO_AVR_ATtiny3227) 73 | #define WORKSPACESIZE (514-SDSIZE) /* Objects (4*bytes) */ 74 | // #define EEPROMSIZE 256 /* Bytes */ 75 | #define STACKDIFF 1 76 | #define CPU_ATtiny3227 77 | 78 | #elif defined(__AVR_AVR64DD28__) 79 | #include 80 | #define WORKSPACESIZE (1440-SDSIZE) /* Objects (4*bytes) */ 81 | #define FLASHWRITESIZE 6144 /* Bytes */ 82 | #define STACKDIFF 1 83 | #define CPU_AVR64DD28 84 | 85 | #else 86 | #error "Board not supported!" 87 | #endif"#) 88 | 89 | (defparameter *watchdog-avr-nano* #" 90 | // Watchdog 91 | 92 | void watchdogenable (int interval) { 93 | int i = 5; 94 | while (interval) { interval = interval>>1; i++; } 95 | wdt_enable(i); 96 | } 97 | 98 | void watchdogreset () { 99 | wdt_reset(); 100 | }"#) 101 | 102 | 103 | (defparameter *check-pins-avr-nano* #" 104 | // Check pins - these are board-specific not processor-specific 105 | 106 | void checkanalogread (int pin) { 107 | #if defined(ARDUINO_AVR_UNO) 108 | if (!(pin>=0 && pin<=5)) error(invalidpin, number(pin)); 109 | #elif defined(ARDUINO_AVR_NANO_EVERY) 110 | if (!((pin>=14 && pin<=21))) error(invalidpin, number(pin)); 111 | #elif defined(ARDUINO_AVR_ATmega4809) /* MegaCoreX core */ 112 | if (!((pin>=22 && pin<=33) || (pin>=36 && pin<=39))) error(invalidpin, number(pin)); 113 | #elif defined(ARDUINO_AVR_ATtiny3227) 114 | if (!((pin>=0 && pin<=3) || (pin>=6 && pin<=7) || (pin>=10 && pin<=11) || pin==18)) error(invalidpin, number(pin)); 115 | #endif 116 | } 117 | 118 | void checkanalogwrite (int pin) { 119 | #if defined(ARDUINO_AVR_UNO) 120 | if (!(pin==3 || pin==5 || pin==6 || (pin>=9 && pin<=11))) error(invalidpin, number(pin)); 121 | #elif defined(ARDUINO_AVR_NANO_EVERY) 122 | if (!(pin==3 || pin==5 || pin==6 || pin==9 || pin==10)) error(invalidpin, number(pin)); 123 | #elif defined(ARDUINO_AVR_ATmega4809) /* MegaCoreX core */ 124 | if (!((pin>=16 && pin<=19) || (pin>=38 && pin<=39))) error(invalidpin, number(pin)); 125 | #elif defined(ARDUINO_AVR_ATtiny3227) 126 | if (!((pin>=0 && pin<=1) || (pin>=9 && pin<=11) || pin==20)) error(invalidpin, number(pin)); 127 | #endif 128 | }"#) 129 | 130 | (defparameter *note-avr-nano* #" 131 | // Note 132 | 133 | #if defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28) 134 | const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; 135 | #else 136 | const uint8_t scale[] PROGMEM = {239,226,213,201,190,179,169,160,151,142,134,127}; 137 | #endif 138 | 139 | void playnote (int pin, int note, int octave) { 140 | #if defined(CPU_ATmega328P) 141 | if (pin == 3) { 142 | DDRD = DDRD | 1<6) error(PSTR("octave out of range"), number(oct)); 151 | OCR2A = pgm_read_byte(&scale[note%12]) - 1; 152 | TCCR2B = 0<8) error(PSTR("octave out of range"), number(oct)); 158 | tone(pin, scale[note%12]>>prescaler); 159 | 160 | #elif defined(CPU_AVR64DD28) 161 | int oct = octave + note/12; 162 | int prescaler = 8 - oct; 163 | if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct)); 164 | tone(pin, pgm_read_word(&scale[note%12])>>prescaler); 165 | #endif 166 | } 167 | 168 | void nonote (int pin) { 169 | #if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28) 170 | noTone(pin); 171 | #else 172 | (void) pin; 173 | TCCR2B = 0< 0) { sleep(); secs--; } 213 | WDTCSR = 1< 35 | #include 36 | #include 37 | #include 38 | 39 | #if defined(sdcardsupport) 40 | #include 41 | #define SDSIZE 172 42 | #else 43 | #define SDSIZE 0 44 | #endif"#) 45 | 46 | (defparameter *workspace-avr* #" 47 | // Platform specific settings 48 | 49 | #define WORDALIGNED __attribute__((aligned (2))) 50 | #define OBJECTALIGNED __attribute__((aligned (4))) 51 | #define BUFFERSIZE 22 /* longest builtin name + 1 */ 52 | 53 | #if defined(ARDUINO_AVR_MEGA2560) 54 | #include 55 | #define WORKSPACESIZE (1344-SDSIZE) /* Objects (4*bytes) */ 56 | #define EEPROMSIZE 4096 /* Bytes */ 57 | #define STACKDIFF 320 58 | #define CPU_ATmega2560 59 | 60 | #elif defined(__AVR_ATmega1284P__) 61 | #include "optiboot.h" 62 | #define WORKSPACESIZE (2944-SDSIZE) /* Objects (4*bytes) */ 63 | // #define EEPROMSIZE 4096 /* Bytes */ 64 | #define FLASHWRITESIZE 16384 /* Bytes */ 65 | #define CODESIZE 96 /* Bytes <= 256 */ 66 | #define STACKDIFF 320 67 | #define CPU_ATmega1284P 68 | 69 | #elif defined(__AVR_AVR128DA48__) 70 | #include 71 | #define Serial Serial1 72 | #define WORKSPACESIZE (2920-SDSIZE) /* Objects (4*bytes) */ 73 | #define FLASHWRITESIZE 15872 /* Bytes */ 74 | #define CODESIZE 96 /* Bytes <= 512 */ 75 | #define STACKDIFF 320 76 | #define CPU_AVR128DX48 77 | #define LED_BUILTIN 20 78 | 79 | #elif defined(__AVR_AVR128DB48__) 80 | #include 81 | #define Serial Serial3 82 | #define WORKSPACESIZE (2920-SDSIZE) /* Objects (4*bytes) */ 83 | #define FLASHWRITESIZE 15872 /* Bytes */ 84 | #define CODESIZE 96 /* Bytes <= 512 */ 85 | #define STACKDIFF 320 86 | #define CPU_AVR128DX48 87 | #define LED_BUILTIN 20 88 | 89 | #else 90 | #error "Board not supported!" 91 | #endif"#) 92 | 93 | (defparameter *watchdog-avr* #" 94 | // Watchdog 95 | 96 | void watchdogenable (int interval) { 97 | int i = 5; 98 | while (interval) { interval = interval>>1; i++; } 99 | wdt_enable(i); 100 | } 101 | 102 | void watchdogreset () { 103 | wdt_reset(); 104 | }"#) 105 | 106 | 107 | (defparameter *check-pins-avr* #" 108 | // Check pins - these are board-specific not processor-specific 109 | 110 | void checkanalogread (int pin) { 111 | #if defined(ARDUINO_AVR_MEGA2560) 112 | if (!(pin>=0 && pin<=15)) error(invalidpin, number(pin)); 113 | #elif defined(__AVR_ATmega1284P__) 114 | if (!(pin>=0 && pin<=7)) error(invalidpin, number(pin)); 115 | #elif defined(__AVR_AVR128DA48__) 116 | if (!(pin>=22 && pin<=39)) error(invalidpin, number(pin)); 117 | #endif 118 | } 119 | 120 | void checkanalogwrite (int pin) { 121 | #if defined(ARDUINO_AVR_MEGA2560) 122 | if (!((pin>=2 && pin<=13) || (pin>=44 && pin<=46))) error(invalidpin, number(pin)); 123 | #elif defined(__AVR_ATmega1284P__) 124 | if (!(pin==3 || pin==4 || pin==6 || pin==7 || (pin>=12 && pin<=15))) error(invalidpin, number(pin)); 125 | #elif defined(__AVR_AVR128DA48__) 126 | if (!((pin>=4 && pin<=5) || (pin>=8 && pin<=19) || (pin>=38 && pin<=39))) error(invalidpin, number(pin)); 127 | #endif 128 | }"#) 129 | 130 | (defparameter *note-avr* #" 131 | // Note 132 | 133 | #if defined(CPU_AVR128DX48) 134 | const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; 135 | #else 136 | const uint8_t scale[] PROGMEM = {239,226,213,201,190,179,169,160,151,142,134,127}; 137 | #endif 138 | 139 | void playnote (int pin, int note, int octave) { 140 | #if defined(CPU_ATmega2560) 141 | if (pin == 9) { 142 | DDRH = DDRH | 1<6) error(PSTR("octave out of range"), number(oct)); 151 | OCR2A = pgm_read_byte(&scale[note%12]) - 1; 152 | TCCR2B = 0<6) error(PSTR("octave out of range"), number(oct)); 165 | OCR2A = pgm_read_byte(&scale[note%12]) - 1; 166 | TCCR2B = 0<8) error(PSTR("octave out of range"), number(oct)); 172 | tone(pin, pgm_read_word(&scale[note%12])>>prescaler); 173 | #endif 174 | } 175 | 176 | void nonote (int pin) { 177 | #if defined(CPU_AVR128DX48) 178 | noTone(pin); 179 | #else 180 | (void) pin; 181 | TCCR2B = 0< 0) { sleep(); secs--; } 217 | WDTCSR = 1< 34 | #include 35 | #include 36 | #include 37 | #include 38 | 39 | #if defined(gfxsupport) 40 | #define COLOR_WHITE ST77XX_WHITE 41 | #define COLOR_BLACK ST77XX_BLACK 42 | #include // Core graphics library 43 | #include // Hardware-specific library for ST7789 44 | #if defined(ARDUINO_ESP32_DEV) 45 | Adafruit_ST7789 tft = Adafruit_ST7789(5, 16, 19, 18); 46 | #define TFT_BACKLITE 4 47 | #else 48 | Adafruit_ST7789 tft = Adafruit_ST7789(TFT_CS, TFT_DC, MOSI, SCK, TFT_RST); 49 | #endif 50 | #endif 51 | 52 | #if defined(sdcardsupport) 53 | #include 54 | #define SDSIZE 172 55 | #else 56 | #define SDSIZE 0 57 | #endif"#) 58 | 59 | (defparameter *workspace-esp* #" 60 | // Platform specific settings 61 | 62 | #define WORDALIGNED __attribute__((aligned (4))) 63 | #define BUFFERSIZE 36 // Number of bits+4 64 | 65 | // ESP32 boards *************************************************************** 66 | 67 | #if defined(ARDUINO_ESP32_DEV) /* For TTGO T-Display etc. */ 68 | #if defined(BOARD_HAS_PSRAM) 69 | #define WORKSPACESIZE 260000 /* Objects (8*bytes) */ 70 | #else 71 | #define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */ 72 | #endif 73 | #define LITTLEFS 74 | #include 75 | #define analogWrite(x,y) dacWrite((x),(y)) 76 | #define SDCARD_SS_PIN 13 77 | #define LED_BUILTIN 13 78 | #define CPU_LX6 79 | 80 | #elif defined(ARDUINO_FEATHER_ESP32) 81 | #define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */ 82 | #define LITTLEFS 83 | #include 84 | #define analogWrite(x,y) dacWrite((x),(y)) 85 | #define SDCARD_SS_PIN 13 86 | #define CPU_LX6 87 | 88 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2) 89 | #if defined(BOARD_HAS_PSRAM) 90 | #define WORKSPACESIZE 250000 /* Objects (8*bytes) */ 91 | #else 92 | #define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */ 93 | #endif 94 | #define MAX_STACK 7000 95 | #define LITTLEFS 96 | #include 97 | #define analogWrite(x,y) dacWrite((x),(y)) 98 | #define SDCARD_SS_PIN 13 99 | #define CPU_LX6 100 | 101 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO) || defined(ARDUINO_ESP32_PICO) 102 | #if defined(BOARD_HAS_PSRAM) 103 | #define WORKSPACESIZE 250000 /* Objects (8*bytes) */ 104 | #else 105 | #define WORKSPACESIZE (9500-SDSIZE) /* Objects (8*bytes) */ 106 | #endif 107 | #define MAX_STACK 7000 108 | #define LITTLEFS 109 | #include 110 | #define SDCARD_SS_PIN 13 111 | #define LED_BUILTIN 13 112 | #define CPU_LX6 113 | 114 | // ESP32-S2 boards *************************************************************** 115 | 116 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT) 117 | #if defined(BOARD_HAS_PSRAM) 118 | #define WORKSPACESIZE 250000 /* Objects (8*bytes) */ 119 | #else 120 | #define WORKSPACESIZE (6500-SDSIZE) /* Objects (8*bytes) */ 121 | #endif 122 | #define MAX_STACK 7000 123 | #define LITTLEFS 124 | #include 125 | #define analogWrite(x,y) dacWrite((x),(y)) 126 | #define SDCARD_SS_PIN 13 127 | #define CPU_LX7 128 | 129 | #elif defined(ARDUINO_FEATHERS2) /* UM FeatherS2 */ 130 | #if defined(BOARD_HAS_PSRAM) 131 | #define WORKSPACESIZE 1000000 /* Objects (8*bytes) */ 132 | #else 133 | #define WORKSPACESIZE (8160-SDSIZE) /* Objects (8*bytes) */ 134 | #endif 135 | #define MAX_STACK 7000 136 | #define LITTLEFS 137 | #include 138 | #define analogWrite(x,y) dacWrite((x),(y)) 139 | #define SDCARD_SS_PIN 13 140 | #define LED_BUILTIN 13 141 | #define CPU_LX7 142 | 143 | #elif defined(ARDUINO_ESP32S2_DEV) 144 | #if defined(BOARD_HAS_PSRAM) 145 | #define WORKSPACESIZE 260000 /* Objects (8*bytes) */ 146 | #else 147 | #define WORKSPACESIZE (8160-SDSIZE) /* Objects (8*bytes) */ 148 | #endif 149 | #define MAX_STACK 7000 150 | #define LITTLEFS 151 | #include 152 | #define analogWrite(x,y) dacWrite((x),(y)) 153 | #define SDCARD_SS_PIN 13 154 | #define LED_BUILTIN 13 155 | #define CPU_LX7 156 | 157 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2) 158 | #if defined(BOARD_HAS_PSRAM) 159 | #define WORKSPACESIZE 260000 /* Objects (8*bytes) */ 160 | #else 161 | #define WORKSPACESIZE (7232-SDSIZE) /* Objects (8*bytes) */ 162 | #endif 163 | #define MAX_STACK 7000 164 | #define LITTLEFS 165 | #include 166 | #define analogWrite(x,y) dacWrite((x),(y)) 167 | #define SDCARD_SS_PIN 13 168 | #define LED_BUILTIN 13 169 | #define CPU_LX7 170 | 171 | // ESP32-S3 boards *************************************************************** 172 | 173 | #elif defined(ARDUINO_ESP32S3_DEV) 174 | #define WORKSPACESIZE (25000-SDSIZE) /* Objects (8*bytes) */ 175 | #define MAX_STACK 6500 176 | #define LITTLEFS 177 | #include 178 | #define SDCARD_SS_PIN 13 179 | #define LED_BUILTIN 13 180 | #define CPU_LX7 181 | 182 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S3_TFT) 183 | #if defined(BOARD_HAS_PSRAM) 184 | #define WORKSPACESIZE 250000 /* Objects (8*bytes) */ 185 | #else 186 | #define WORKSPACESIZE (22000-SDSIZE) /* Objects (8*bytes) */ 187 | #endif 188 | #define MAX_STACK 7000 189 | #define LITTLEFS 190 | #include 191 | #define SDCARD_SS_PIN 13 192 | #define LED_BUILTIN 13 193 | #define CPU_LX7 194 | 195 | // ESP32-C3 boards *************************************************************** 196 | 197 | #elif defined(ARDUINO_ESP32C3_DEV) 198 | #define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */ 199 | #define MAX_STACK 7500 200 | #define LITTLEFS 201 | #include 202 | #define SDCARD_SS_PIN 13 203 | #define LED_BUILTIN 13 204 | #define CPU_RISC_V 205 | 206 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3) 207 | #define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */ 208 | #define MAX_STACK 8000 209 | #define LITTLEFS 210 | #include 211 | #define SDCARD_SS_PIN 13 212 | #define LED_BUILTIN 13 213 | #define CPU_RISC_V 214 | 215 | // Legacy boards *************************************************************** 216 | 217 | #elif defined(ESP32) /* Generic ESP32 board */ 218 | #define WORKSPACESIZE (9216-SDSIZE) /* Objects (8*bytes) */ 219 | #define MAX_STACK 7000 220 | #define LITTLEFS 221 | #include 222 | #define analogWrite(x,y) dacWrite((x),(y)) 223 | #define SDCARD_SS_PIN 13 224 | #define LED_BUILTIN 13 225 | #define CPU_LX6 226 | 227 | #else 228 | #error "Board not supported!" 229 | #endif"#) 230 | 231 | (defparameter *check-pins-esp* #" 232 | // Check pins 233 | 234 | void checkanalogread (int pin) { 235 | #if defined(ESP32) || defined(ARDUINO_ESP32_DEV) 236 | if (!(pin==0 || pin==2 || pin==4 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=36) || pin==39)) 237 | error("invalid pin", number(pin)); 238 | #elif defined(ARDUINO_FEATHER_ESP32) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2) 239 | if (!(pin==4 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=36) || pin==39)) error("invalid pin", number(pin)); 240 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT) 241 | if (!(pin==8 || (pin>=14 && pin<=18))) error("invalid pin", number(pin)); 242 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO) 243 | if (!(pin==4 || pin==7 || (pin>=12 && pin<=15) || (pin>=25 && pin<=27) || (pin>=32 && pin<=33))) error("invalid pin", number(pin)); 244 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2) 245 | if (!((pin>=5 && pin<=9) || (pin>=16 && pin<=18))) error("invalid pin", number(pin)); 246 | #elif defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3) 247 | if (!((pin>=0 && pin<=1) || (pin>=3 && pin<=5))) error("invalid pin", number(pin)); 248 | #elif defined(ARDUINO_FEATHERS2) || defined(ARDUINO_ESP32S2_DEV) 249 | if (!((pin>=1 && pin<=20))) error("invalid pin", number(pin)); 250 | #elif defined(ARDUINO_ESP32C3_DEV) 251 | if (!((pin>=0 && pin<=5))) error("invalid pin", number(pin)); 252 | #elif defined(ARDUINO_ESP32S3_DEV) 253 | if (!((pin>=1 && pin<=20))) error("invalid pin", number(pin)); 254 | #endif 255 | } 256 | 257 | void checkanalogwrite (int pin) { 258 | #if defined(ESP32) || defined(ARDUINO_FEATHER_ESP32) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32_V2) || defined(ARDUINO_ESP32_DEV) \ 259 | || defined(ARDUINO_ADAFRUIT_QTPY_ESP32_PICO) 260 | if (!(pin>=25 && pin<=26)) error("invalid pin", number(pin)); 261 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2) || defined(ARDUINO_ADAFRUIT_FEATHER_ESP32S2_TFT) || defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2) \ 262 | || defined(ARDUINO_FEATHERS2) || defined(ARDUINO_ESP32S2_DEV) 263 | if (!(pin>=17 && pin<=18)) error("invalid pin", number(pin)); 264 | #elif defined(ARDUINO_ESP32C3_DEV) || defined(ARDUINO_ESP32S3_DEV) || defined(ARDUINO_ADAFRUIT_QTPY_ESP32C3) 265 | error2(ANALOGWRITE, "not supported"); 266 | #endif 267 | }"#) 268 | 269 | 270 | (defparameter *note-esp* #" 271 | // Note 272 | 273 | void tone (int pin, int note) { 274 | (void) pin, (void) note; 275 | } 276 | 277 | void noTone (int pin) { 278 | (void) pin; 279 | } 280 | 281 | const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; 282 | 283 | void playnote (int pin, int note, int octave) { 284 | int oct = octave + note/12; 285 | int prescaler = 8 - oct; 286 | if (prescaler<0 || prescaler>8) error(PSTR("octave out of range"), number(oct)); 287 | tone(pin, scale[note%12]>>prescaler); 288 | } 289 | 290 | void nonote (int pin) { 291 | noTone(pin); 292 | }"#) 293 | 294 | (defparameter *sleep-esp* #" 295 | // Sleep 296 | 297 | void initsleep () { } 298 | 299 | void doze (int secs) { 300 | delay(1000 * secs); 301 | }"#) 302 | 303 | (defparameter *keywords-esp* 304 | '((nil 305 | ((NIL LED_BUILTIN) 306 | (DIGITALWRITE HIGH LOW) 307 | (PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT))))) -------------------------------------------------------------------------------- /preface.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | (defparameter *macros* '( 6 | 7 | #+avr-nano 8 | #" 9 | // C Macros 10 | 11 | #define nil NULL 12 | #define car(x) (((object *) (x))->car) 13 | #define cdr(x) (((object *) (x))->cdr) 14 | 15 | #define first(x) car(x) 16 | #define rest(x) cdr(x) 17 | #define second(x) first(rest(x)) 18 | #define cddr(x) cdr(cdr(x)) 19 | #define third(x) first(cddr(x)) 20 | 21 | #define push(x, y) ((y) = cons((x),(y))) 22 | #define pop(y) ((y) = cdr(y)) 23 | 24 | #define protect(y) push((y), GCStack) 25 | #define unprotect() pop(GCStack) 26 | 27 | #define integerp(x) ((x) != NULL && (x)->type == NUMBER) 28 | #define symbolp(x) ((x) != NULL && (x)->type == SYMBOL) 29 | #define stringp(x) ((x) != NULL && (x)->type == STRING) 30 | #define characterp(x) ((x) != NULL && (x)->type == CHARACTER) 31 | #define streamp(x) ((x) != NULL && (x)->type == STREAM) 32 | 33 | #define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT)) 34 | #define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT)) 35 | #define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0) 36 | #define MARKBIT 1 37 | 38 | #define setflag(x) (Flags = Flags | 1<<(x)) 39 | #define clrflag(x) (Flags = Flags & ~(1<<(x))) 40 | #define tstflag(x) (Flags & 1<<(x)) 41 | 42 | #define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t') 43 | #define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'') 44 | #define fntype(x) (getminmax((uint16_t)(x))>>6) 45 | #define longsymbolp(x) (((x)->name & 0x03) == 0) 46 | #define longnamep(x) (((x) & 0x03) == 0) 47 | #define twist(x) ((uint16_t)((x)<<2) | (((x) & 0xC000)>>14)) 48 | #define untwist(x) (((x)>>2 & 0x3FFF) | ((x) & 0x03)<<14) 49 | #define arraysize(x) (sizeof(x) / sizeof(x[0])) 50 | #define stringifyX(x) #x 51 | #define stringify(x) stringifyX(x) 52 | #define PACKEDS 17600 53 | #define BUILTINS 64000 54 | #define ENDFUNCTIONS 1536 55 | 56 | #define SDCARD_SS_PIN 10 57 | 58 | #if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) 59 | #define PROGMEM 60 | #define PSTR(s) (s) 61 | #endif"# 62 | 63 | #+avr 64 | #" 65 | // C Macros 66 | 67 | #define nil NULL 68 | #define car(x) (((object *) (x))->car) 69 | #define cdr(x) (((object *) (x))->cdr) 70 | 71 | #define first(x) car(x) 72 | #define rest(x) cdr(x) 73 | #define second(x) first(rest(x)) 74 | #define cddr(x) cdr(cdr(x)) 75 | #define third(x) first(cddr(x)) 76 | 77 | #define push(x, y) ((y) = cons((x),(y))) 78 | #define pop(y) ((y) = cdr(y)) 79 | 80 | #define protect(y) push((y), GCStack) 81 | #define unprotect() pop(GCStack) 82 | 83 | #define integerp(x) ((x) != NULL && (x)->type == NUMBER) 84 | #define symbolp(x) ((x) != NULL && (x)->type == SYMBOL) 85 | #define stringp(x) ((x) != NULL && (x)->type == STRING) 86 | #define characterp(x) ((x) != NULL && (x)->type == CHARACTER) 87 | #define arrayp(x) ((x) != NULL && (x)->type == ARRAY) 88 | #define streamp(x) ((x) != NULL && (x)->type == STREAM) 89 | 90 | #define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT)) 91 | #define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT)) 92 | #define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0) 93 | #define MARKBIT 1 94 | 95 | #define setflag(x) (Flags = Flags | 1<<(x)) 96 | #define clrflag(x) (Flags = Flags & ~(1<<(x))) 97 | #define tstflag(x) (Flags & 1<<(x)) 98 | 99 | #define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t') 100 | #define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'') 101 | #define fntype(x) (getminmax((uint16_t)(x))>>6) 102 | #define longsymbolp(x) (((x)->name & 0x03) == 0) 103 | #define longnamep(x) (((x) & 0x03) == 0) 104 | #define twist(x) ((uint16_t)((x)<<2) | (((x) & 0xC000)>>14)) 105 | #define untwist(x) (((x)>>2 & 0x3FFF) | ((x) & 0x03)<<14) 106 | #define arraysize(x) (sizeof(x) / sizeof(x[0])) 107 | #define stringifyX(x) #x 108 | #define stringify(x) stringifyX(x) 109 | #define PACKEDS 17600 110 | #define BUILTINS 64000 111 | #define ENDFUNCTIONS 1536 112 | 113 | // Code marker stores start and end of code block (max 256 bytes) 114 | #define startblock(x) ((x->integer) & 0xFF) 115 | #define endblock(x) ((x->integer) >> 8 & 0xFF) 116 | 117 | #define SDCARD_SS_PIN 10"# 118 | 119 | #+(or arm riscv esp) 120 | #" 121 | // C Macros 122 | 123 | #define nil NULL 124 | #define car(x) (((object *) (x))->car) 125 | #define cdr(x) (((object *) (x))->cdr) 126 | 127 | #define first(x) car(x) 128 | #define rest(x) cdr(x) 129 | #define second(x) first(rest(x)) 130 | #define cddr(x) cdr(cdr(x)) 131 | #define third(x) first(cddr(x)) 132 | 133 | #define push(x, y) ((y) = cons((x),(y))) 134 | #define pop(y) ((y) = cdr(y)) 135 | 136 | #define protect(y) push((y), GCStack) 137 | #define unprotect() pop(GCStack) 138 | 139 | #define integerp(x) ((x) != NULL && (x)->type == NUMBER) 140 | #define floatp(x) ((x) != NULL && (x)->type == FLOAT) 141 | #define symbolp(x) ((x) != NULL && (x)->type == SYMBOL) 142 | #define stringp(x) ((x) != NULL && (x)->type == STRING) 143 | #define characterp(x) ((x) != NULL && (x)->type == CHARACTER) 144 | #define arrayp(x) ((x) != NULL && (x)->type == ARRAY) 145 | #define streamp(x) ((x) != NULL && (x)->type == STREAM) 146 | 147 | #define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT)) 148 | #define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT)) 149 | #define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0) 150 | #define MARKBIT 1 151 | 152 | #define setflag(x) (Flags = Flags | 1<<(x)) 153 | #define clrflag(x) (Flags = Flags & ~(1<<(x))) 154 | #define tstflag(x) (Flags & 1<<(x)) 155 | 156 | #define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t') 157 | #define isbr(x) (x == ')' || x == '(' || x == '"' || x == '#' || x == '\'') 158 | #define fntype(x) (getminmax((uint16_t)(x))>>6) 159 | #define longsymbolp(x) (((x)->name & 0x03) == 0) 160 | #define longnamep(x) (((x) & 0x03) == 0) 161 | #define twist(x) ((uint32_t)((x)<<2) | (((x) & 0xC0000000)>>30)) 162 | #define untwist(x) (((x)>>2 & 0x3FFFFFFF) | ((x) & 0x03)<<30) 163 | #define arraysize(x) (sizeof(x) / sizeof(x[0])) 164 | #define stringifyX(x) #x 165 | #define stringify(x) stringifyX(x) 166 | #define PACKEDS 0x43238000 167 | #define BUILTINS 0xF4240000 168 | #define ENDFUNCTIONS 0x0BDC0000"# 169 | 170 | #+(or arm riscv) 171 | #" 172 | // Code marker stores start and end of code block 173 | #define startblock(x) ((x->integer) & 0xFFFF) 174 | #define endblock(x) ((x->integer) >> 16 & 0xFFFF)"#)) 175 | 176 | (defparameter *constants* 177 | '( 178 | #+avr-nano 179 | #" 180 | // Constants 181 | 182 | const int TRACEMAX = 3; // Number of traced functions 183 | enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, STRING=12, PAIR=14 }; // STRING and PAIR must be last 184 | enum token { UNUSED, BRA, KET, QUO, DOT }; 185 | enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM }; 186 | enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS }; 187 | 188 | // Stream names used by printobject 189 | const char serialstream[] PROGMEM = "serial"; 190 | const char i2cstream[] PROGMEM = "i2c"; 191 | const char spistream[] PROGMEM = "spi"; 192 | const char sdstream[] PROGMEM = "sd"; 193 | const char stringstream[] PROGMEM = "string"; 194 | PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream};"# 195 | 196 | #+avr 197 | #" 198 | // Constants 199 | 200 | #define TRACEMAX 3 // Maximum number of traced functions 201 | 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 202 | enum token { UNUSED, BRA, KET, QUO, DOT }; 203 | enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM }; 204 | enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS }; 205 | 206 | // Stream names used by printobject 207 | const char serialstream[] PROGMEM = "serial"; 208 | const char i2cstream[] PROGMEM = "i2c"; 209 | const char spistream[] PROGMEM = "spi"; 210 | const char sdstream[] PROGMEM = "sd"; 211 | const char stringstream[] PROGMEM = "string"; 212 | PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream};"# 213 | 214 | #+arm 215 | #" 216 | // Constants 217 | 218 | #define TRACEMAX 3 // Maximum number of traced functions 219 | 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 220 | enum token { UNUSED, BRA, KET, QUO, DOT }; 221 | enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, WIFISTREAM, STRINGSTREAM, GFXSTREAM }; 222 | enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS }; 223 | 224 | // Stream names used by printobject 225 | const char serialstream[] PROGMEM = "serial"; 226 | const char i2cstream[] PROGMEM = "i2c"; 227 | const char spistream[] PROGMEM = "spi"; 228 | const char sdstream[] PROGMEM = "sd"; 229 | const char wifistream[] PROGMEM = "wifi"; 230 | const char stringstream[] PROGMEM = "string"; 231 | const char gfxstream[] PROGMEM = "gfx"; 232 | const char *const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, wifistream, stringstream, gfxstream};"# 233 | 234 | #+esp 235 | #" 236 | // Constants 237 | 238 | #define TRACEMAX 3 // Maximum number of traced functions 239 | 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 240 | enum token { UNUSED, BRA, KET, QUO, DOT }; 241 | enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, WIFISTREAM, STRINGSTREAM, GFXSTREAM }; 242 | enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS }; 243 | 244 | // Stream names used by printobject 245 | const char serialstream[] PROGMEM = "serial"; 246 | const char i2cstream[] PROGMEM = "i2c"; 247 | const char spistream[] PROGMEM = "spi"; 248 | const char sdstream[] PROGMEM = "sd"; 249 | const char wifistream[] PROGMEM = "wifi"; 250 | const char stringstream[] PROGMEM = "string"; 251 | const char gfxstream[] PROGMEM = "gfx"; 252 | PGM_P const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, wifistream, stringstream, gfxstream};"# 253 | 254 | #+riscv 255 | #" 256 | // Constants 257 | 258 | #define TRACEMAX 3 // Maximum number of traced functions 259 | 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 260 | enum token { UNUSED, BRA, KET, QUO, DOT }; 261 | enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM, GFXSTREAM }; 262 | enum fntypes_t { OTHER_FORMS, TAIL_FORMS, FUNCTIONS, SPECIAL_FORMS }; 263 | 264 | // Stream names used by printobject 265 | const char serialstream[] PROGMEM = "serial"; 266 | const char i2cstream[] PROGMEM = "i2c"; 267 | const char spistream[] PROGMEM = "spi"; 268 | const char sdstream[] PROGMEM = "sd"; 269 | const char stringstream[] PROGMEM = "string"; 270 | const char gfxstream[] PROGMEM = "gfx"; 271 | const char *const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream, gfxstream};"#)) 272 | 273 | #+avr-nano 274 | (defparameter *typedefs* #" 275 | // Typedefs 276 | 277 | typedef uint16_t symbol_t; 278 | typedef uint16_t builtin_t; 279 | typedef uint16_t chars_t; 280 | 281 | typedef struct sobject { 282 | union { 283 | struct { 284 | sobject *car; 285 | sobject *cdr; 286 | }; 287 | struct { 288 | unsigned int type; 289 | union { 290 | symbol_t name; 291 | int integer; 292 | chars_t chars; // For strings 293 | }; 294 | }; 295 | }; 296 | } object; 297 | 298 | typedef object *(*fn_ptr_type)(object *, object *); 299 | typedef void (*mapfun_t)(object *, object **); 300 | typedef int (*intfn_ptr_type)(int w, int x, int y, int z); 301 | 302 | typedef const struct { 303 | const char *string; 304 | fn_ptr_type fptr; 305 | uint8_t minmax; 306 | } tbl_entry_t; 307 | 308 | typedef int (*gfun_t)(); 309 | typedef void (*pfun_t)(char);"#) 310 | 311 | #+avr 312 | (defparameter *typedefs* #" 313 | // Typedefs 314 | 315 | typedef uint16_t symbol_t; 316 | typedef uint16_t builtin_t; 317 | typedef uint16_t chars_t; 318 | 319 | typedef struct sobject { 320 | union { 321 | struct { 322 | sobject *car; 323 | sobject *cdr; 324 | }; 325 | struct { 326 | unsigned int type; 327 | union { 328 | symbol_t name; 329 | int integer; 330 | chars_t chars; // For strings 331 | }; 332 | }; 333 | }; 334 | } object; 335 | 336 | typedef object *(*fn_ptr_type)(object *, object *); 337 | typedef void (*mapfun_t)(object *, object **); 338 | typedef int (*intfn_ptr_type)(int w, int x, int y, int z); 339 | 340 | typedef const struct { 341 | const char *string; 342 | fn_ptr_type fptr; 343 | uint8_t minmax; 344 | const char *doc; 345 | } tbl_entry_t; 346 | 347 | typedef int (*gfun_t)(); 348 | typedef void (*pfun_t)(char);"#) 349 | 350 | #+msp430 351 | (defparameter *typedefs* #" 352 | // Typedefs 353 | 354 | typedef unsigned int symbol_t; 355 | 356 | typedef struct sobject { 357 | union { 358 | struct { 359 | sobject *car; 360 | sobject *cdr; 361 | }; 362 | struct { 363 | unsigned int type; 364 | union { 365 | symbol_t name; 366 | int integer; 367 | int chars; // For strings 368 | }; 369 | }; 370 | }; 371 | } object; 372 | 373 | typedef object *(*fn_ptr_type)(object *, object *); 374 | typedef void (*mapfun_t)(object *, object **); 375 | 376 | typedef const struct { 377 | PGM_P string; 378 | fn_ptr_type fptr; 379 | uint8_t funtype: 2; 380 | uint8_t minargs: 3; 381 | uint8_t maxargs: 3; 382 | const char *doc; 383 | } tbl_entry_t; 384 | 385 | typedef int (*gfun_t)(); 386 | typedef void (*pfun_t)(char); 387 | 388 | typedef uint16_t builtin_t;"#) 389 | 390 | #+arm 391 | (defparameter *typedefs* #" 392 | // Typedefs 393 | 394 | typedef uint32_t symbol_t; 395 | typedef uint32_t builtin_t; 396 | typedef uint32_t chars_t; 397 | 398 | typedef struct sobject { 399 | union { 400 | struct { 401 | sobject *car; 402 | sobject *cdr; 403 | }; 404 | struct { 405 | unsigned int type; 406 | union { 407 | symbol_t name; 408 | int integer; 409 | chars_t chars; // For strings 410 | float single_float; 411 | }; 412 | }; 413 | }; 414 | } object; 415 | 416 | typedef object *(*fn_ptr_type)(object *, object *); 417 | typedef void (*mapfun_t)(object *, object **); 418 | typedef int (*intfn_ptr_type)(int w, int x, int y, int z); 419 | 420 | typedef const struct { 421 | const char *string; 422 | fn_ptr_type fptr; 423 | uint8_t minmax; 424 | const char *doc; 425 | } tbl_entry_t; 426 | 427 | typedef int (*gfun_t)(); 428 | typedef void (*pfun_t)(char);"#) 429 | 430 | #+riscv 431 | (defparameter *typedefs* #" 432 | // Typedefs 433 | 434 | typedef uint32_t symbol_t; 435 | typedef uint32_t builtin_t; 436 | typedef uint32_t chars_t; 437 | 438 | typedef struct sobject { 439 | union { 440 | struct { 441 | sobject *car; 442 | sobject *cdr; 443 | }; 444 | struct { 445 | uintptr_t type; 446 | union { 447 | symbol_t name; 448 | int integer; 449 | chars_t chars; // For strings 450 | float single_float; 451 | }; 452 | }; 453 | }; 454 | } object; 455 | 456 | typedef object *(*fn_ptr_type)(object *, object *); 457 | typedef void (*mapfun_t)(object *, object **); 458 | typedef int (*intfn_ptr_type)(int w, int x, int y, int z); 459 | 460 | typedef const struct { 461 | const char *string; 462 | fn_ptr_type fptr; 463 | uint8_t minmax; 464 | const char *doc; 465 | } tbl_entry_t; 466 | 467 | typedef int (*gfun_t)(); 468 | typedef void (*pfun_t)(char); 469 | typedef int PinMode;"#) 470 | 471 | #+esp 472 | (defparameter *typedefs* #" 473 | // Typedefs 474 | 475 | typedef uint32_t symbol_t; 476 | typedef uint32_t builtin_t; 477 | typedef uint32_t chars_t; 478 | 479 | typedef struct sobject { 480 | union { 481 | struct { 482 | sobject *car; 483 | sobject *cdr; 484 | }; 485 | struct { 486 | unsigned int type; 487 | union { 488 | symbol_t name; 489 | int integer; 490 | chars_t chars; // For strings 491 | float single_float; 492 | }; 493 | }; 494 | }; 495 | } object; 496 | 497 | typedef object *(*fn_ptr_type)(object *, object *); 498 | typedef void (*mapfun_t)(object *, object **); 499 | 500 | typedef const struct { 501 | PGM_P string; 502 | fn_ptr_type fptr; 503 | uint8_t minmax; 504 | const char *doc; 505 | } tbl_entry_t; 506 | 507 | typedef int (*gfun_t)(); 508 | typedef void (*pfun_t)(char);"#) 509 | 510 | (defparameter *global-variables* 511 | '( 512 | 513 | #+avr-nano 514 | #" 515 | // Global variables 516 | 517 | uint8_t FLAG __attribute__ ((section (".noinit"))); 518 | 519 | object Workspace[WORKSPACESIZE] OBJECTALIGNED;"# 520 | 521 | #+avr 522 | #" 523 | // Global variables 524 | 525 | uint8_t FLAG __attribute__ ((section (".noinit"))); 526 | 527 | object Workspace[WORKSPACESIZE] OBJECTALIGNED; 528 | #if defined(CODESIZE) 529 | uint8_t MyCode[CODESIZE] WORDALIGNED; // Must be even 530 | #endif"# 531 | 532 | 533 | #+arm 534 | #" 535 | // Global variables 536 | 537 | object Workspace[WORKSPACESIZE] WORDALIGNED MEMBANK; 538 | #if defined(CODESIZE) 539 | RAMFUNC uint8_t MyCode[CODESIZE] WORDALIGNED; 540 | #endif"# 541 | 542 | #+esp 543 | #" 544 | // Global variables 545 | 546 | #if defined(BOARD_HAS_PSRAM) 547 | object *Workspace WORDALIGNED; 548 | #else 549 | object Workspace[WORKSPACESIZE] WORDALIGNED; 550 | #endif"# 551 | 552 | #+riscv 553 | #" 554 | // Global variables 555 | 556 | #if (WORKSPACESIZE > 80000) 557 | object *Workspace WORDALIGNED; 558 | #else 559 | object Workspace[WORKSPACESIZE] WORDALIGNED; 560 | #endif 561 | uint8_t MyCode[CODESIZE] WORDALIGNED;"# 562 | 563 | #+avr-nano 564 | #" 565 | jmp_buf exception; 566 | unsigned int Freespace = 0; 567 | object *Freelist; 568 | unsigned int I2Ccount; 569 | unsigned int TraceFn[TRACEMAX]; 570 | unsigned int TraceDepth[TRACEMAX]; 571 | builtin_t Context; 572 | 573 | object *GlobalEnv; 574 | object *GCStack = NULL; 575 | object *GlobalString; 576 | object *GlobalStringTail; 577 | int GlobalStringIndex = 0; 578 | uint8_t PrintCount = 0; 579 | uint8_t BreakLevel = 0; 580 | char LastChar = 0; 581 | char LastPrint = 0; 582 | uint16_t RandomSeed;"# 583 | 584 | #+avr 585 | #" 586 | jmp_buf toplevel_handler; 587 | jmp_buf *handler = &toplevel_handler; 588 | unsigned int Freespace = 0; 589 | object *Freelist; 590 | unsigned int I2Ccount; 591 | unsigned int TraceFn[TRACEMAX]; 592 | unsigned int TraceDepth[TRACEMAX]; 593 | builtin_t Context; 594 | #define BACKTRACESIZE 8 595 | uint8_t TraceStart = 0, TraceTop = 0; 596 | symbol_t Backtrace[BACKTRACESIZE]; 597 | 598 | object *GlobalEnv; 599 | object *GCStack = NULL; 600 | object *GlobalString; 601 | object *GlobalStringTail; 602 | int GlobalStringIndex = 0; 603 | uint8_t PrintCount = 0; 604 | uint8_t BreakLevel = 0; 605 | char LastChar = 0; 606 | char LastPrint = 0; 607 | uint16_t RandomSeed;"# 608 | 609 | #+(or arm riscv) 610 | #" 611 | jmp_buf toplevel_handler; 612 | jmp_buf *handler = &toplevel_handler; 613 | unsigned int Freespace = 0; 614 | object *Freelist; 615 | unsigned int I2Ccount; 616 | unsigned int TraceFn[TRACEMAX]; 617 | unsigned int TraceDepth[TRACEMAX]; 618 | builtin_t Context; 619 | #define BACKTRACESIZE 8 620 | uint8_t TraceStart = 0, TraceTop = 0; 621 | symbol_t Backtrace[BACKTRACESIZE]; 622 | 623 | object *GlobalEnv; 624 | object *GCStack = NULL; 625 | object *GlobalString; 626 | object *GlobalStringTail; 627 | int GlobalStringIndex = 0; 628 | uint8_t PrintCount = 0; 629 | uint8_t BreakLevel = 0; 630 | char LastChar = 0; 631 | char LastPrint = 0;"# 632 | 633 | #+esp 634 | #" 635 | jmp_buf toplevel_handler; 636 | jmp_buf *handler = &toplevel_handler; 637 | unsigned int Freespace = 0; 638 | object *Freelist; 639 | unsigned int I2Ccount; 640 | unsigned int TraceFn[TRACEMAX]; 641 | unsigned int TraceDepth[TRACEMAX]; 642 | builtin_t Context; 643 | #define BACKTRACESIZE 8 644 | uint8_t TraceStart = 0, TraceTop = 0; 645 | symbol_t Backtrace[BACKTRACESIZE]; 646 | 647 | object *GlobalEnv; 648 | object *GCStack = NULL; 649 | object *GlobalString; 650 | object *GlobalStringTail; 651 | int GlobalStringIndex = 0; 652 | uint8_t PrintCount = 0; 653 | uint8_t BreakLevel = 0; 654 | char LastChar = 0; 655 | char LastPrint = 0; 656 | void* StackBottom;"# 657 | 658 | 659 | #-errors 660 | #" 661 | // Flags 662 | enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED, NOESC, NOECHO, BACKTRACE }; 663 | typedef uint8_t flags_t; 664 | volatile flags_t Flags = 1< 4 3 2 1)) 140 | (aeq '< nil (> 4 2 2 1)) 141 | (aeq '< t (>= 4 2 2 1)) 142 | (aeq '< nil (>= 4 2 3 1)) 143 | (aeq '< t (< 1)) 144 | (aeq '< nil (< 1 3 2)) 145 | (aeq '< nil (< -1 -2)) 146 | (aeq '< nil (< 10 10)) 147 | (aeq '<= t (<= 10 10)) 148 | (aeq '= t (= 32767 32767)) 149 | (aeq '>= t (>= 10 10)) 150 | (aeq '>= nil (>= 9 10)) 151 | (aeq '/= t (/= 1)) 152 | (aeq '/= nil (/= 1 2 1)) 153 | (aeq '/= nil (/= 1 2 3 1)) 154 | (aeq '/= t (/= 1 2 3 4)) 155 | (aeq 'plusp t (plusp 1)) 156 | (aeq 'plusp nil (plusp 0)) 157 | (aeq 'plusp nil (plusp -1)) 158 | (aeq 'minusp nil (minusp 1)) 159 | (aeq 'minusp nil (minusp 0)) 160 | (aeq 'minusp t (minusp -1)) 161 | (aeq 'zerop nil (zerop 1)) 162 | (aeq 'zerop t (zerop 0)) 163 | (aeq 'zerop nil (zerop -1)) 164 | (aeq 'evenp nil (evenp 1)) 165 | (aeq 'evenp t (evenp 0)) 166 | (aeq 'evenp nil (evenp -1)) 167 | (aeq 'oddp t (oddp 1)) 168 | (aeq 'oddp nil (oddp 0)) 169 | (aeq 'oddp t (oddp -1)) 170 | 171 | #| Maths functions |# 172 | 173 | (aeq 'abs 10 (abs 10)) 174 | (aeq 'abs 10 (abs -10)) 175 | (aeq 'max 45 (max 23 45)) 176 | (aeq 'max -23 (max -23 -45)) 177 | (aeq 'min 23 (min 23 45)) 178 | (aeq 'min -45 (min -23 -45)) 179 | (aeq 'zerop t (zerop 0)) 180 | (aeq 'zerop nil (zerop 32767)) 181 | (aeq 'mod 1 (mod 13 4)) 182 | (aeq 'mod 3 (mod -13 4)) 183 | (aeq 'mod -3 (mod 13 -4)) 184 | (aeq 'mod -1 (mod -13 -4)) 185 | 186 | #| Number entry |# 187 | 188 | (aeq 'hex -1 #xFFFF) 189 | (aeq 'hex 1 #x0001) 190 | (aeq 'hex 4112 #x1010) 191 | (aeq 'oct 511 #o777) 192 | (aeq 'oct 1 #o1) 193 | (aeq 'oct -1 #o177777) 194 | (aeq 'bin -1 #b1111111111111111) 195 | (aeq 'bin 10 #b1010) 196 | (aeq 'bin 0 #b0) 197 | (aeq 'bin 12 #'12) 198 | (aeq 'bin 6 (funcall #'(lambda (x) (+ x 2)) 4)) 199 | 200 | #| Boolean |# 201 | 202 | (aeq 'and 7 (and t t 7)) 203 | (aeq 'and nil (and t nil 7)) 204 | (aeq 'or t (or t nil 7)) 205 | (aeq 'or 1 (or 1 2 3)) 206 | (aeq 'or nil (or nil nil nil)) 207 | (aeq 'or 'a (or 'a 'b 'c)) 208 | (aeq 'or 1 (let ((x 0)) (or (incf x)) x)) 209 | 210 | #| Bitwise |# 211 | 212 | (aeq 'logand -1 (logand)) 213 | (aeq 'logand 170 (logand #xAA)) 214 | (aeq 'logand 0 (logand #xAAAA #x5555)) 215 | (aeq 'logior 0 (logior)) 216 | (aeq 'logior 170 (logior #xAA)) 217 | (aeq 'logior #xFFFF (logior #xAAAA #x5555)) 218 | (aeq 'logxor 0 (logxor)) 219 | (aeq 'logxor 170 (logior #xAA)) 220 | (aeq 'logxor 255 (logxor #xAAAA #xAA55)) 221 | (aeq 'lognot #x5555 (lognot #xAAAA)) 222 | (aeq 'ash 492 (ash 123 2)) 223 | (aeq 'ash #xFFFF (ash #xFFFF 0)) 224 | (aeq 'ash #xFFFF (ash #xFFFF -2)) 225 | (aeq 'ash -4 (ash #xFFFF 2)) 226 | (aeq 'ash 8191 (ash #x7FFF -2)) 227 | (aeq 'logbitp t (logbitp 0 1)) 228 | (aeq 'logbitp t (logbitp 1000 -1)) 229 | (aeq 'logbitp nil (logbitp 1000 0)) 230 | 231 | #| Tests |# 232 | 233 | (aeq 'atom t (atom nil)) 234 | (aeq 'atom t (atom t)) 235 | (aeq 'atom nil (atom '(1 2))) 236 | (aeq 'consp nil (consp 'b)) 237 | (aeq 'consp t (consp '(a b))) 238 | (aeq 'consp nil (consp nil)) 239 | (aeq 'listp nil (listp 'b)) 240 | (aeq 'listp t (listp '(a b))) 241 | (aeq 'listp t (listp nil)) 242 | (aeq 'numberp t (numberp (+ 1 2))) 243 | (aeq 'numberp nil (numberp 'b)) 244 | (aeq 'numberp nil (numberp nil)) 245 | (aeq 'symbolp t (symbolp 'b)) 246 | (aeq 'symbolp nil (symbolp 3)) 247 | (aeq 'symbolp t (symbolp nil)) 248 | (aeq 'streamp nil (streamp 'b)) 249 | (aeq 'streamp nil (streamp nil)) 250 | (aeq 'boundp t (let (x) (boundp 'x))) 251 | (aeq 'boundp nil (let (x) (boundp 'y))) 252 | 253 | #| cxr operations |# 254 | 255 | (aeq 'car 'a (car '(a b c))) 256 | (aeq 'car nil (car nil)) 257 | (aeq 'first 'a (first '(a b c))) 258 | (aeq 'first nil (first nil)) 259 | (aeq 'cdr 'b (cdr '(a . b))) 260 | (aeq 'cdr 'b (car (cdr '(a b)))) 261 | (aeq 'cdr nil (cdr nil)) 262 | (aeq 'rest 'b (rest '(a . b))) 263 | (aeq 'rest 'b (car (rest '(a b)))) 264 | (aeq 'rest nil (rest nil)) 265 | (aeq 'caaar 'a (caaar '(((a))))) 266 | (aeq 'caaar 'nil (caaar nil)) 267 | (aeq 'caadr 'b (caadr '(a (b)))) 268 | (aeq 'caadr 'nil (caadr nil)) 269 | (aeq 'caar 'a (caar '((a)))) 270 | (aeq 'caar 'nil (caar nil)) 271 | (aeq 'cadar 'c (cadar '((a c) (b)))) 272 | (aeq 'cadar 'nil (cadar nil)) 273 | (aeq 'caddr 'c (caddr '(a b c))) 274 | (aeq 'caddr 'nil (caddr nil)) 275 | (aeq 'cadr 'b (cadr '(a b))) 276 | (aeq 'second 'nil (second '(a))) 277 | (aeq 'second 'b (second '(a b))) 278 | (aeq 'cadr 'nil (cadr '(a))) 279 | (aeq 'caddr 'c (caddr '(a b c))) 280 | (aeq 'caddr 'nil (caddr nil)) 281 | (aeq 'third 'c (third '(a b c))) 282 | (aeq 'third 'nil (third nil)) 283 | (aeq 'cdaar 'b (car (cdaar '(((a b)) b c)))) 284 | (aeq 'cdaar 'nil (cdaar nil)) 285 | (aeq 'cdadr 'c (car (cdadr '(a (b c))))) 286 | (aeq 'cdadr 'nil (cdadr nil)) 287 | (aeq 'cdar 'b (car (cdar '((a b c))))) 288 | (aeq 'cdar 'nil (cdar nil)) 289 | (aeq 'cddar 'c (car (cddar '((a b c))))) 290 | (aeq 'cddar 'nil (cddar nil)) 291 | (aeq 'cdddr 'd (car (cdddr '(a b c d)))) 292 | (aeq 'cdddr nil (car (cdddr '(a b c)))) 293 | (aeq 'cddr 'c (car (cddr '(a b c)))) 294 | (aeq 'cddr 'nil (cddr '(a))) 295 | 296 | #| List operations |# 297 | 298 | (aeq 'cons 'a (car (cons 'a 'b))) 299 | (aeq 'cons nil (car (cons nil 'b))) 300 | (aeq 'append 6 (length (append '(a b c) '(d e f)))) 301 | (aeq 'append nil (append nil nil)) 302 | (aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6))) 303 | (aeq 'list nil (car (list nil))) 304 | (aeq 'list 'a (car (list 'a 'b 'c))) 305 | (aeq 'reverse 'c (car (reverse '(a b c)))) 306 | (aeq 'reverse nil (reverse nil)) 307 | (aeq 'length 0 (length nil)) 308 | (aeq 'length 4 (length '(a b c d))) 309 | (aeq 'length 2 (length '(nil nil))) 310 | (aeq 'assoc nil (assoc 'b nil)) 311 | (aeq 'assoc nil (assoc 'b '(nil nil))) 312 | (aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12)))) 313 | (aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12)))) 314 | (aeq 'assoc '(b) (assoc 'b '((a . 10) (b)))) 315 | (aeq 'mapc 2 (cadr (mapc + '(1 2 3 4)))) 316 | (aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x)) 317 | (aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4))) 318 | (aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4))) 319 | (aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5))) 320 | (aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6))) 321 | (aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4))) 322 | (aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11))) 323 | (aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4)))) 324 | (aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4)))) 325 | 326 | #| let/let*/lambda |# 327 | 328 | (aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y))) 329 | (aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y))) 330 | (aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 331 | (aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 332 | (aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3)) 333 | (aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4)) 334 | (aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2)) 335 | (aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3)) 336 | (aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3)) 337 | (aeq 'lambda 123 ((lambda (list) list) 123)) 338 | 339 | #| loops and control |# 340 | 341 | (aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x)))) 342 | (aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y))))) 343 | (aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y))))) 344 | (aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y))))) 345 | (aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y))))) 346 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y))))) 347 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y))))) 348 | (aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x)))) 349 | (aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x)))) 350 | 351 | #| conditions |# 352 | 353 | (aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4))) 354 | (aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4))) 355 | (aeq 'if 4 (let ((a 3)) (if (= a 3) 4))) 356 | (aeq 'if nil (let ((a 4)) (if (= a 3) 4))) 357 | (aeq 'when 4 (let ((a 3)) (when (= a 3) 4))) 358 | (aeq 'when nil (let ((a 2)) (when (= a 3) 4))) 359 | (aeq 'unless nil (let ((a 3)) (unless (= a 3) 4))) 360 | (aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4))) 361 | (aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9)))) 362 | (aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9)))) 363 | (aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8)))) 364 | (aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4)))))) 365 | (aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 366 | (aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 367 | (aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 368 | 369 | #| eval/funcall/apply |# 370 | 371 | (aeq 'funcall 10 (funcall + 1 2 3 4)) 372 | (aeq 'funcall 'a (funcall car '(a b c d))) 373 | (aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x)) 374 | (aeq 'apply 10 (apply + '(1 2 3 4))) 375 | (aeq 'apply 13 (apply + 1 2 '(1 2 3 4))) 376 | (aeq 'eval 10 (eval (list + 1 2 3 4))) 377 | (aeq 'eval nil (eval nil)) 378 | (aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x))) 379 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2))) 380 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2))) 381 | (aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3)))) 382 | 383 | #| in-place operations |# 384 | 385 | (aeq 'incf 6 (let ((x 0)) (+ (incf x) (incf x) (incf x)))) 386 | (aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2)))) 387 | (aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1))))) 388 | (aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b))) 389 | (aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a))) 390 | (aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a))) 391 | (aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a))) 392 | 393 | #| recursion |# 394 | 395 | (aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10))) 396 | (aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7))) 397 | (aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a)) 398 | 399 | #| streams |# 400 | 401 | (aeq 'stream "" (with-output-to-string (s) (princ s s))) 402 | (aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34))) 403 | (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)))))) 404 | 405 | #| printing |# 406 | 407 | (aeq 'princ "hello" (princ-to-string "hello")) 408 | (aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\"")) 409 | (aeq 'prin1 "\"hello\"" (prin1-to-string "hello")) 410 | (aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\"")) 411 | 412 | #| format |# 413 | 414 | (aeq 'format "hello" (format nil "hello")) 415 | (aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23)) 416 | (aeq 'format " 17" (format nil "~5x" 23)) 417 | (aeq 'format " 10111" (format nil "~6b" 23)) 418 | (aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23)) 419 | (aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23)) 420 | (aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7)) 421 | (aeq 'format "Hello42" (format nil "Hello~a" 42)) 422 | (aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3))) 423 | (aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil)) 424 | 425 | #| strings |# 426 | 427 | (aeq 'stringp t (stringp "hello")) 428 | (aeq 'stringp nil (stringp 5)) 429 | (aeq 'stringp nil (stringp '(a b))) 430 | (aeq 'numberp nil (numberp "hello")) 431 | (aeq 'atom t (atom "hello")) 432 | (aeq 'consp nil (consp "hello")) 433 | (aeq 'eq nil (eq "hello" "hello")) 434 | (aeq 'eq t (let ((a "hello")) (eq a a))) 435 | (aeq 'length 0 (length "")) 436 | (aeq 'length 5 (length "hello")) 437 | (aeq 'subseq "hello" (subseq "hellofromdavid" 0 5)) 438 | (aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5)) 439 | (aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB")) 440 | (aeq 'concatenate 3 (length (concatenate 'string "A" "BC"))) 441 | (aeq 'concatenate 0 (length (concatenate 'string))) 442 | (aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD")) 443 | (aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE")) 444 | (aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE")) 445 | (aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF")) 446 | (aeq 'string< nil (string< "cat" "cat")) 447 | (aeq 'string< t (string< "cat" "cat ")) 448 | (aeq 'string< t (string< "fish" "fish ")) 449 | (aeq 'string> nil (string> "cat" "cat")) 450 | (aeq 'string> t (string> "cat " "cat")) 451 | (aeq 'string "albatross" (string "albatross")) 452 | (aeq 'string "x" (string #\x)) 453 | (aeq 'string "cat" (string 'cat)) 454 | (aeq 'string "albatross" (string 'albatross)) 455 | 456 | #| characters |# 457 | 458 | (aeq 'char-code 97 (char-code #\a)) 459 | (aeq 'char-code 13 (char-code #\return)) 460 | (aeq 'char-code 255 (char-code #\255)) 461 | (aeq 'code-char #\return (code-char 13)) 462 | (aeq 'code-char #\a (code-char 97)) 463 | (aeq 'code-char #\255 (code-char 255)) 464 | (aeq 'eq t (eq #\b #\b)) 465 | (aeq 'eq nil (eq #\b #\B)) 466 | (aeq 'numberp nil (numberp #\b)) 467 | (aeq 'characterp t (characterp #\b)) 468 | (aeq 'char #\o (char "hello" 4)) 469 | (aeq 'char #\h (char "hello" 0)) 470 | (aeq 'char "A" (princ-to-string (code-char 65))) 471 | (aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7))) 472 | (aeq 'char "[#\\Return]" (format nil "[~s]" #\return)) 473 | (aeq 'char "[#\\127]" (format nil "[~s]" #\127)) 474 | (aeq 'char "[#\\255]" (format nil "[~s]" #\255)) 475 | 476 | #| read-from-string |# 477 | 478 | (aeq 'read-from-string 123 (read-from-string "123")) 479 | (aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)"))) 480 | (aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)"))) 481 | (aeq 'read-from-string nil (read-from-string "()")) 482 | 483 | #| closures |# 484 | 485 | (aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn)))))) 486 | (aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1))) 487 | (aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x)) 488 | (aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x)) 489 | (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)))) 490 | (aeq 'closure 3 (let ((y 0) (tst (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (tst (+ x 2))) (incf y x)))) 491 | 492 | #| repl |# 493 | 494 | (aeq 'repl 23 (read-from-string "23(2)")) 495 | (aeq 'repl nil (read-from-string "()23")) 496 | (aeq 'repl 23 (read-from-string "23\"Hi\"")) 497 | (aeq 'repl "Hi" (read-from-string "\"Hi\"23")) 498 | (aeq 'repl #\1 (read-from-string " #\\1\"Hi\"")) 499 | (aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101"))) 500 | 501 | #| subseq/equal |# 502 | 503 | (aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2)) 504 | (aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3)) 505 | (aeq 'subseq nil (subseq '() 0)) 506 | (aeq 'equal t (equal '(1 2 3) '(1 2 3))) 507 | (aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3))) 508 | (aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3))) 509 | (aeq 'equal t (equal "cat" "cat")) 510 | (aeq 'equal nil (equal "cat" "Cat")) 511 | (aeq 'equal t (equal 'cat 'Cat)) 512 | (aeq 'equal t (equal 2 (+ 1 1))) 513 | 514 | #| keywords |# 515 | 516 | (aeq 'keywordp t (keywordp :led-builtin)) 517 | (aeq 'keywordp nil (keywordp print)) 518 | (aeq 'keywordp nil (keywordp nil)) 519 | (aeq 'keywordp nil (keywordp 12)) 520 | 521 | "#) 522 | 523 | (defun run-tests (&optional (usb 1411)) ; "/dev/cu.usbserial-A104OVGT")) ; 524 | (let ((name (cond 525 | ((numberp usb) (format nil "/dev/cu.usbmodem~a" usb)) 526 | ((eq usb :badge) "/dev/cu.usbserial-A104OVGT") ; "/dev/cu.usbserial-A602TRZF" 527 | ((eq usb :star) "/dev/cu.usbserial-A10JYSPG") 528 | (t usb))) 529 | (speed 0.5)) 530 | (flet ((serial-write-exp (string stream) 531 | (write-string string stream) 532 | (write-char #\newline stream)) 533 | ;; 534 | (echo (s) 535 | (sleep speed) 536 | (loop 537 | (let ((c (read-char-no-hang s))) 538 | (unless c (return)) 539 | (unless (eq c #\return) (write-char c)))) 540 | (format t "~%")) 541 | ;; 542 | (read-serial (s) 543 | (sleep speed) 544 | (let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) 545 | (loop 546 | (let ((c (read-char-no-hang s))) 547 | (unless c (return string)) 548 | (vector-push-extend c string)))))) 549 | ;; 550 | (with-open-stream (s (make-instance 'serial-stream :name name)) 551 | (echo s) 552 | (echo s) 553 | (serial-write-exp "(defvar ers 0)" s) 554 | (echo s) 555 | (serial-write-exp 556 | "(defun aeq (tst x y) 557 | (unless (equal x y) 558 | (incf ers) 559 | (format t \"~a=~a/~a~%\" tst x y)))" 560 | s) 561 | (echo s) 562 | ;; 563 | ;; tests 564 | ;; 565 | (with-input-from-string (str *tests*) 566 | (loop 567 | (let ((line (read-line str nil nil))) 568 | (unless line (return)) 569 | (serial-write-exp line s) 570 | (let ((output (read-serial s))) 571 | (let* ((m1 (position #\return output)) 572 | (m2 (when m1 (position #\return output :start (+ 2 m1))))) 573 | (cond 574 | ((null m2) (format t "~a~%" output)) 575 | ((string= (subseq output (+ 2 m1) m2) "nil") nil) 576 | (t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1))))))))))))) -------------------------------------------------------------------------------- /Test Suites/AutoTester AVR.lisp: -------------------------------------------------------------------------------- 1 | ; uLisp Auto Tester 2 | 3 | ; Sharp-double-quote 4 | 5 | (defun sharp-double-quote-reader (stream sub-char numarg) 6 | (declare (ignore sub-char numarg)) 7 | (let (chars) 8 | (do ((prev (read-char stream) curr) 9 | (curr (read-char stream) (read-char stream))) 10 | ((and (char= prev #\") (char= curr #\#))) 11 | (push prev chars)) 12 | (coerce (nreverse chars) 'string))) 13 | 14 | (set-dispatch-macro-character 15 | #\# #\" #'sharp-double-quote-reader) 16 | 17 | ; do (run-tests) 18 | 19 | ;;; ================================================================ 20 | 21 | (eval-when (:compile-toplevel :load-toplevel :execute) 22 | (require "serial-port")) 23 | 24 | (cl:in-package "CL-USER") 25 | 26 | ;;; ================================================================ 27 | ;;; Class SERIAL-STREAM 28 | 29 | (defclass serial-stream (stream:fundamental-character-input-stream 30 | stream:fundamental-character-output-stream) 31 | ((serial-port :initform nil 32 | :initarg :serial-port 33 | :accessor stream-serial-port))) 34 | 35 | (defmethod initialize-instance :after ((stream serial-stream) 36 | &key name (baud-rate 9600) (data-bits 8) (stop-bits 1) (parity :none) 37 | &allow-other-keys) 38 | (unless (stream-serial-port stream) 39 | (check-type name string) 40 | (setf (stream-serial-port stream) 41 | (serial-port:open-serial-port name 42 | :baud-rate baud-rate 43 | :data-bits data-bits 44 | :stop-bits stop-bits 45 | :parity parity)))) 46 | 47 | (defmethod stream-element-type ((stream serial-stream)) 48 | 'character) 49 | 50 | (defmethod input-stream-p ((stream serial-stream)) 51 | t) 52 | 53 | (defmethod output-stream-p ((stream serial-stream)) 54 | t) 55 | 56 | ;;; ================================================================ 57 | ;;; Input 58 | 59 | (defmethod stream:stream-read-char ((stream serial-stream)) 60 | (serial-port:read-serial-port-char (stream-serial-port stream))) 61 | 62 | (defmethod stream:stream-read-char-no-hang ((stream serial-stream)) 63 | (when (stream:stream-listen stream) 64 | (stream:stream-read-char stream))) 65 | 66 | (defmethod stream:stream-listen ((stream serial-stream)) 67 | (serial-port:serial-port-input-available-p (stream-serial-port stream))) 68 | 69 | (defmethod stream:stream-clear-input ((stream serial-stream)) 70 | (loop while (stream:stream-listen stream) 71 | do (stream:stream-read-char stream)) 72 | nil) 73 | 74 | 75 | ;;; ================================================================ 76 | ;;; Output 77 | 78 | (defmethod stream:stream-write-char ((stream serial-stream) char) 79 | (serial-port:write-serial-port-char char (stream-serial-port stream))) 80 | 81 | (defmethod stream:stream-write-string ((stream serial-stream) string &optional (start 0) (end (length string))) 82 | (serial-port:write-serial-port-string string (stream-serial-port stream) t :start start :end end)) 83 | 84 | (defmethod stream:stream-force-output ((stream serial-stream)) 85 | nil) 86 | 87 | (defmethod stream:stream-finish-output ((stream serial-stream)) 88 | nil) 89 | 90 | (defmethod stream:stream-clear-output ((stream serial-stream)) 91 | nil) 92 | 93 | (defmethod close :after ((stream serial-stream) &key abort) 94 | (declare (ignorable abort)) 95 | (serial-port:close-serial-port (stream-serial-port stream))) 96 | 97 | ;;; ================================================================ 98 | ;;; Example 99 | 100 | (defparameter *tests* 101 | 102 | #"#| Symbols |# 103 | 104 | (aeq 'let 123 (let ((cat 123)) cat)) 105 | (aeq 'let 79 (let ((ca% 79)) ca%)) 106 | (aeq 'let 83 (let ((1- 83)) 1-)) 107 | (aeq 'let 13 (let ((12a 13)) 12a)) 108 | (aeq 'let 17 (let ((-1- 17)) -1-)) 109 | (aeq 'let 66 (let ((abcdef 66)) abcdef)) 110 | (aeq 'let 77 (let ((abcdefg 77)) abcdefg)) 111 | (aeq 'let 88 (let ((abcdefgh 88)) abcdefgh)) 112 | (aeq 'let 99 (let ((abcdefghi 99)) abcdefghi)) 113 | (aeq 'let 1010 (let ((abcdefghij 1010)) abcdefghij)) 114 | (aeq 'let "ab9" (princ-to-string 'ab9)) 115 | (aeq 'let t (eq 'me 'me)) 116 | (aeq 'let t (eq 'fishcake 'fishcake)) 117 | (aeq 'let nil (eq 'fishcak 'fishca)) 118 | 119 | #| Arithmetic |# 120 | 121 | (aeq '* 9 (* -3 -3)) 122 | (aeq '* 32580 (* 180 181)) 123 | (aeq '* 1 (*)) 124 | (aeq '+ 32767 (+ 32765 1 1)) 125 | (aeq '+ 0 (+)) 126 | (aeq '+ -2 (+ -1 -1)) 127 | (aeq '- -4 (- 4)) 128 | (aeq '- 0 (- 4 2 1 1)) 129 | (aeq '/ 2 (/ 60 10 3)) 130 | (aeq '1+ 2 (1+ 1)) 131 | (aeq '1+ 0 (1+ -1)) 132 | (aeq '1- 0 (1- 1)) 133 | 134 | #| Comparisons |# 135 | 136 | (aeq '< t (< -32768 32767)) 137 | (aeq '< t (< -1 0)) 138 | (aeq '< t (< 1 2 3 4)) 139 | (aeq '< nil (< 1 2 2 4)) 140 | (aeq '< t (<= 1 2 2 4)) 141 | (aeq '< nil (<= 1 3 2 4)) 142 | (aeq '< t (> 4 3 2 1)) 143 | (aeq '< nil (> 4 2 2 1)) 144 | (aeq '< t (>= 4 2 2 1)) 145 | (aeq '< nil (>= 4 2 3 1)) 146 | (aeq '< t (< 1)) 147 | (aeq '< nil (< 1 3 2)) 148 | (aeq '< nil (< -1 -2)) 149 | (aeq '< nil (< 10 10)) 150 | (aeq '<= t (<= 10 10)) 151 | (aeq '= t (= 32767 32767)) 152 | (aeq '>= t (>= 10 10)) 153 | (aeq '>= nil (>= 9 10)) 154 | (aeq '/= t (/= 1)) 155 | (aeq '/= nil (/= 1 2 1)) 156 | (aeq '/= nil (/= 1 2 3 1)) 157 | (aeq '/= t (/= 1 2 3 4)) 158 | (aeq 'plusp t (plusp 1)) 159 | (aeq 'plusp nil (plusp 0)) 160 | (aeq 'plusp nil (plusp -1)) 161 | (aeq 'minusp nil (minusp 1)) 162 | (aeq 'minusp nil (minusp 0)) 163 | (aeq 'minusp t (minusp -1)) 164 | (aeq 'zerop nil (zerop 1)) 165 | (aeq 'zerop t (zerop 0)) 166 | (aeq 'zerop nil (zerop -1)) 167 | (aeq 'evenp nil (evenp 1)) 168 | (aeq 'evenp t (evenp 0)) 169 | (aeq 'evenp nil (evenp -1)) 170 | (aeq 'oddp t (oddp 1)) 171 | (aeq 'oddp nil (oddp 0)) 172 | (aeq 'oddp t (oddp -1)) 173 | 174 | #| Maths functions |# 175 | 176 | (aeq 'abs 10 (abs 10)) 177 | (aeq 'abs 10 (abs -10)) 178 | (aeq 'max 45 (max 23 45)) 179 | (aeq 'max -23 (max -23 -45)) 180 | (aeq 'min 23 (min 23 45)) 181 | (aeq 'min -45 (min -23 -45)) 182 | (aeq 'zerop t (zerop 0)) 183 | (aeq 'zerop nil (zerop 32767)) 184 | (aeq 'mod 1 (mod 13 4)) 185 | (aeq 'mod 3 (mod -13 4)) 186 | (aeq 'mod -3 (mod 13 -4)) 187 | (aeq 'mod -1 (mod -13 -4)) 188 | 189 | #| Number entry |# 190 | 191 | (aeq 'hex -1 #xFFFF) 192 | (aeq 'hex 1 #x0001) 193 | (aeq 'hex 4112 #x1010) 194 | (aeq 'oct 511 #o777) 195 | (aeq 'oct 1 #o1) 196 | (aeq 'oct -1 #o177777) 197 | (aeq 'bin -1 #b1111111111111111) 198 | (aeq 'bin 10 #b1010) 199 | (aeq 'bin 0 #b0) 200 | (aeq 'hash 12 #'12) 201 | (aeq 'hash 6 (funcall #'(lambda (x) (+ x 2)) 4)) 202 | 203 | #| Boolean |# 204 | 205 | (aeq 'and 7 (and t t 7)) 206 | (aeq 'and nil (and t nil 7)) 207 | (aeq 'or t (or t nil 7)) 208 | (aeq 'or 1 (or 1 2 3)) 209 | (aeq 'or nil (or nil nil nil)) 210 | (aeq 'or 'a (or 'a 'b 'c)) 211 | (aeq 'or 1 (let ((x 0)) (or (incf x)) x)) 212 | 213 | #| Bitwise |# 214 | 215 | (aeq 'logand -1 (logand)) 216 | (aeq 'logand 170 (logand #xAA)) 217 | (aeq 'logand 0 (logand #xAAAA #x5555)) 218 | (aeq 'logior 0 (logior)) 219 | (aeq 'logior 170 (logior #xAA)) 220 | (aeq 'logior #xFFFF (logior #xAAAA #x5555)) 221 | (aeq 'logxor 0 (logxor)) 222 | (aeq 'logxor 170 (logior #xAA)) 223 | (aeq 'logxor 255 (logxor #xAAAA #xAA55)) 224 | (aeq 'lognot #x5555 (lognot #xAAAA)) 225 | (aeq 'ash 492 (ash 123 2)) 226 | (aeq 'ash #xFFFF (ash #xFFFF 0)) 227 | (aeq 'ash #xFFFF (ash #xFFFF -2)) 228 | (aeq 'ash -4 (ash #xFFFF 2)) 229 | (aeq 'ash 8191 (ash #x7FFF -2)) 230 | (aeq 'logbitp t (logbitp 0 1)) 231 | (aeq 'logbitp t (logbitp 1000 -1)) 232 | (aeq 'logbitp nil (logbitp 1000 0)) 233 | 234 | #| Tests |# 235 | 236 | (aeq 'atom t (atom nil)) 237 | (aeq 'atom t (atom t)) 238 | (aeq 'atom nil (atom '(1 2))) 239 | (aeq 'consp nil (consp 'b)) 240 | (aeq 'consp t (consp '(a b))) 241 | (aeq 'consp nil (consp nil)) 242 | (aeq 'listp nil (listp 'b)) 243 | (aeq 'listp t (listp '(a b))) 244 | (aeq 'listp t (listp nil)) 245 | (aeq 'numberp t (numberp (+ 1 2))) 246 | (aeq 'numberp nil (numberp 'b)) 247 | (aeq 'numberp nil (numberp nil)) 248 | (aeq 'symbolp t (symbolp 'b)) 249 | (aeq 'symbolp nil (symbolp 3)) 250 | (aeq 'symbolp t (symbolp nil)) 251 | (aeq 'streamp nil (streamp 'b)) 252 | (aeq 'streamp nil (streamp nil)) 253 | (aeq 'boundp t (let (x) (boundp 'x))) 254 | (aeq 'boundp nil (let (x) (boundp 'y))) 255 | 256 | #| cxr operations |# 257 | 258 | (aeq 'car 'a (car '(a b c))) 259 | (aeq 'car nil (car nil)) 260 | (aeq 'first 'a (first '(a b c))) 261 | (aeq 'first nil (first nil)) 262 | (aeq 'cdr 'b (cdr '(a . b))) 263 | (aeq 'cdr 'b (car (cdr '(a b)))) 264 | (aeq 'cdr nil (cdr nil)) 265 | (aeq 'rest 'b (rest '(a . b))) 266 | (aeq 'rest 'b (car (rest '(a b)))) 267 | (aeq 'rest nil (rest nil)) 268 | (aeq 'caaar 'a (caaar '(((a))))) 269 | (aeq 'caaar 'nil (caaar nil)) 270 | (aeq 'caadr 'b (caadr '(a (b)))) 271 | (aeq 'caadr 'nil (caadr nil)) 272 | (aeq 'caar 'a (caar '((a)))) 273 | (aeq 'caar 'nil (caar nil)) 274 | (aeq 'cadar 'c (cadar '((a c) (b)))) 275 | (aeq 'cadar 'nil (cadar nil)) 276 | (aeq 'caddr 'c (caddr '(a b c))) 277 | (aeq 'caddr 'nil (caddr nil)) 278 | (aeq 'cadr 'b (cadr '(a b))) 279 | (aeq 'second 'nil (second '(a))) 280 | (aeq 'second 'b (second '(a b))) 281 | (aeq 'cadr 'nil (cadr '(a))) 282 | (aeq 'caddr 'c (caddr '(a b c))) 283 | (aeq 'caddr 'nil (caddr nil)) 284 | (aeq 'third 'c (third '(a b c))) 285 | (aeq 'third 'nil (third nil)) 286 | (aeq 'cdaar 'b (car (cdaar '(((a b)) b c)))) 287 | (aeq 'cdaar 'nil (cdaar nil)) 288 | (aeq 'cdadr 'c (car (cdadr '(a (b c))))) 289 | (aeq 'cdadr 'nil (cdadr nil)) 290 | (aeq 'cdar 'b (car (cdar '((a b c))))) 291 | (aeq 'cdar 'nil (cdar nil)) 292 | (aeq 'cddar 'c (car (cddar '((a b c))))) 293 | (aeq 'cddar 'nil (cddar nil)) 294 | (aeq 'cdddr 'd (car (cdddr '(a b c d)))) 295 | (aeq 'cdddr nil (car (cdddr '(a b c)))) 296 | (aeq 'cddr 'c (car (cddr '(a b c)))) 297 | (aeq 'cddr 'nil (cddr '(a))) 298 | 299 | #| List operations |# 300 | 301 | (aeq 'cons 'a (car (cons 'a 'b))) 302 | (aeq 'cons nil (car (cons nil 'b))) 303 | (aeq 'append 6 (length (append '(a b c) '(d e f)))) 304 | (aeq 'append nil (append nil nil)) 305 | (aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6))) 306 | (aeq 'list nil (car (list nil))) 307 | (aeq 'list 'a (car (list 'a 'b 'c))) 308 | (aeq 'reverse 'c (car (reverse '(a b c)))) 309 | (aeq 'reverse nil (reverse nil)) 310 | (aeq 'length 0 (length nil)) 311 | (aeq 'length 4 (length '(a b c d))) 312 | (aeq 'length 2 (length '(nil nil))) 313 | (aeq 'assoc nil (assoc 'b nil)) 314 | (aeq 'assoc nil (assoc 'b '(nil nil))) 315 | (aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12)))) 316 | (aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12)))) 317 | (aeq 'assoc '(b) (assoc 'b '((a . 10) (b)))) 318 | (aeq 'assoc '("three" . 3) (assoc "three" '(("one" . 1) ("two" . 2) ("three" . 3)) :test string=)) 319 | (aeq 'member '(3 4) (member 3 '(1 2 3 4))) 320 | (aeq 'member nil (member 5 '(1 2 3 4))) 321 | (aeq 'member '(3 4) (member 3 '(1 2 3 4) :test eq)) 322 | (aeq 'member '("three" "four") (member "three" '("one" "two" "three" "four") :test string=)) 323 | (aeq 'member '("two" "three" "four") (member "three" '("one" "two" "three" "four") :test string<)) 324 | 325 | #| map operations |# 326 | 327 | (aeq 'mapc 2 (cadr (mapc + '(1 2 3 4)))) 328 | (aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x)) 329 | (aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4))) 330 | (aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4))) 331 | (aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5))) 332 | (aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6))) 333 | (aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4))) 334 | (aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11))) 335 | (aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4)))) 336 | (aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4)))) 337 | (aeq 'maplist '(((1 2 3) 6 7 8) ((2 3) 7 8) ((3) 8)) (maplist #'cons '(1 2 3) '(6 7 8))) 338 | (aeq 'maplist '(1 2 3) (mapl #'cons '(1 2 3) '(6 7 8))) 339 | (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))) 340 | 341 | 342 | #| let/let*/lambda |# 343 | 344 | (aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y))) 345 | (aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y))) 346 | (aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 347 | (aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 348 | (aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3)) 349 | (aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4)) 350 | (aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2)) 351 | (aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3)) 352 | (aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3)) 353 | (aeq 'lambda 123 ((lambda (list) list) 123)) 354 | 355 | #| loops and control |# 356 | 357 | (aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x)))) 358 | (aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y))))) 359 | (aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y))))) 360 | (aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y))))) 361 | (aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y))))) 362 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y))))) 363 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y))))) 364 | (aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x)))) 365 | (aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x)))) 366 | (aeq 'return 'a (let ((a 7)) (loop (progn (return 'a))))) 367 | (aeq 'return nil (loop (return))) 368 | (aeq 'return 'a (let ((a 7)) (loop (progn (return 'a) nil)))) 369 | (aeq 'do 2 (do* ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x))) 370 | (aeq 'do 3 (do ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x))) 371 | (aeq 'do 720 (do* ((n 6) (f 1 (* j f)) (j n (- j 1))) ((= j 0) f))) 372 | (aeq 'do 720 (let ((n 6)) (do ((f 1 (* j f)) (j n (- j 1)) ) ((= j 0) f)))) 373 | (aeq 'do 10 (do (a (b 1 (1+ b))) ((> b 10) a) (setq a b))) 374 | 375 | #| conditions |# 376 | 377 | (aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4))) 378 | (aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4))) 379 | (aeq 'if 4 (let ((a 3)) (if (= a 3) 4))) 380 | (aeq 'if nil (let ((a 4)) (if (= a 3) 4))) 381 | (aeq 'when 4 (let ((a 3)) (when (= a 3) 4))) 382 | (aeq 'when nil (let ((a 2)) (when (= a 3) 4))) 383 | (aeq 'unless nil (let ((a 3)) (unless (= a 3) 4))) 384 | (aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4))) 385 | (aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9)))) 386 | (aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9)))) 387 | (aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8)))) 388 | (aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4)))))) 389 | (aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 390 | (aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 391 | (aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 392 | 393 | #| eval/funcall/apply |# 394 | 395 | (aeq 'funcall 10 (funcall + 1 2 3 4)) 396 | (aeq 'funcall 'a (funcall car '(a b c d))) 397 | (aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x)) 398 | (aeq 'apply 10 (apply + '(1 2 3 4))) 399 | (aeq 'apply 13 (apply + 1 2 '(1 2 3 4))) 400 | (aeq 'eval 10 (eval (list + 1 2 3 4))) 401 | (aeq 'eval nil (eval nil)) 402 | (aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x))) 403 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2))) 404 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2))) 405 | (aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3)))) 406 | 407 | #| in-place operations |# 408 | 409 | (aeq 'incf 5 (let ((x 0)) (+ (incf x) (incf x 2) (incf x -2)))) 410 | (aeq 'decf -5 (let ((x 0)) (+ (decf x) (decf x 2) (decf x -2)))) 411 | (aeq 'incf 6 (let ((x 0)) (+ (incf x) (incf x) (incf x)))) 412 | (aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2)))) 413 | (aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1))))) 414 | (aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b))) 415 | (aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a))) 416 | (aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a))) 417 | (aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a))) 418 | 419 | #| recursion |# 420 | 421 | (aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10))) 422 | (aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7))) 423 | (aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a)) 424 | 425 | #| streams |# 426 | 427 | (aeq 'stream "" (with-output-to-string (s) (princ s s))) 428 | (aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34))) 429 | 430 | #| features |# 431 | 432 | (aeq 'features nil (member :floating-point *features*)) 433 | (aeq 'features ":arrays" (princ-to-string (first (member :arrays *features*)))) 434 | 435 | #| printing |# 436 | 437 | (aeq 'princ "hello" (princ-to-string "hello")) 438 | (aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\"")) 439 | (aeq 'prin1 "\"hello\"" (prin1-to-string "hello")) 440 | (aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\"")) 441 | 442 | #| prettyprinting |# 443 | 444 | (aeq 'princ "hello" (princ-to-string "hello")) 445 | (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)))))) 446 | 447 | #| documentation |# 448 | 449 | (aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list 'pro)) 450 | (aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list "pro")) 451 | (aeq 'documentation 7397 (let ((n 0)) (let ((st (documentation '?))) (dotimes (i (length st) n) (incf n (char-code (char st i))))))) 452 | 453 | #| format |# 454 | 455 | (aeq 'format "hello" (format nil "hello")) 456 | (aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23)) 457 | (aeq 'format " 17" (format nil "~5x" 23)) 458 | (aeq 'format " 10111" (format nil "~6b" 23)) 459 | (aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23)) 460 | (aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23)) 461 | (aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7)) 462 | (aeq 'format "Hello42" (format nil "Hello~a" 42)) 463 | (aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3))) 464 | (aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil)) 465 | 466 | #| strings |# 467 | 468 | (aeq 'stringp t (stringp "hello")) 469 | (aeq 'stringp nil (stringp 5)) 470 | (aeq 'stringp nil (stringp '(a b))) 471 | (aeq 'numberp nil (numberp "hello")) 472 | (aeq 'atom t (atom "hello")) 473 | (aeq 'consp nil (consp "hello")) 474 | (aeq 'eq nil (eq "hello" "hello")) 475 | (aeq 'eq t (let ((a "hello")) (eq a a))) 476 | (aeq 'length 0 (length "")) 477 | (aeq 'length 5 (length "hello")) 478 | (aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB")) 479 | (aeq 'concatenate 3 (length (concatenate 'string "A" "BC"))) 480 | (aeq 'concatenate 0 (length (concatenate 'string))) 481 | (aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD")) 482 | (aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE")) 483 | (aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE")) 484 | (aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF")) 485 | (aeq 'string= nil (string= "cat" "cat ")) 486 | (aeq 'string= t (string= "cat" "cat")) 487 | (aeq 'string/= 3 (string/= "cat" "catx")) 488 | (aeq 'string/= nil (string/= "cat" "cat")) 489 | (aeq 'string/= nil (string/= "catt" "catt")) 490 | (aeq 'string< nil (string< "cat" "cat")) 491 | (aeq 'string<= 3 (string<= "cat" "cat")) 492 | (aeq 'string< 3 (string< "cat" "cat ")) 493 | (aeq 'string< 4 (string< "fish" "fish ")) 494 | (aeq 'string> nil (string> "cat" "cat")) 495 | (aeq 'string>= 3 (string>= "cat" "cat")) 496 | (aeq 'string>= 5 (string>= "cattx" "cattx")) 497 | (aeq 'string> 0 (string> "c" "a")) 498 | (aeq 'string> 1 (string> "fc" "fa")) 499 | (aeq 'string> 2 (string> "ffc" "ffa")) 500 | (aeq 'string> 3 (string> "fffc" "fffa")) 501 | (aeq 'string> 4 (string> "ffffc" "ffffa")) 502 | (aeq 'string> 5 (string> "fffffc" "fffffa")) 503 | (aeq 'string> nil (string< "fffffc" "fffffa")) 504 | (aeq 'string "albatross" (string "albatross")) 505 | (aeq 'string "x" (string #\x)) 506 | (aeq 'string "cat" (string 'cat)) 507 | (aeq 'string "albatross" (string 'albatross)) 508 | 509 | #| subseq and search |# 510 | 511 | (aeq 'subseq "hello" (subseq "hellofromdavid" 0 5)) 512 | (aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5)) 513 | (aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2)) 514 | (aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3)) 515 | (aeq 'subseq nil (subseq '() 0)) 516 | (aeq 'search 4 (search "cat" "the cat sat on the mat")) 517 | (aeq 'search 19 (search "mat" "the cat sat on the mat")) 518 | (aeq 'search nil (search "hat" "the cat sat on the mat")) 519 | (aeq 'search 1 (search '(1 2) '( 0 1 2 3 4))) 520 | (aeq 'search nil (search '(2 1 2 3 4 5) '(2 1 2 3 4))) 521 | 522 | #| characters |# 523 | 524 | (aeq 'char-code 97 (char-code #\a)) 525 | (aeq 'char-code 13 (char-code #\return)) 526 | (aeq 'char-code 255 (char-code #\255)) 527 | (aeq 'code-char #\return (code-char 13)) 528 | (aeq 'code-char #\a (code-char 97)) 529 | (aeq 'code-char #\255 (code-char 255)) 530 | (aeq 'eq t (eq #\b #\b)) 531 | (aeq 'eq nil (eq #\b #\B)) 532 | (aeq 'numberp nil (numberp #\b)) 533 | (aeq 'characterp t (characterp #\b)) 534 | (aeq 'char #\o (char "hello" 4)) 535 | (aeq 'char #\h (char "hello" 0)) 536 | (aeq 'char "A" (princ-to-string (code-char 65))) 537 | (aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7))) 538 | (aeq 'char "[#\\Return]" (format nil "[~s]" #\return)) 539 | (aeq 'char "[#\\127]" (format nil "[~s]" #\127)) 540 | (aeq 'char "[#\\255]" (format nil "[~s]" #\255)) 541 | 542 | #| read-from-string |# 543 | 544 | (aeq 'read-from-string 123 (read-from-string "123")) 545 | (aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)"))) 546 | (aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)"))) 547 | (aeq 'read-from-string nil (read-from-string "()")) 548 | 549 | #| closures |# 550 | 551 | (aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn)))))) 552 | (aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1))) 553 | (aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x)) 554 | (aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x)) 555 | (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)))) 556 | (aeq 'closure 3 (let ((y 0) (test (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (test (+ x 2))) (incf y x)))) 557 | 558 | #| arrays |# 559 | 560 | (aeq 'array '(0 0) (array-dimensions #2a())) 561 | (aeq 'array '(1 0) (array-dimensions #2a(()))) 562 | (aeq 'array '(2 0) (array-dimensions #2a(() ()))) 563 | (aeq 'array '(0) (array-dimensions (make-array '(0)))) 564 | (aeq 'array '(0) (array-dimensions (make-array 0))) 565 | (aeq 'array 1 (let ((a (make-array 3 :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2))) 566 | (aeq 'array 1 (let ((a (make-array '(3) :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2))) 567 | (aeq 'array 1 (let ((a (make-array '(2 3) :initial-element 0))) (incf (aref a 1 (+ 1 1))) (aref a 1 2))) 568 | (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))) 569 | (aeq 'array 10 (length (make-array 10 :initial-element 1))) 570 | 571 | #| bit arrays |# 572 | 573 | (aeq 'array '(0) (array-dimensions (make-array '(0) :element-type 'bit))) 574 | (aeq 'array '(1 1) (array-dimensions (make-array '(1 1) :element-type 'bit))) 575 | (aeq 'array 10 (length (make-array '(10) :element-type 'bit))) 576 | (aeq 'array 10 (length (make-array 10 :element-type 'bit))) 577 | (aeq 'array 1 (let ((a (make-array 3 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2))) 578 | (aeq 'array 1 (let ((a (make-array 3 :initial-element 0 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2))) 579 | (aeq 'array 0 (let ((a (make-array 10 :element-type 'bit :initial-element 1))) (decf (aref a 4)) (aref a 4))) 580 | (aeq 'array 1 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (aref a 39))) 581 | (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))) 582 | 583 | #| repl |# 584 | 585 | (aeq 'repl 23 (read-from-string "23(2)")) 586 | (aeq 'repl nil (read-from-string "()23")) 587 | (aeq 'repl 23 (read-from-string "23\"Hi\"")) 588 | (aeq 'repl "Hi" (read-from-string "\"Hi\"23")) 589 | (aeq 'repl #\1 (read-from-string " #\\1\"Hi\"")) 590 | (aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101"))) 591 | 592 | #| equal |# 593 | 594 | (aeq 'equal t (equal '(1 2 3) '(1 2 3))) 595 | (aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3))) 596 | (aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3))) 597 | (aeq 'equal t (equal "cat" "cat")) 598 | (aeq 'equal nil (equal "cat" "Cat")) 599 | (aeq 'equal t (equal 'cat 'Cat)) 600 | (aeq 'equal t (equal 2 (+ 1 1))) 601 | (aeq 'equal t (equal '("cat" "dog") '("cat" "dog"))) 602 | (aeq 'equal nil (equal '("cat" "dog") '("cat" "dig"))) 603 | 604 | #| keywords |# 605 | 606 | (aeq 'keywordp t (keywordp :led-builtin)) 607 | (aeq 'keywordp nil (keywordp print)) 608 | (aeq 'keywordp nil (keywordp nil)) 609 | (aeq 'keywordp nil (keywordp 12)) 610 | (aeq 'keywordp t (keywordp :fred)) 611 | (aeq 'keywordp t (keywordp :initial-element)) 612 | (aeq 'keywordp t (keywordp :element-type)) 613 | 614 | #| errors |# 615 | 616 | (aeq 'error 7 (let ((x 7)) (ignore-errors (setq x (/ 1 0))) x)) 617 | (aeq 'error 5 (unwind-protect (+ 2 3) 13)) 618 | 619 | #| Place |# 620 | 621 | (aeq 'setf "hellx" (let ((s "hello")) (setf (char s 4) #\x) s)) 622 | 623 | #| error checks |# 624 | 625 | (aeq 'dolist nothing (ignore-errors (dolist 12 (print x)))) 626 | (aeq 'dolist nothing (ignore-errors (dolist () (print x)))) 627 | (aeq 'dolist nothing (ignore-errors (dolist (x) (print x)))) 628 | (aeq 'dolist nothing (ignore-errors (dolist (x nil x x) (print x)))) 629 | (aeq 'dotimes nothing (ignore-errors (dotimes 12 (print x)))) 630 | (aeq 'dotimes nothing (ignore-errors (dotimes () (print x)))) 631 | (aeq 'dotimes nothing (ignore-errors (dotimes (x) (print x)))) 632 | (aeq 'dotimes nothing (ignore-errors (dotimes (x 1 x x) (print x)))) 633 | (aeq 'for-millis nothing (ignore-errors (for-millis 12 (print 12)))) 634 | (aeq 'for-millis nothing (ignore-errors (for-millis (12 12) (print 12)))) 635 | (aeq 'push nothing (ignore-errors (let ((a #*00000000)) (push 1 (aref a 1)) a))) 636 | (aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 5) #\x) s))) 637 | (aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 20) #\x) s))) 638 | 639 | #| errors |# 640 | 641 | (aeq 'errors 0 ers) 642 | 643 | "#) 644 | 645 | (defun run-tests (&optional (usb 1411)) ; "/dev/cu.usbserial-A104OVGT")) ; 646 | (let ((name (cond 647 | ((numberp usb) (format nil "/dev/cu.usbmodem~a" usb)) 648 | ((eq usb :badge2) "/dev/cu.usbserial-A104OVGT") 649 | ((eq usb :badge) "/dev/cu.usbserial-A10L2FSQ") ; "/dev/cu.usbserial-A602TRZF" 650 | ((eq usb :avrfeather) "/dev/cu.SLAB_USBtoUART") 651 | (t usb))) 652 | (speed 0.5)) 653 | (flet ((serial-write-exp (string stream) 654 | (write-string string stream) 655 | (write-char #\newline stream)) 656 | ;; 657 | (echo (s) 658 | (sleep speed) 659 | (loop 660 | (let ((c (read-char-no-hang s))) 661 | (unless c (return)) 662 | (unless (eq c #\return) (write-char c)))) 663 | (format t "~%")) 664 | ;; 665 | (read-serial (s) 666 | (sleep speed) 667 | (let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) 668 | (loop 669 | (let ((c (read-char-no-hang s))) 670 | (unless c (return string)) 671 | (vector-push-extend c string)))))) 672 | ;; 673 | (with-open-stream (s (make-instance 'serial-stream :name name)) 674 | (sleep 5) 675 | (echo s) 676 | (echo s) 677 | (serial-write-exp "(defvar ers 0)" s) 678 | (echo s) 679 | (serial-write-exp 680 | "(defun aeq (tst x y) 681 | (unless (equal x y) 682 | (incf ers) 683 | (format t \"~a=~a/~a~%\" tst x y)))" 684 | s) 685 | (echo s) 686 | ;; 687 | ;; tests 688 | ;; 689 | (with-input-from-string (str *tests*) 690 | (loop 691 | (let ((line (read-line str nil nil))) 692 | (unless line (return)) 693 | (serial-write-exp line s) 694 | (let ((output (read-serial s))) 695 | (let* ((m1 (position #\return output)) 696 | (m2 (when m1 (position #\return output :start (+ 2 m1))))) 697 | (cond 698 | ((null m2) (format t "~a~%" output)) 699 | ((string= (subseq output (+ 2 m1) m2) "nil") nil) 700 | (t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1))))))))))))) -------------------------------------------------------------------------------- /arm.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | ; Arm 6 | 7 | (defparameter *title-arm* 8 | #"/* uLisp ARM Release ~a - www.ulisp.com 9 | David Johnson-Davies - www.technoblogy.com - ~a 10 | 11 | Licensed under the MIT license: https://opensource.org/licenses/MIT 12 | */"#) 13 | 14 | (defparameter *header-arm* #" 15 | // Lisp Library 16 | const char LispLibrary[] PROGMEM = ""; 17 | 18 | // Compile options 19 | 20 | // #define resetautorun 21 | #define printfreespace 22 | // #define printgcs 23 | // #define sdcardsupport 24 | // #define gfxsupport 25 | // #define lisplibrary 26 | #define assemblerlist 27 | // #define lineeditor 28 | // #define vt100 29 | // #define extensions 30 | 31 | // Includes 32 | 33 | // #include "LispLibrary.h" 34 | #include 35 | #include 36 | #include 37 | #include 38 | 39 | #if defined(sdcardsupport) 40 | #include 41 | #define SDSIZE 720 42 | #else 43 | #define SDSIZE 0 44 | #endif"#) 45 | 46 | (defparameter *workspace-arm* #" 47 | // Platform specific settings 48 | 49 | #define WORDALIGNED __attribute__((aligned (4))) 50 | #define BUFFERSIZE 36 // Number of bits+4 51 | #define RAMFUNC __attribute__ ((section (".ramfunctions"))) 52 | #define MEMBANK 53 | 54 | // ATSAMD21 boards *************************************************************** 55 | 56 | #if defined(ARDUINO_GEMMA_M0) || defined(ARDUINO_SEEED_XIAO_M0) || defined(ARDUINO_QTPY_M0) 57 | #define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */ 58 | #define CPUFLASH 59 | #define FLASHSIZE 32768 /* Bytes */ 60 | #define CODESIZE 128 /* Bytes */ 61 | #define STACKDIFF 320 62 | #define CPU_ATSAMD21 63 | 64 | #elif defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS) 65 | #define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */ 66 | #define DATAFLASH 67 | #define FLASHSIZE 2048000 /* 2 MBytes */ 68 | #define CODESIZE 128 /* Bytes */ 69 | #define STACKDIFF 320 70 | #define SDCARD_SS_PIN 4 71 | #define CPU_ATSAMD21 72 | 73 | #elif defined(ADAFRUIT_FEATHER_M0) /* Feather M0 without DataFlash */ 74 | #define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */ 75 | #define CPUFLASH 76 | #define FLASHSIZE 32768 /* Bytes */ 77 | #define CODESIZE 128 /* Bytes */ 78 | #define STACKDIFF 320 79 | #define SDCARD_SS_PIN 4 80 | #define CPU_ATSAMD21 81 | 82 | #elif defined(ARDUINO_SAMD_MKRZERO) 83 | #define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */ 84 | #define CPUFLASH 85 | #define FLASHSIZE 32768 /* Bytes */ 86 | #define CODESIZE 128 /* Bytes */ 87 | #define STACKDIFF 840 88 | #define CPU_ATSAMD21 89 | 90 | #elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */ 91 | #define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */ 92 | #define CPUFLASH 93 | #define FLASHSIZE 32768 /* Bytes */ 94 | #define CODESIZE 128 /* Bytes */ 95 | #define STACKDIFF 320 96 | #define SDCARD_SS_PIN 10 97 | #define CPU_ATSAMD21 98 | 99 | // ATSAMD51 boards *************************************************************** 100 | 101 | #elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) 102 | #define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */ 103 | #define DATAFLASH 104 | #define FLASHSIZE 2048000 /* 2 MBytes */ 105 | #define CODESIZE 256 /* Bytes */ 106 | #define STACKDIFF 400 107 | #define SDCARD_SS_PIN 10 108 | #define CPU_ATSAMD51 109 | 110 | #elif defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) 111 | #define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */ 112 | #define DATAFLASH 113 | #define FLASHSIZE 2048000 /* 2 MBytes */ 114 | #define CODESIZE 256 /* Bytes */ 115 | #define STACKDIFF 400 116 | #define SDCARD_SS_PIN 10 117 | #define CPU_ATSAMD51 118 | #if defined(gfxsupport) 119 | const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0, TFT_BACKLIGHT = 47; 120 | #include // Core graphics library 121 | #include // Hardware-specific library for ST7735 122 | Adafruit_ST7735 tft = Adafruit_ST7735(44, 45, 41, 42, 46); 123 | #endif 124 | 125 | #elif defined(ARDUINO_WIO_TERMINAL) 126 | #define WORKSPACESIZE (20480-SDSIZE) /* Objects (8*bytes) */ 127 | #define DATAFLASH 128 | #define FLASHSIZE 2048000 /* 2 MBytes */ 129 | #define CODESIZE 256 /* Bytes */ 130 | #define STACKDIFF 400 131 | #define CPU_ATSAMD51 132 | #define EXTERNAL_FLASH_USE_QSPI 133 | #if defined(gfxsupport) 134 | const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; 135 | #include // Hardware-specific library 136 | TFT_eSPI tft = TFT_eSPI(); 137 | #endif 138 | 139 | #elif defined(ARDUINO_GRAND_CENTRAL_M4) 140 | #define WORKSPACESIZE (28800-SDSIZE) /* Objects (8*bytes) */ 141 | #define DATAFLASH 142 | #define FLASHSIZE 8192000 /* 8 MBytes */ 143 | #define CODESIZE 256 /* Bytes */ 144 | #define STACKDIFF 440 145 | #define CPU_ATSAMD51 146 | 147 | // nRF51 boards *************************************************************** 148 | 149 | #elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_SINOBIT) 150 | #define WORKSPACESIZE 1344 /* Objects (8*bytes) */ 151 | #define CODESIZE 64 /* Bytes */ 152 | #define STACKDIFF 320 153 | #define CPU_NRF51822 154 | 155 | #elif defined(ARDUINO_CALLIOPE_MINI) 156 | #define WORKSPACESIZE 3392 /* Objects (8*bytes) */ 157 | #define CODESIZE 64 /* Bytes */ 158 | #define STACKDIFF 320 159 | #define CPU_NRF51822 160 | 161 | // nRF52 boards *************************************************************** 162 | 163 | #elif defined(ARDUINO_BBC_MICROBIT_V2) 164 | #define WORKSPACESIZE 12928 /* Objects (8*bytes) */ 165 | #define CODESIZE 128 /* Bytes */ 166 | #define STACKDIFF 320 167 | #define CPU_NRF52833 168 | 169 | #elif defined(ARDUINO_NRF52840_ITSYBITSY) || defined(ARDUINO_Seeed_XIAO_nRF52840) \ 170 | || defined(ARDUINO_Seeed_XIAO_nRF52840_Sense) || defined(ARDUINO_NRF52840_CIRCUITPLAY) 171 | #define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */ 172 | #define DATAFLASH 173 | #define FLASHSIZE 2048000 /* 2 MBytes */ 174 | #define CODESIZE 256 /* Bytes */ 175 | #define STACKDIFF 8 176 | #define CPU_NRF52840 177 | 178 | #elif defined(ARDUINO_NRF52840_CLUE) 179 | #define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */ 180 | #define DATAFLASH 181 | #define FLASHSIZE 2048000 /* 2 MBytes */ 182 | #define CODESIZE 256 /* Bytes */ 183 | #define STACKDIFF 8 184 | #define CPU_NRF52840 185 | #if defined(gfxsupport) 186 | const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; 187 | #include 188 | #include 189 | Adafruit_ST7789 tft = Adafruit_ST7789(&SPI1, PIN_TFT_CS, PIN_TFT_DC, PIN_TFT_RST); 190 | #endif 191 | 192 | // MAX32620 boards *************************************************************** 193 | 194 | #elif defined(MAX32620) 195 | #define WORKSPACESIZE (24704-SDSIZE) /* Objects (8*bytes) */ 196 | #define CODESIZE 256 /* Bytes */ 197 | #define STACKDIFF 320 198 | #define CPU_MAX32620 199 | #define Wire1 Wire2 200 | 201 | // iMXRT1062 boards *************************************************************** 202 | 203 | #elif defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) 204 | #define WORKSPACESIZE 60000 /* Objects (8*bytes) */ 205 | #define CODESIZE 256 /* Bytes */ 206 | #define STACKDIFF 15000 207 | #define LITTLEFS (960 * 1024) 208 | #include 209 | LittleFS_Program LittleFS; 210 | #define FS_FILE_WRITE FILE_WRITE_BEGIN 211 | #define FS_FILE_READ FILE_READ 212 | #define CPU_iMXRT1062 213 | #define SDCARD_SS_PIN BUILTIN_SDCARD 214 | #define BitOrder uint8_t 215 | #undef RAMFUNC 216 | #define RAMFUNC FASTRUN 217 | #undef MEMBANK 218 | #define MEMBANK DMAMEM 219 | 220 | // RP2040 boards *************************************************************** 221 | 222 | #elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \ 223 | || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040) 224 | #define WORKSPACESIZE (23000-SDSIZE) /* Objects (8*bytes) */ 225 | #define CODESIZE 256 /* Bytes */ 226 | #define STACKDIFF 480 227 | #define LITTLEFS 228 | #include 229 | #define FS_FILE_WRITE "w" 230 | #define FS_FILE_READ "r" 231 | #define CPU_RP2040 232 | #if defined(gfxsupport) 233 | const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; 234 | #include // Core graphics library 235 | #include // Hardware-specific library for ST7789 236 | Adafruit_ST7789 tft = Adafruit_ST7789(5, 1, 3, 2, 0); // TTGO RP2040 TFT 237 | #define TFT_BACKLIGHT 4 238 | #define TFT_I2C_POWER 22 239 | #endif 240 | 241 | #elif defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) 242 | #define WORKSPACESIZE 23000 /* Objects (8*bytes) */ 243 | #define CODESIZE 256 /* Bytes */ 244 | #define STACKDIFF 480 245 | #define LITTLEFS 246 | #include 247 | #define FS_FILE_WRITE "w" 248 | #define FS_FILE_READ "r" 249 | #define SDCARD_SS_PIN 23 250 | #define CPU_RP2040 251 | 252 | #elif defined(ARDUINO_RASPBERRY_PI_PICO_W) 253 | #define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */ 254 | #define CODESIZE 256 /* Bytes */ 255 | #define STACKDIFF 480 256 | #define LITTLEFS 257 | #include 258 | #include 259 | #define FS_FILE_WRITE "w" 260 | #define FS_FILE_READ "r" 261 | #define CPU_RP2040 262 | 263 | // RP2350 boards *************************************************************** 264 | 265 | #elif defined(ARDUINO_RASPBERRY_PI_PICO_2) 266 | #if defined(__riscv) 267 | #define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */ 268 | #define STACKDIFF 580 269 | #else 270 | #define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */ 271 | #define STACKDIFF 520 272 | #endif 273 | #define CODESIZE 256 /* Bytes */ 274 | #define LITTLEFS 275 | #include 276 | #define FS_FILE_WRITE "w" 277 | #define FS_FILE_READ "r" 278 | #define CPU_RP2350 279 | 280 | #elif defined(ARDUINO_PIMORONI_PICO_PLUS_2) 281 | //#define BOARD_HAS_PSRAM /* Uncomment to use PSRAM */ 282 | #if defined(BOARD_HAS_PSRAM) 283 | #undef MEMBANK 284 | #define MEMBANK PSRAM 285 | #define WORKSPACESIZE 1000000 /* Objects (8*bytes) */ 286 | #define STACKDIFF 580 287 | #elif defined(__riscv) 288 | #define WORKSPACESIZE (42000-SDSIZE) /* Objects (8*bytes) */ 289 | #define STACKDIFF 580 290 | #else 291 | #define WORKSPACESIZE (46500-SDSIZE) /* Objects (8*bytes) */ 292 | #define STACKDIFF 520 293 | #endif 294 | #define CODESIZE 256 /* Bytes */ 295 | #define LITTLEFS 296 | #include 297 | #define FS_FILE_WRITE "w" 298 | #define FS_FILE_READ "r" 299 | #define SDCARD_SS_PIN 10 300 | #define CPU_RP2350 301 | 302 | #elif defined(ARDUINO_PIMORONI_TINY2350) 303 | #if defined(__riscv) 304 | #define WORKSPACESIZE (42500-SDSIZE) /* Objects (8*bytes) */ 305 | #define STACKDIFF 580 306 | #else 307 | #define WORKSPACESIZE (47000-SDSIZE) /* Objects (8*bytes) */ 308 | #define STACKDIFF 520 309 | #endif 310 | #define CODESIZE 256 /* Bytes */ 311 | #define LITTLEFS 312 | #include 313 | #define FS_FILE_WRITE "w" 314 | #define FS_FILE_READ "r" 315 | #define CPU_RP2350 316 | 317 | // RA4M1 boards *************************************************************** 318 | 319 | #elif defined(ARDUINO_MINIMA) 320 | #define WORKSPACESIZE (2032-SDSIZE) /* Objects (8*bytes) */ 321 | #include 322 | #define EEPROMFLASH 323 | #define FLASHSIZE 8192 /* Bytes */ 324 | #define CODESIZE 128 /* Bytes */ 325 | #define STACKDIFF 320 326 | #define eAnalogReference ar_aref 327 | #define CPU_RA4M1 328 | #define SDCARD_SS_PIN 10 329 | 330 | #elif defined(ARDUINO_UNOWIFIR4) 331 | #define WORKSPACESIZE (1610-SDSIZE) /* Objects (8*bytes) */ 332 | #include 333 | #include "WiFiS3.h" 334 | #define EEPROMFLASH 335 | #define FLASHSIZE 8192 /* Bytes */ 336 | #define CODESIZE 128 /* Bytes */ 337 | #define STACKDIFF 320 338 | #define eAnalogReference ar_aref 339 | #define CPU_RA4M1 340 | #define SDCARD_SS_PIN 10 341 | 342 | #else 343 | #error "Board not supported!" 344 | #endif"#) 345 | 346 | (defparameter *check-pins-arm* #" 347 | // Check pins - these are board-specific not processor-specific 348 | 349 | void checkanalogread (int pin) { 350 | #if defined(ARDUINO_SAM_DUE) 351 | if (!(pin>=54 && pin<=65)) error(invalidpin, number(pin)); 352 | #elif defined(ARDUINO_SAMD_ZERO) 353 | if (!(pin>=14 && pin<=19)) error(invalidpin, number(pin)); 354 | #elif defined(ARDUINO_SAMD_MKRZERO) 355 | if (!(pin>=15 && pin<=21)) error(invalidpin, number(pin)); 356 | #elif defined(ARDUINO_ITSYBITSY_M0) 357 | if (!(pin>=14 && pin<=25)) error(invalidpin, number(pin)); 358 | #elif defined(ARDUINO_NEOTRINKEY_M0) 359 | if (!(pin==1 || pin==2 || pin==6)) error(invalidpin, number(pin)); 360 | #elif defined(ARDUINO_GEMMA_M0) 361 | if (!(pin>=8 && pin<=10)) error(invalidpin, number(pin)); 362 | #elif defined(ARDUINO_QTPY_M0) 363 | if (!((pin>=0 && pin<=3) || (pin>=6 && pin<=10))) error(invalidpin, number(pin)); 364 | #elif defined(ARDUINO_SEEED_XIAO_M0) 365 | if (!(pin>=0 && pin<=10)) error(invalidpin, number(pin)); 366 | #elif defined(ARDUINO_METRO_M4) 367 | if (!(pin>=14 && pin<=21)) error(invalidpin, number(pin)); 368 | #elif defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) 369 | if (!(pin>=14 && pin<=20)) error(invalidpin, number(pin)); 370 | #elif defined(ARDUINO_PYBADGE_M4) 371 | if (!(pin>=14 && pin<=23)) error(invalidpin, number(pin)); 372 | #elif defined(ARDUINO_PYGAMER_M4) 373 | if (!(pin>=14 && pin<=25)) error(invalidpin, number(pin)); 374 | #elif defined(ARDUINO_WIO_TERMINAL) 375 | if (!((pin>=0 && pin<=8))) error(invalidpin, number(pin)); 376 | #elif defined(ARDUINO_GRAND_CENTRAL_M4) 377 | if (!((pin>=67 && pin<=74) || (pin>=54 && pin<=61))) error(invalidpin, number(pin)); 378 | #elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_SINOBIT) 379 | if (!((pin>=0 && pin<=4) || pin==10)) error(invalidpin, number(pin)); 380 | #elif defined(ARDUINO_BBC_MICROBIT_V2) 381 | if (!((pin>=0 && pin<=4) || pin==10 || pin==29)) error(invalidpin, number(pin)); 382 | #elif defined(ARDUINO_CALLIOPE_MINI) 383 | if (!(pin==1 || pin==2 || (pin>=4 && pin<=6) || pin==21)) error(invalidpin, number(pin)); 384 | #elif defined(ARDUINO_NRF52840_ITSYBITSY) 385 | if (!(pin>=14 && pin<=20)) error(invalidpin, number(pin)); 386 | #elif defined(ARDUINO_Seeed_XIAO_nRF52840) || defined(ARDUINO_Seeed_XIAO_nRF52840_Sense) 387 | if (!(pin>=0 && pin<=5)) error(invalidpin, number(pin)); 388 | #elif defined(ARDUINO_NRF52840_CLUE) 389 | if (!((pin>=0 && pin<=4) || pin==10 || pin==12 || pin==16)) error(invalidpin, number(pin)); 390 | #elif defined(ARDUINO_NRF52840_CIRCUITPLAY) 391 | if (!(pin==0 || (pin>=2 && pin<=3) || pin==6 || (pin>=9 && pin<=10) || (pin>=22 && pin<=23))) error(invalidpin, number(pin)); 392 | #elif defined(MAX32620) 393 | if (!(pin>=49 && pin<=52)) error(invalidpin, number(pin)); 394 | #elif defined(ARDUINO_TEENSY40) 395 | if (!((pin>=14 && pin<=27))) error(invalidpin, number(pin)); 396 | #elif defined(ARDUINO_TEENSY41) 397 | if (!((pin>=14 && pin<=27) || (pin>=38 && pin<=41))) error(invalidpin, number(pin)); 398 | #elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \ 399 | || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) \ 400 | || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040) \ 401 | || defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 402 | if (!(pin>=26 && pin<=29)) error(invalidpin, number(pin)); 403 | #elif defined(ARDUINO_MINIMA) || defined(ARDUINO_UNOWIFIR4) 404 | if (!((pin>=14 && pin<=21))) error(invalidpin, number(pin)); 405 | #endif 406 | } 407 | 408 | void checkanalogwrite (int pin) { 409 | #if defined(ARDUINO_SAM_DUE) 410 | if (!((pin>=2 && pin<=13) || pin==66 || pin==67)) error(invalidpin, number(pin)); 411 | #elif defined(ARDUINO_SAMD_ZERO) 412 | if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || pin==14)) error(invalidpin, number(pin)); 413 | #elif defined(ARDUINO_SAMD_MKRZERO) 414 | if (!((pin>=0 && pin<=8) || pin==10 || pin==18 || pin==19)) error(invalidpin, number(pin)); 415 | #elif defined(ARDUINO_ITSYBITSY_M0) 416 | if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || (pin>=15 && pin<=16) || (pin>=22 && pin<=25))) error(invalidpin, number(pin)); 417 | #elif defined(ARDUINO_NEOTRINKEY_M0) 418 | error2("not supported"); 419 | #elif defined(ARDUINO_GEMMA_M0) 420 | if (!(pin==0 || pin==2 || pin==9 || pin==10)) error(invalidpin, number(pin)); 421 | #elif defined(ARDUINO_QTPY_M0) 422 | if (!(pin==0 || (pin>=2 && pin<=10))) error(invalidpin, number(pin)); 423 | #elif defined(ARDUINO_SEEED_XIAO_M0) 424 | if (!(pin>=0 && pin<=10)) error(invalidpin, number(pin)); 425 | #elif defined(ARDUINO_METRO_M4) 426 | if (!(pin>=0 && pin<=15)) error(invalidpin, number(pin)); 427 | #elif defined(ARDUINO_ITSYBITSY_M4) 428 | if (!(pin==0 || pin==1 || pin==4 || pin==5 || pin==7 || (pin>=9 && pin<=15) || pin==21 || pin==22)) error(invalidpin, number(pin)); 429 | #elif defined(ARDUINO_FEATHER_M4) 430 | 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)); 431 | #elif defined(ARDUINO_PYBADGE_M4) 432 | if (!(pin==4 || pin==7 || pin==9 || (pin>=12 && pin<=13) || (pin>=24 && pin<=25) || (pin>=46 && pin<=47))) error(invalidpin, number(pin)); 433 | #elif defined(ARDUINO_PYGAMER_M4) 434 | if (!(pin==4 || pin==7 || pin==9 || (pin>=12 && pin<=13) || (pin>=26 && pin<=27) || (pin>=46 && pin<=47))) error(invalidpin, number(pin)); 435 | #elif defined(ARDUINO_WIO_TERMINAL) 436 | if (!((pin>=0 && pin<=2) || pin==6 || pin==8 || (pin>=12 && pin<=20) || pin==24)) error(invalidpin, number(pin)); 437 | #elif defined(ARDUINO_GRAND_CENTRAL_M4) 438 | 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)); 439 | #elif defined(ARDUINO_BBC_MICROBIT) || defined(ARDUINO_BBC_MICROBIT_V2) || defined(ARDUINO_SINOBIT) 440 | if (!(pin>=0 && pin<=32)) error(invalidpin, number(pin)); 441 | #elif defined(ARDUINO_CALLIOPE_MINI) 442 | if (!(pin>=0 && pin<=30)) error(invalidpin, number(pin)); 443 | #elif defined(ARDUINO_NRF52840_ITSYBITSY) 444 | if (!(pin>=0 && pin<=25)) error(invalidpin, number(pin)); 445 | #elif defined(ARDUINO_NRF52840_CLUE) 446 | if (!(pin>=0 && pin<=46)) error(invalidpin, number(pin)); 447 | #elif defined(ARDUINO_NRF52840_CIRCUITPLAY) 448 | if (!(pin>=0 && pin<=35)) error(invalidpin, number(pin)); 449 | #elif defined(MAX32620) 450 | if (!((pin>=20 && pin<=29) || pin==32 || (pin>=40 && pin<=48))) error(invalidpin, number(pin)); 451 | #elif defined(ARDUINO_TEENSY40) 452 | 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)); 453 | #elif defined(ARDUINO_TEENSY41) 454 | 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)); 455 | #elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \ 456 | || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \ 457 | || defined(ARDUINO_SEEED_XIAO_RP2040) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \ 458 | || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 459 | if (!(pin>=0 && pin<=29)) error(invalidpin, number(pin)); 460 | #elif defined(ARDUINO_RASPBERRY_PI_PICO_W) 461 | if (!((pin>=0 && pin<=29) || pin == 32)) error(invalidpin, number(pin)); 462 | #elif defined(ARDUINO_MINIMA) || defined(ARDUINO_UNOWIFIR4) 463 | if (!((pin>=0 && pin<=21))) error(invalidpin, number(pin)); 464 | #endif 465 | }"#) 466 | 467 | (defparameter *note-arm* #" 468 | // Note 469 | 470 | const int scale[] = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; 471 | 472 | void playnote (int pin, int note, int octave) { 473 | #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_NRF52840_CIRCUITPLAY) \ 474 | || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \ 475 | || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) \ 476 | || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_WIO_TERMINAL) \ 477 | || defined(ARDUINO_SEEED_XIAO_RP2040) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \ 478 | || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 479 | int oct = octave + note/12; 480 | int prescaler = 8 - oct; 481 | if (prescaler<0 || prescaler>8) error("octave out of range", number(oct)); 482 | tone(pin, scale[note%12]>>prescaler); 483 | #else 484 | (void) pin, (void) note, (void) octave; 485 | #endif 486 | } 487 | 488 | void nonote (int pin) { 489 | #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_NRF52840_CIRCUITPLAY) \ 490 | || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \ 491 | || defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \ 492 | || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040_ADALOGGER) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) \ 493 | || defined(ARDUINO_WIO_TERMINAL) || defined(ARDUINO_SEEED_XIAO_RP2040) \ 494 | || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 495 | noTone(pin); 496 | #else 497 | (void) pin; 498 | #endif 499 | }"#) 500 | 501 | (defparameter *sleep-arm* #" 502 | // Sleep 503 | 504 | #if defined(CPU_ATSAMD21) 505 | void WDT_Handler(void) { 506 | // ISR for watchdog early warning 507 | WDT->CTRL.bit.ENABLE = 0; // Disable watchdog 508 | while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write 509 | WDT->INTFLAG.bit.EW = 1; // Clear interrupt flag 510 | } 511 | #endif 512 | 513 | void initsleep () { 514 | #if defined(CPU_ATSAMD21) 515 | // One-time initialization of watchdog timer. 516 | 517 | // Generic clock generator 2, divisor = 32 (2^(DIV+1)) 518 | GCLK->GENDIV.reg = GCLK_GENDIV_ID(2) | GCLK_GENDIV_DIV(4); 519 | // Enable clock generator 2 using low-power 32KHz oscillator. 520 | // With /32 divisor above, this yields 1024Hz clock. 521 | GCLK->GENCTRL.reg = GCLK_GENCTRL_ID(2) | 522 | GCLK_GENCTRL_GENEN | 523 | GCLK_GENCTRL_SRC_OSCULP32K | 524 | GCLK_GENCTRL_DIVSEL; 525 | while(GCLK->STATUS.bit.SYNCBUSY); 526 | // WDT clock = clock gen 2 527 | GCLK->CLKCTRL.reg = GCLK_CLKCTRL_ID_WDT | 528 | GCLK_CLKCTRL_CLKEN | 529 | GCLK_CLKCTRL_GEN_GCLK2; 530 | 531 | // Enable WDT early-warning interrupt 532 | NVIC_DisableIRQ(WDT_IRQn); 533 | NVIC_ClearPendingIRQ(WDT_IRQn); 534 | NVIC_SetPriority(WDT_IRQn, 0); // Top priority 535 | NVIC_EnableIRQ(WDT_IRQn); 536 | #endif 537 | } 538 | 539 | void doze (int secs) { 540 | #if defined(CPU_ATSAMD21) 541 | WDT->CTRL.reg = 0; // Disable watchdog for config 542 | while(WDT->STATUS.bit.SYNCBUSY); 543 | WDT->INTENSET.bit.EW = 1; // Enable early warning interrupt 544 | WDT->CONFIG.bit.PER = 0xB; // Period = max 545 | WDT->CONFIG.bit.WINDOW = 0x7; // Set time of interrupt = 1024 cycles = 1 sec 546 | WDT->CTRL.bit.WEN = 1; // Enable window mode 547 | while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write 548 | 549 | SysTick->CTRL = 0; // Stop SysTick interrupts 550 | 551 | while (secs > 0) { 552 | WDT->CLEAR.reg = WDT_CLEAR_CLEAR_KEY;// Clear watchdog interval 553 | while(WDT->STATUS.bit.SYNCBUSY); 554 | WDT->CTRL.bit.ENABLE = 1; // Start watchdog now! 555 | while(WDT->STATUS.bit.SYNCBUSY); 556 | SCB->SCR |= SCB_SCR_SLEEPDEEP_Msk; // Deepest sleep 557 | __DSB(); 558 | __WFI(); // Wait for interrupt 559 | secs--; 560 | } 561 | SysTick->CTRL = 7; // Restart SysTick interrupts 562 | #else 563 | delay(1000*secs); 564 | #endif 565 | }"#) 566 | 567 | (defparameter *keywords-arm* 568 | '((nil 569 | ((NIL LED_BUILTIN) 570 | (DIGITALWRITE HIGH LOW))) 571 | ("CPU_ATSAMD21" 572 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 573 | (ANALOGREFERENCE AR_DEFAULT AR_INTERNAL1V0 AR_INTERNAL1V65 AR_INTERNAL2V23 AR_EXTERNAL) 574 | (REGISTER (PA_DIR "PORT->Group[0].DIR.reg") (PA_DIRCLR "PORT->Group[0].DIRCLR.reg") (PA_DIRSET "PORT->Group[0].DIRSET.reg") 575 | (PA_DIRTGL "PORT->Group[0].DIRTGL.reg") (PA_OUT "PORT->Group[0].OUT.reg") (PA_OUTCLR "PORT->Group[0].OUTCLR.reg") 576 | (PA_OUTSET "PORT->Group[0].OUTSET.reg") (PA_OUTTGL "PORT->Group[0].OUTTGL.reg") (PA_IN "PORT->Group[0].IN.reg") 577 | (PB_DIR "PORT->Group[1].DIR.reg") (PB_DIRCLR "PORT->Group[1].DIRCLR.reg") (PB_DIRSET "PORT->Group[1].DIRSET.reg") 578 | (PB_DIRTGL "PORT->Group[1].DIRTGL.reg") (PB_OUT "PORT->Group[1].OUT.reg") (PB_OUTCLR "PORT->Group[1].OUTCLR.reg") 579 | (PB_OUTSET "PORT->Group[1].OUTSET.reg") (PB_OUTTGL "PORT->Group[1].OUTTGL.reg") (PB_IN "PORT->Group[1].IN.reg")))) 580 | ("CPU_ATSAMD51" 581 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 582 | (ANALOGREFERENCE AR_DEFAULT AR_INTERNAL1V0 AR_INTERNAL1V1 AR_INTERNAL1V2 AR_INTERNAL1V25 AR_INTERNAL1V65 AR_INTERNAL2V0 583 | AR_INTERNAL2V2 AR_INTERNAL2V23 AR_INTERNAL2V4 AR_INTERNAL2V5 AR_EXTERNAL) 584 | (REGISTER (PA_DIR "PORT->Group[0].DIR.reg") (PA_DIRCLR "PORT->Group[0].DIRCLR.reg") (PA_DIRSET "PORT->Group[0].DIRSET.reg") 585 | (PA_DIRTGL "PORT->Group[0].DIRTGL.reg") (PA_OUT "PORT->Group[0].OUT.reg") (PA_OUTCLR "PORT->Group[0].OUTCLR.reg") 586 | (PA_OUTSET "PORT->Group[0].OUTSET.reg") (PA_OUTTGL "PORT->Group[0].OUTTGL.reg") (PA_IN "PORT->Group[0].IN.reg") 587 | (PB_DIR "PORT->Group[1].DIR.reg") (PB_DIRCLR "PORT->Group[1].DIRCLR.reg") (PB_DIRSET "PORT->Group[1].DIRSET.reg") 588 | (PB_DIRTGL "PORT->Group[1].DIRTGL.reg") (PB_OUT "PORT->Group[1].OUT.reg") (PB_OUTCLR "PORT->Group[1].OUTCLR.reg") 589 | (PB_OUTSET "PORT->Group[1].OUTSET.reg") (PB_OUTTGL "PORT->Group[1].OUTTGL.reg") (PB_IN "PORT->Group[1].IN.reg")))) 590 | ("CPU_NRF51822" 591 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 592 | (ANALOGREFERENCE AR_DEFAULT AR_VBG AR_SUPPLY_ONE_HALF AR_SUPPLY_ONE_THIRD AR_EXT0 AR_EXT1) 593 | (REGISTER (P0_OUT "NRF_GPIO->OUT") (P0_OUTSET "NRF_GPIO->OUTSET") (P0_OUTCLR "NRF_GPIO->OUTCLR") (P0_IN "NRF_GPIO->IN") 594 | (P0_DIR "NRF_GPIO->DIR") (P0_DIRSET "NRF_GPIO->DIRSET") (P0_DIRCLR "NRF_GPIO->DIRCLR")))) 595 | ("CPU_NRF52840" 596 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 597 | (ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_INTERNAL_3_0 AR_INTERNAL_2_4 AR_INTERNAL_1_8 AR_INTERNAL_1_2 AR_VDD4) 598 | (REGISTER (P0_OUT "NRF_P0->OUT") (P0_OUTSET "NRF_P0->OUTSET") (P0_OUTCLR "NRF_P0->OUTCLR") (P0_IN "NRF_P0->IN") 599 | (P0_DIR "NRF_P0->DIR") (P0_DIRSET "NRF_P0->DIRSET") (P0_DIRCLR "NRF_P0->DIRCLR") 600 | (P1_OUT "NRF_P1->OUT") (P1_OUTSET "NRF_P1->OUTSET") (P1_OUTCLR "NRF_P1->OUTCLR") (P1_IN "NRF_P1->IN") 601 | (P1_DIR "NRF_P1->DIR") (P1_DIRSET "NRF_P1->DIRSET") (P1_DIRCLR "NRF_P1->DIRCLR")))) 602 | ("CPU_NRF52833" 603 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 604 | (ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_VDD4) 605 | (REGISTER (P0_OUT "NRF_P0->OUT") (P0_OUTSET "NRF_P0->OUTSET") (P0_OUTCLR "NRF_P0->OUTCLR") (P0_IN "NRF_P0->IN") 606 | (P0_DIR "NRF_P0->DIR") (P0_DIRSET "NRF_P0->DIRSET") (P0_DIRCLR "NRF_P0->DIRCLR") 607 | (P1_OUT "NRF_P1->OUT") (P1_OUTSET "NRF_P1->OUTSET") (P1_OUTCLR "NRF_P1->OUTCLR") (P1_IN "NRF_P1->IN") 608 | (P1_DIR "NRF_P1->DIR") (P1_DIRSET "NRF_P1->DIRSET") (P1_DIRCLR "NRF_P1->DIRCLR")))) 609 | ("CPU_iMXRT1062" 610 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT OUTPUT_OPENDRAIN))) 611 | ("CPU_MAX32620" 612 | ((PINMODE INPUT INPUT_PULLUP OUTPUT) 613 | (ANALOGREFERENCE DEFAULT EXTERNAL))) 614 | ("CPU_RP2040" 615 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 616 | (REGISTER (GPIO_IN "(SIO_BASE+SIO_GPIO_IN_OFFSET)") (GPIO_OUT "(SIO_BASE+SIO_GPIO_OUT_OFFSET)") 617 | (GPIO_OUT_SET "(SIO_BASE+SIO_GPIO_OUT_SET_OFFSET)") (GPIO_OUT_CLR "(SIO_BASE+SIO_GPIO_OUT_CLR_OFFSET)") 618 | (GPIO_OUT_XOR "(SIO_BASE+SIO_GPIO_OUT_XOR_OFFSET)") (GPIO_OE "(SIO_BASE+SIO_GPIO_OE_OFFSET)") 619 | (GPIO_OE_SET "(SIO_BASE+SIO_GPIO_OE_SET_OFFSET)") (GPIO_OE_CLR "(SIO_BASE+SIO_GPIO_OE_CLR_OFFSET)") 620 | (GPIO_OE_XOR "(SIO_BASE+SIO_GPIO_OE_XOR_OFFSET)")))) 621 | ("CPU_RP2350" 622 | ((PINMODE INPUT INPUT_PULLUP INPUT_PULLDOWN OUTPUT) 623 | (REGISTER (GPIO_IN "(SIO_BASE+SIO_GPIO_IN_OFFSET)") (GPIO_OUT "(SIO_BASE+SIO_GPIO_OUT_OFFSET)") 624 | (GPIO_OUT_SET "(SIO_BASE+SIO_GPIO_OUT_SET_OFFSET)") (GPIO_OUT_CLR "(SIO_BASE+SIO_GPIO_OUT_CLR_OFFSET)") 625 | (GPIO_OUT_XOR "(SIO_BASE+SIO_GPIO_OUT_XOR_OFFSET)") (GPIO_OE "(SIO_BASE+SIO_GPIO_OE_OFFSET)") 626 | (GPIO_OE_SET "(SIO_BASE+SIO_GPIO_OE_SET_OFFSET)") (GPIO_OE_CLR "(SIO_BASE+SIO_GPIO_OE_CLR_OFFSET)") 627 | (GPIO_OE_XOR "(SIO_BASE+SIO_GPIO_OE_XOR_OFFSET)")))) 628 | ("CPU_RA4M1" 629 | ((PINMODE INPUT INPUT_PULLUP OUTPUT OUTPUT_OPENDRAIN) 630 | (ANALOGREFERENCE AR_DEFAULT AR_INTERNAL AR_EXTERNAL))))) -------------------------------------------------------------------------------- /streams.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: cl-user -*- 2 | 3 | (in-package :cl-user) 4 | 5 | (defparameter *i2c-interface* '( 6 | 7 | #+avr-nano 8 | #" 9 | // I2C interface for AVR platforms, uses much less RAM than Arduino Wire 10 | 11 | #if defined(CPU_ATmega328P) 12 | uint8_t const TWI_SDA_PIN = 18; 13 | uint8_t const TWI_SCL_PIN = 19; 14 | #elif defined(CPU_ATmega1280) || defined(CPU_ATmega2560) 15 | uint8_t const TWI_SDA_PIN = 20; 16 | uint8_t const TWI_SCL_PIN = 21; 17 | #elif defined(CPU_ATmega644P) || defined(CPU_ATmega1284P) 18 | uint8_t const TWI_SDA_PIN = 17; 19 | uint8_t const TWI_SCL_PIN = 16; 20 | #elif defined(CPU_ATmega32U4) 21 | uint8_t const TWI_SDA_PIN = 6; 22 | uint8_t const TWI_SCL_PIN = 5; 23 | #endif 24 | 25 | #if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28) 26 | uint32_t const FREQUENCY = 400000L; // Hardware I2C clock in Hz 27 | uint32_t const T_RISE = 300L; // Rise time 28 | #else 29 | uint32_t const F_TWI = 400000L; // Hardware I2C clock in Hz 30 | uint8_t const TWSR_MTX_DATA_ACK = 0x28; 31 | uint8_t const TWSR_MTX_ADR_ACK = 0x18; 32 | uint8_t const TWSR_MRX_ADR_ACK = 0x40; 33 | uint8_t const TWSR_START = 0x08; 34 | uint8_t const TWSR_REP_START = 0x10; 35 | uint8_t const I2C_READ = 1; 36 | uint8_t const I2C_WRITE = 0; 37 | #endif 38 | 39 | void I2Cinit (bool enablePullup) { 40 | #if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28) 41 | #if defined(CPU_ATmega4809) 42 | if (enablePullup) { 43 | pinMode(SDA, INPUT_PULLUP); 44 | pinMode(SCL, INPUT_PULLUP); 45 | } 46 | #else 47 | (void) enablePullup; 48 | #endif 49 | uint32_t baud = ((F_CPU/FREQUENCY) - (((F_CPU*T_RISE)/1000)/1000)/1000 - 10)/2; 50 | TWI0.MBAUD = (uint8_t)baud; 51 | TWI0.MCTRLA = TWI_ENABLE_bm; // Enable as master, no interrupts 52 | TWI0.MSTATUS = TWI_BUSSTATE_IDLE_gc; 53 | #else 54 | TWSR = 0; // no prescaler 55 | TWBR = (F_CPU/F_TWI - 16)/2; // set bit rate factor 56 | if (enablePullup) { 57 | digitalWrite(SDA, HIGH); 58 | digitalWrite(SCL, HIGH); 59 | } 60 | #endif 61 | } 62 | 63 | int I2Cread () { 64 | #if defined(CPU_ATmega4809) || defined(CPU_ATtiny3227) || defined(CPU_AVR64DD28) 65 | if (I2Ccount != 0) I2Ccount--; 66 | while (!(TWI0.MSTATUS & TWI_RIF_bm)); // Wait for read interrupt flag 67 | uint8_t data = TWI0.MDATA; 68 | // Check slave sent ACK? 69 | if (I2Ccount != 0) TWI0.MCTRLB = TWI_MCMD_RECVTRANS_gc; // ACK = more bytes to read 70 | else TWI0.MCTRLB = TWI_ACKACT_NACK_gc; // Send NAK 71 | return data; 72 | #else 73 | if (I2Ccount != 0) I2Ccount--; 74 | TWCR = 1<begin(); 262 | } 263 | 264 | int I2Cread (TwoWire *port) { 265 | return port->read(); 266 | } 267 | 268 | void I2Cwrite (TwoWire *port, uint8_t data) { 269 | port->write(data); 270 | } 271 | 272 | bool I2Cstart (TwoWire *port, uint8_t address, uint8_t read) { 273 | int ok = true; 274 | if (read == 0) { 275 | port->beginTransmission(address); 276 | ok = (port->endTransmission(true) == 0); 277 | port->beginTransmission(address); 278 | } 279 | else port->requestFrom(address, I2Ccount); 280 | return ok; 281 | } 282 | 283 | bool I2Crestart (TwoWire *port, uint8_t address, uint8_t read) { 284 | int error = (port->endTransmission(false) != 0); 285 | if (read == 0) port->beginTransmission(address); 286 | else port->requestFrom(address, I2Ccount); 287 | return error ? false : true; 288 | } 289 | 290 | void I2Cstop (TwoWire *port, uint8_t read) { 291 | if (read == 0) port->endTransmission(); // Check for error? 292 | // Release pins 293 | port->end(); 294 | }"# 295 | 296 | #-(or avr avr-nano badge arm esp) 297 | #" 298 | // I2C interface for one port, using Arduino Wire 299 | 300 | void I2Cinit (bool enablePullup) { 301 | (void) enablePullup; 302 | Wire.begin(); 303 | } 304 | 305 | int I2Cread () { 306 | return Wire.read(); 307 | } 308 | 309 | void I2Cwrite (uint8_t data) { 310 | Wire.write(data); 311 | } 312 | 313 | bool I2Cstart (uint8_t address, uint8_t read) { 314 | int ok = true; 315 | if (read == 0) { 316 | Wire.beginTransmission(address); 317 | ok = (Wire.endTransmission(true) == 0); 318 | Wire.beginTransmission(address); 319 | } 320 | else Wire.requestFrom(address, I2Ccount); 321 | return ok; 322 | } 323 | 324 | bool I2Crestart (uint8_t address, uint8_t read) { 325 | int error = (Wire.endTransmission(false) != 0); 326 | if (read == 0) Wire.beginTransmission(address); 327 | else Wire.requestFrom(address, I2Ccount); 328 | return error ? false : true; 329 | } 330 | 331 | void I2Cstop (uint8_t read) { 332 | if (read == 0) Wire.endTransmission(); // Check for error? 333 | }"# 334 | 335 | #+badge 336 | #" 337 | // I2C interface for AVR platforms, uses much less RAM than Arduino Wire 338 | 339 | uint8_t const TWI_SDA_PIN = 17; 340 | uint8_t const TWI_SCL_PIN = 16; 341 | 342 | uint32_t const F_TWI = 400000L; // Hardware I2C clock in Hz 343 | uint8_t const TWSR_MTX_DATA_ACK = 0x28; 344 | uint8_t const TWSR_MTX_ADR_ACK = 0x18; 345 | uint8_t const TWSR_MRX_ADR_ACK = 0x40; 346 | uint8_t const TWSR_START = 0x08; 347 | uint8_t const TWSR_REP_START = 0x10; 348 | uint8_t const I2C_READ = 1; 349 | uint8_t const I2C_WRITE = 0; 350 | 351 | void I2Cinit (bool enablePullup) { 352 | TWSR = 0; // no prescaler 353 | TWBR = (F_CPU/F_TWI - 16)/2; // set bit rate factor 354 | if (enablePullup) { 355 | digitalWrite(TWI_SDA_PIN, HIGH); 356 | digitalWrite(TWI_SCL_PIN, HIGH); 357 | } 358 | } 359 | 360 | int I2Cread () { 361 | if (I2Ccount != 0) I2Ccount--; 362 | TWCR = 1<>8; address = stream & 0xFF; 464 | } 465 | if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread; 466 | else if (streamtype == SPISTREAM) gfun = spiread; 467 | else if (streamtype == SERIALSTREAM) { 468 | if (address == 0) gfun = gserial; 469 | #if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48) 470 | else if (address == 1) gfun = serial1read; 471 | #elif defined(CPU_ATmega2560) 472 | else if (address == 1) gfun = serial1read; 473 | else if (address == 2) gfun = serial2read; 474 | else if (address == 3) gfun = serial3read; 475 | #endif 476 | } 477 | #if defined(sdcardsupport) 478 | else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread; 479 | #endif 480 | else error2(unknownstreamtype); 481 | return gfun; 482 | } 483 | 484 | inline void spiwrite (char c) { SPI.transfer(c); } 485 | #if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48) 486 | inline void serial1write (char c) { Serial1.write(c); } 487 | #elif defined(CPU_ATmega2560) 488 | inline void serial1write (char c) { Serial1.write(c); } 489 | inline void serial2write (char c) { Serial2.write(c); } 490 | inline void serial3write (char c) { Serial3.write(c); } 491 | #endif 492 | #if defined(sdcardsupport) 493 | inline void SDwrite (char c) { int w = SDpfile.write(c); if (w != 1) { Context = NIL; error2(PSTR("failed to write to file")); } } 494 | #endif 495 | 496 | pfun_t pstreamfun (object *args) { 497 | int streamtype = SERIALSTREAM; 498 | int address = 0; 499 | pfun_t pfun = pserial; 500 | if (args != NULL && first(args) != NULL) { 501 | int stream = isstream(first(args)); 502 | streamtype = stream>>8; address = stream & 0xFF; 503 | } 504 | if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite; 505 | else if (streamtype == SPISTREAM) pfun = spiwrite; 506 | else if (streamtype == SERIALSTREAM) { 507 | if (address == 0) pfun = pserial; 508 | #if defined(CPU_ATmega1284P) || defined(CPU_AVR128DX48) 509 | else if (address == 1) pfun = serial1write; 510 | #elif defined(CPU_ATmega2560) 511 | else if (address == 1) pfun = serial1write; 512 | else if (address == 2) pfun = serial2write; 513 | else if (address == 3) pfun = serial3write; 514 | #endif 515 | } 516 | else if (streamtype == STRINGSTREAM) { 517 | pfun = pstr; 518 | } 519 | #if defined(sdcardsupport) 520 | else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite; 521 | #endif 522 | else error2(unknownstreamtype); 523 | return pfun; 524 | }"# 525 | 526 | #+arm 527 | #" 528 | // Streams 529 | 530 | // Simplify board differences 531 | #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) \ 532 | || defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) || defined(ARDUINO_TEENSY40) \ 533 | || defined(ARDUINO_TEENSY41) || defined(ARDUINO_RASPBERRY_PI_PICO) \ 534 | || defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_RASPBERRY_PI_PICO_2) \ 535 | || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 536 | #define ULISP_SPI1 537 | #endif 538 | #if defined(ARDUINO_WIO_TERMINAL) || defined(ARDUINO_BBC_MICROBIT_V2) \ 539 | || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) \ 540 | || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \ 541 | || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) \ 542 | || defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2) \ 543 | || defined(ARDUINO_GRAND_CENTRAL_M4) || defined(ARDUINO_NRF52840_CIRCUITPLAY) 544 | #define ULISP_I2C1 545 | #endif 546 | #if defined(ARDUINO_SAM_DUE) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) 547 | #define ULISP_SERIAL3 548 | #elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) \ 549 | || defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_PIMORONI_PICO_PLUS_2) 550 | #define ULISP_SERIAL2 551 | #elif !defined(CPU_NRF51822) && !defined(CPU_NRF52833) && !defined(ARDUINO_FEATHER_F405) 552 | #define ULISP_SERIAL1 553 | #endif 554 | #if defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_UNOWIFIR4) 555 | #define ULISP_WIFI 556 | #endif 557 | 558 | inline int spiread () { return SPI.transfer(0); } 559 | #if defined(ULISP_SPI1) 560 | inline int spi1read () { return SPI1.transfer(0); } 561 | #endif 562 | inline int i2cread () { return I2Cread(&Wire); } 563 | #if defined(ULISP_I2C1) 564 | inline int i2c1read () { return I2Cread(&Wire1); } 565 | #endif 566 | #if defined(ULISP_SERIAL3) 567 | inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); } 568 | #endif 569 | #if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2) 570 | inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); } 571 | #endif 572 | #if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2) || defined(ULISP_SERIAL1) 573 | inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); } 574 | #endif 575 | #if defined(sdcardsupport) 576 | File SDpfile, SDgfile; 577 | inline int SDread () { 578 | if (LastChar) { 579 | char temp = LastChar; 580 | LastChar = 0; 581 | return temp; 582 | } 583 | return SDgfile.read(); 584 | } 585 | #endif 586 | 587 | #if defined(ULISP_WIFI) 588 | WiFiClient client; 589 | WiFiServer server(80); 590 | 591 | inline int WiFiread () { 592 | if (LastChar) { 593 | char temp = LastChar; 594 | LastChar = 0; 595 | return temp; 596 | } 597 | while (!client.available()) testescape(); 598 | return client.read(); 599 | } 600 | #endif 601 | 602 | void serialbegin (int address, int baud) { 603 | #if defined(ULISP_SERIAL3) 604 | if (address == 1) Serial1.begin((long)baud*100); 605 | else if (address == 2) Serial2.begin((long)baud*100); 606 | else if (address == 3) Serial3.begin((long)baud*100); 607 | #elif defined(ULISP_SERIAL2) 608 | if (address == 1) Serial1.begin((long)baud*100); 609 | else if (address == 2) Serial2.begin((long)baud*100); 610 | #elif defined(ULISP_SERIAL1) 611 | if (address == 1) Serial1.begin((long)baud*100); 612 | #else 613 | (void) baud; 614 | if (false); 615 | #endif 616 | else error("port not supported", number(address)); 617 | } 618 | 619 | void serialend (int address) { 620 | #if defined(ULISP_SERIAL3) 621 | if (address == 1) {Serial1.flush(); Serial1.end(); } 622 | else if (address == 2) {Serial2.flush(); Serial2.end(); } 623 | else if (address == 3) {Serial3.flush(); Serial3.end(); } 624 | #elif defined(ULISP_SERIAL2) 625 | if (address == 1) {Serial1.flush(); Serial1.end(); } 626 | else if (address == 2) {Serial2.flush(); Serial2.end(); } 627 | #elif defined(ULISP_SERIAL1) 628 | if (address == 1) {Serial1.flush(); Serial1.end(); } 629 | #else 630 | if (false); 631 | #endif 632 | else error("port not supported", number(address)); 633 | } 634 | 635 | gfun_t gstreamfun (object *args) { 636 | int streamtype = SERIALSTREAM; 637 | int address = 0; 638 | gfun_t gfun = gserial; 639 | if (args != NULL) { 640 | int stream = isstream(first(args)); 641 | streamtype = stream>>8; address = stream & 0xFF; 642 | } 643 | if (streamtype == I2CSTREAM) { 644 | if (address < 128) gfun = i2cread; 645 | #if defined(ULISP_I2C1) 646 | else gfun = i2c1read; 647 | #endif 648 | } else if (streamtype == SPISTREAM) { 649 | if (address < 128) gfun = spiread; 650 | #if defined(ULISP_SPI1) 651 | else gfun = spi1read; 652 | #endif 653 | } 654 | else if (streamtype == SERIALSTREAM) { 655 | if (address == 0) gfun = gserial; 656 | #if defined(ULISP_SERIAL3) 657 | else if (address == 1) gfun = serial1read; 658 | else if (address == 2) gfun = serial2read; 659 | else if (address == 3) gfun = serial3read; 660 | #elif defined(ULISP_SERIAL2) 661 | else if (address == 1) gfun = serial1read; 662 | else if (address == 2) gfun = serial2read; 663 | #elif defined(ULISP_SERIAL1) 664 | else if (address == 1) gfun = serial1read; 665 | #endif 666 | } 667 | #if defined(sdcardsupport) 668 | else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread; 669 | #endif 670 | #if defined(ULISP_WIFI) 671 | else if (streamtype == WIFISTREAM) gfun = (gfun_t)WiFiread; 672 | #endif 673 | else error2("unknown stream type"); 674 | return gfun; 675 | } 676 | 677 | inline void spiwrite (char c) { SPI.transfer(c); } 678 | #if defined(ULISP_SPI1) 679 | inline void spi1write (char c) { SPI1.transfer(c); } 680 | #endif 681 | inline void i2cwrite (char c) { I2Cwrite(&Wire, c); } 682 | #if defined(ULISP_I2C1) 683 | inline void i2c1write (char c) { I2Cwrite(&Wire1, c); } 684 | #endif 685 | #if defined(ULISP_SERIAL3) 686 | inline void serial1write (char c) { Serial1.write(c); } 687 | inline void serial2write (char c) { Serial2.write(c); } 688 | inline void serial3write (char c) { Serial3.write(c); } 689 | #elif defined(ULISP_SERIAL2) 690 | inline void serial2write (char c) { Serial2.write(c); } 691 | inline void serial1write (char c) { Serial1.write(c); } 692 | #elif defined(ULISP_SERIAL1) 693 | inline void serial1write (char c) { Serial1.write(c); } 694 | #endif 695 | #if defined(sdcardsupport) 696 | inline void SDwrite (char c) { SDpfile.write(uint8_t(c)); } // Fix for RP2040 697 | #endif 698 | #if defined(ULISP_WIFI) 699 | inline void WiFiwrite (char c) { client.write(c); } 700 | #endif 701 | #if defined(gfxsupport) 702 | inline void gfxwrite (char c) { tft.write(c); } 703 | #endif 704 | 705 | pfun_t pstreamfun (object *args) { 706 | int streamtype = SERIALSTREAM; 707 | int address = 0; 708 | pfun_t pfun = pserial; 709 | if (args != NULL && first(args) != NULL) { 710 | int stream = isstream(first(args)); 711 | streamtype = stream>>8; address = stream & 0xFF; 712 | } 713 | if (streamtype == I2CSTREAM) { 714 | if (address < 128) pfun = i2cwrite; 715 | #if defined(ULISP_I2C1) 716 | else pfun = i2c1write; 717 | #endif 718 | } else if (streamtype == SPISTREAM) { 719 | if (address < 128) pfun = spiwrite; 720 | #if defined(ULISP_SPI1) 721 | else pfun = spi1write; 722 | #endif 723 | } else if (streamtype == SERIALSTREAM) { 724 | if (address == 0) pfun = pserial; 725 | #if defined(ULISP_SERIAL3) 726 | else if (address == 1) pfun = serial1write; 727 | else if (address == 2) pfun = serial2write; 728 | else if (address == 3) pfun = serial3write; 729 | #elif defined(ULISP_SERIAL2) 730 | else if (address == 1) pfun = serial1write; 731 | else if (address == 2) pfun = serial2write; 732 | #elif defined(ULISP_SERIAL1) 733 | else if (address == 1) pfun = serial1write; 734 | #endif 735 | } 736 | else if (streamtype == STRINGSTREAM) { 737 | pfun = pstr; 738 | } 739 | #if defined(sdcardsupport) 740 | else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite; 741 | #endif 742 | #if defined(gfxsupport) 743 | else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite; 744 | #endif 745 | #if defined(ULISP_WIFI) 746 | else if (streamtype == WIFISTREAM) pfun = (pfun_t)WiFiwrite; 747 | #endif 748 | else error2("unknown stream type"); 749 | return pfun; 750 | }"# 751 | 752 | #+esp 753 | #" 754 | // Streams 755 | 756 | // Simplify board differences 757 | #if defined(ARDUINO_ADAFRUIT_QTPY_ESP32S2) 758 | #define ULISP_I2C1 759 | #endif 760 | 761 | inline int spiread () { return SPI.transfer(0); } 762 | inline int i2cread () { return I2Cread(&Wire); } 763 | #if defined(ULISP_I2C1) 764 | inline int i2c1read () { return I2Cread(&Wire1); } 765 | #endif 766 | inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); } 767 | #if defined(sdcardsupport) 768 | File SDpfile, SDgfile; 769 | inline int SDread () { 770 | if (LastChar) { 771 | char temp = LastChar; 772 | LastChar = 0; 773 | return temp; 774 | } 775 | return SDgfile.read(); 776 | } 777 | #endif 778 | 779 | WiFiClient client; 780 | WiFiServer server(80); 781 | 782 | inline int WiFiread () { 783 | if (LastChar) { 784 | char temp = LastChar; 785 | LastChar = 0; 786 | return temp; 787 | } 788 | while (!client.available()) testescape(); 789 | return client.read(); 790 | } 791 | 792 | void serialbegin (int address, int baud) { 793 | if (address == 1) Serial1.begin((long)baud*100); 794 | else error(PSTR("port not supported"), number(address)); 795 | } 796 | 797 | void serialend (int address) { 798 | if (address == 1) {Serial1.flush(); Serial1.end(); } 799 | else error(PSTR("port not supported"), number(address)); 800 | } 801 | 802 | gfun_t gstreamfun (object *args) { 803 | int streamtype = SERIALSTREAM; 804 | int address = 0; 805 | gfun_t gfun = gserial; 806 | if (args != NULL) { 807 | int stream = isstream(first(args)); 808 | streamtype = stream>>8; address = stream & 0xFF; 809 | } 810 | if (streamtype == I2CSTREAM) { 811 | if (address < 128) gfun = i2cread; 812 | #if defined(ULISP_I2C1) 813 | else gfun = i2c1read; 814 | #endif 815 | } else if (streamtype == SPISTREAM) gfun = spiread; 816 | else if (streamtype == SERIALSTREAM) { 817 | if (address == 0) gfun = gserial; 818 | else if (address == 1) gfun = serial1read; 819 | } 820 | #if defined(sdcardsupport) 821 | else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread; 822 | #endif 823 | else if (streamtype == WIFISTREAM) gfun = (gfun_t)WiFiread; 824 | else error2(PSTR("unknown stream type")); 825 | return gfun; 826 | } 827 | 828 | inline void spiwrite (char c) { SPI.transfer(c); } 829 | inline void i2cwrite (char c) { I2Cwrite(&Wire, c); } 830 | #if defined(ULISP_I2C1) 831 | inline void i2c1write (char c) { I2Cwrite(&Wire1, c); } 832 | #endif 833 | inline void serial1write (char c) { Serial1.write(c); } 834 | inline void WiFiwrite (char c) { client.write(c); } 835 | #if defined(sdcardsupport) 836 | inline void SDwrite (char c) { SDpfile.write(c); } 837 | #endif 838 | #if defined(gfxsupport) 839 | inline void gfxwrite (char c) { tft.write(c); } 840 | #endif 841 | 842 | pfun_t pstreamfun (object *args) { 843 | int streamtype = SERIALSTREAM; 844 | int address = 0; 845 | pfun_t pfun = pserial; 846 | if (args != NULL && first(args) != NULL) { 847 | int stream = isstream(first(args)); 848 | streamtype = stream>>8; address = stream & 0xFF; 849 | } 850 | if (streamtype == I2CSTREAM) { 851 | if (address < 128) pfun = i2cwrite; 852 | #if defined(ULISP_I2C1) 853 | else pfun = i2c1write; 854 | #endif 855 | } else if (streamtype == SPISTREAM) pfun = spiwrite; 856 | else if (streamtype == SERIALSTREAM) { 857 | if (address == 0) pfun = pserial; 858 | else if (address == 1) pfun = serial1write; 859 | } 860 | else if (streamtype == STRINGSTREAM) { 861 | pfun = pstr; 862 | } 863 | #if defined(sdcardsupport) 864 | else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite; 865 | #endif 866 | #if defined(gfxsupport) 867 | else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite; 868 | #endif 869 | else if (streamtype == WIFISTREAM) pfun = (pfun_t)WiFiwrite; 870 | else error2(PSTR("unknown stream type")); 871 | return pfun; 872 | }"# 873 | 874 | #+riscv 875 | #" 876 | // Streams 877 | 878 | inline int spiread () { return SPI.transfer(0); } 879 | #if defined(BOARD_SIPEED_MAIX_DUINO) 880 | inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); } 881 | inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); } 882 | inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); } 883 | #endif 884 | #if defined(sdcardsupport) 885 | File SDpfile, SDgfile; 886 | inline int SDread () { 887 | if (LastChar) { 888 | char temp = LastChar; 889 | LastChar = 0; 890 | return temp; 891 | } 892 | return SDgfile.read(); 893 | } 894 | #endif 895 | 896 | void serialbegin (int address, int baud) { 897 | #if defined(BOARD_SIPEED_MAIX_DUINO) 898 | if (address == 1) Serial1.begin((long)baud*100); 899 | else if (address == 2) Serial2.begin((long)baud*100); 900 | else if (address == 3) Serial3.begin((long)baud*100); 901 | else error(PSTR("port not supported"), number(address)); 902 | #endif 903 | } 904 | 905 | void serialend (int address) { 906 | #if defined(BOARD_SIPEED_MAIX_DUINO) 907 | if (address == 1) {Serial1.flush(); Serial1.end(); } 908 | else if (address == 2) {Serial2.flush(); Serial2.end(); } 909 | else if (address == 3) {Serial3.flush(); Serial3.end(); } 910 | #endif 911 | } 912 | 913 | gfun_t gstreamfun (object *args) { 914 | int streamtype = SERIALSTREAM; 915 | int address = 0; 916 | gfun_t gfun = gserial; 917 | if (args != NULL) { 918 | int stream = isstream(first(args)); 919 | streamtype = stream>>8; address = stream & 0xFF; 920 | } 921 | if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread; 922 | else if (streamtype == SPISTREAM) { 923 | if (address < 128) gfun = spiread; 924 | } 925 | else if (streamtype == SERIALSTREAM) { 926 | if (address == 0) gfun = gserial; 927 | #if defined(BOARD_SIPEED_MAIX_DUINO) 928 | else if (address == 1) gfun = serial1read; 929 | else if (address == 2) gfun = serial2read; 930 | else if (address == 3) gfun = serial3read; 931 | #endif 932 | } 933 | #if defined(sdcardsupport) 934 | else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread; 935 | #endif 936 | else error2(PSTR("unknown stream type")); 937 | return gfun; 938 | } 939 | 940 | inline void spiwrite (char c) { SPI.transfer(c); } 941 | #if defined(BOARD_SIPEED_MAIX_DUINO) 942 | inline void serial1write (char c) { Serial1.write(c); } 943 | inline void serial2write (char c) { Serial2.write(c); } 944 | inline void serial3write (char c) { Serial3.write(c); } 945 | #endif 946 | #if defined(sdcardsupport) 947 | inline void SDwrite (char c) { SDpfile.write(c); } 948 | #endif 949 | #if defined(gfxsupport) 950 | inline void gfxwrite (char c) { tft.write(c); } 951 | #endif 952 | 953 | pfun_t pstreamfun (object *args) { 954 | int streamtype = SERIALSTREAM; 955 | int address = 0; 956 | pfun_t pfun = pserial; 957 | if (args != NULL && first(args) != NULL) { 958 | int stream = isstream(first(args)); 959 | streamtype = stream>>8; address = stream & 0xFF; 960 | } 961 | if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite; 962 | else if (streamtype == SPISTREAM) { 963 | if (address < 128) pfun = spiwrite; 964 | } 965 | else if (streamtype == SERIALSTREAM) { 966 | if (address == 0) pfun = pserial; 967 | #if defined(BOARD_SIPEED_MAIX_DUINO) 968 | else if (address == 1) pfun = serial1write; 969 | else if (address == 2) pfun = serial2write; 970 | else if (address == 3) pfun = serial3write; 971 | #endif 972 | } 973 | else if (streamtype == STRINGSTREAM) { 974 | pfun = pstr; 975 | } 976 | #if defined(sdcardsupport) 977 | else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite; 978 | #endif 979 | #if defined(gfxsupport) 980 | else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite; 981 | #endif 982 | else error2(PSTR("unknown stream type")); 983 | return pfun; 984 | }"#)) -------------------------------------------------------------------------------- /Test Suites/AutoTester 32-bit.lisp: -------------------------------------------------------------------------------- 1 | ; uLisp Auto Tester 2 | 3 | ; Sharp-double-quote 4 | 5 | (defun sharp-double-quote-reader (stream sub-char numarg) 6 | (declare (ignore sub-char numarg)) 7 | (let (chars) 8 | (do ((prev (read-char stream) curr) 9 | (curr (read-char stream) (read-char stream))) 10 | ((and (char= prev #\") (char= curr #\#))) 11 | (push prev chars)) 12 | (coerce (nreverse chars) 'string))) 13 | 14 | (set-dispatch-macro-character 15 | #\# #\" #'sharp-double-quote-reader) 16 | 17 | ; do (run-tests) 18 | 19 | ;;; ================================================================ 20 | 21 | (eval-when (:compile-toplevel :load-toplevel :execute) 22 | (require "serial-port")) 23 | 24 | (cl:in-package "CL-USER") 25 | 26 | ;;; ================================================================ 27 | ;;; Class SERIAL-STREAM 28 | 29 | (defclass serial-stream (stream:fundamental-character-input-stream 30 | stream:fundamental-character-output-stream) 31 | ((serial-port :initform nil 32 | :initarg :serial-port 33 | :accessor stream-serial-port))) 34 | 35 | (defmethod initialize-instance :after ((stream serial-stream) 36 | &key name (baud-rate 9600) (data-bits 8) (stop-bits 1) (parity :none) 37 | &allow-other-keys) 38 | (unless (stream-serial-port stream) 39 | (check-type name string) 40 | (setf (stream-serial-port stream) 41 | (serial-port:open-serial-port name 42 | :baud-rate baud-rate 43 | :data-bits data-bits 44 | :stop-bits stop-bits 45 | :parity parity)))) 46 | 47 | (defmethod stream-element-type ((stream serial-stream)) 48 | 'character) 49 | 50 | (defmethod input-stream-p ((stream serial-stream)) 51 | t) 52 | 53 | (defmethod output-stream-p ((stream serial-stream)) 54 | t) 55 | 56 | ;;; ================================================================ 57 | ;;; Input 58 | 59 | (defmethod stream:stream-read-char ((stream serial-stream)) 60 | (serial-port:read-serial-port-char (stream-serial-port stream))) 61 | 62 | (defmethod stream:stream-read-char-no-hang ((stream serial-stream)) 63 | (when (stream:stream-listen stream) 64 | (stream:stream-read-char stream))) 65 | 66 | (defmethod stream:stream-listen ((stream serial-stream)) 67 | (serial-port:serial-port-input-available-p (stream-serial-port stream))) 68 | 69 | (defmethod stream:stream-clear-input ((stream serial-stream)) 70 | (loop while (stream:stream-listen stream) 71 | do (stream:stream-read-char stream)) 72 | nil) 73 | 74 | 75 | ;;; ================================================================ 76 | ;;; Output 77 | 78 | (defmethod stream:stream-write-char ((stream serial-stream) char) 79 | (serial-port:write-serial-port-char char (stream-serial-port stream))) 80 | 81 | (defmethod stream:stream-write-string ((stream serial-stream) string &optional (start 0) (end (length string))) 82 | (serial-port:write-serial-port-string string (stream-serial-port stream) t :start start :end end)) 83 | 84 | (defmethod stream:stream-force-output ((stream serial-stream)) 85 | nil) 86 | 87 | (defmethod stream:stream-finish-output ((stream serial-stream)) 88 | nil) 89 | 90 | (defmethod stream:stream-clear-output ((stream serial-stream)) 91 | nil) 92 | 93 | (defmethod close :after ((stream serial-stream) &key abort) 94 | (declare (ignorable abort)) 95 | (serial-port:close-serial-port (stream-serial-port stream))) 96 | 97 | ;;; ================================================================ 98 | ;;; Example 99 | 100 | (defparameter *tests* 101 | 102 | #"#| Symbols |# 103 | 104 | (aeq 'let 123 (let ((cat 123)) cat)) 105 | (aeq 'let 79 (let ((ca% 79)) ca%)) 106 | (aeq 'let 83 (let ((1- 83)) 1-)) 107 | (aeq 'let 13 (let ((12a 13)) 12a)) 108 | (aeq 'let 17 (let ((-1- 17)) -1-)) 109 | (aeq 'let 66 (let ((abcdef 66)) abcdef)) 110 | (aeq 'let 77 (let ((abcdefg 77)) abcdefg)) 111 | (aeq 'let 88 (let ((abcdefgh 88)) abcdefgh)) 112 | (aeq 'let 99 (let ((abcdefghi 99)) abcdefghi)) 113 | (aeq 'let 1010 (let ((abcdefghij 1010)) abcdefghij)) 114 | (aeq 'let "ab9" (princ-to-string 'ab9)) 115 | (aeq 'let t (eq 'me 'me)) 116 | (aeq 'let t (eq 'fishcake 'fishcake)) 117 | (aeq 'let nil (eq 'fishcak 'fishca)) 118 | 119 | #| Arithmetic |# 120 | 121 | (aeq '* 9 (* -3 -3)) 122 | (aeq '* 32580 (* 180 181)) 123 | (aeq '* 1 (*)) 124 | (aeq '+ 32767 (+ 32765 1 1)) 125 | (aeq '+ 0 (+)) 126 | (aeq '+ -2 (+ -1 -1)) 127 | (aeq '- -4 (- 4)) 128 | (aeq '- 0 (- 4 2 1 1)) 129 | (aeq '/ 2 (/ 60 10 3)) 130 | (aeq '1+ 2 (1+ 1)) 131 | (aeq '1+ 0 (1+ -1)) 132 | (aeq '1- 0 (1- 1)) 133 | 134 | #| Comparisons |# 135 | 136 | (aeq '< t (< -32768 32767)) 137 | (aeq '< t (< -1 0)) 138 | (aeq '< t (< 1 2 3 4)) 139 | (aeq '< nil (< 1 2 2 4)) 140 | (aeq '< t (<= 1 2 2 4)) 141 | (aeq '< nil (<= 1 3 2 4)) 142 | (aeq '< t (> 4 3 2 1)) 143 | (aeq '< nil (> 4 2 2 1)) 144 | (aeq '< t (>= 4 2 2 1)) 145 | (aeq '< nil (>= 4 2 3 1)) 146 | (aeq '< t (< 1)) 147 | (aeq '< nil (< 1 3 2)) 148 | (aeq '< nil (< -1 -2)) 149 | (aeq '< nil (< 10 10)) 150 | (aeq '<= t (<= 10 10)) 151 | (aeq '= t (= 32767 32767)) 152 | (aeq '>= t (>= 10 10)) 153 | (aeq '>= nil (>= 9 10)) 154 | (aeq '/= t (/= 1)) 155 | (aeq '/= nil (/= 1 2 1)) 156 | (aeq '/= nil (/= 1 2 3 1)) 157 | (aeq '/= t (/= 1 2 3 4)) 158 | (aeq 'plusp t (plusp 1)) 159 | (aeq 'plusp nil (plusp 0)) 160 | (aeq 'plusp nil (plusp -1)) 161 | (aeq 'minusp nil (minusp 1)) 162 | (aeq 'minusp nil (minusp 0)) 163 | (aeq 'minusp t (minusp -1)) 164 | (aeq 'zerop nil (zerop 1)) 165 | (aeq 'zerop t (zerop 0)) 166 | (aeq 'zerop nil (zerop -1)) 167 | (aeq 'evenp nil (evenp 1)) 168 | (aeq 'evenp t (evenp 0)) 169 | (aeq 'evenp nil (evenp -1)) 170 | (aeq 'oddp t (oddp 1)) 171 | (aeq 'oddp nil (oddp 0)) 172 | (aeq 'oddp t (oddp -1)) 173 | 174 | #| Maths functions |# 175 | 176 | (aeq 'abs 10 (abs 10)) 177 | (aeq 'abs 10 (abs -10)) 178 | (aeq 'max 45 (max 23 45)) 179 | (aeq 'max -23 (max -23 -45)) 180 | (aeq 'min 23 (min 23 45)) 181 | (aeq 'min -45 (min -23 -45)) 182 | (aeq 'zerop t (zerop 0)) 183 | (aeq 'zerop nil (zerop 32767)) 184 | (aeq 'mod 1 (mod 13 4)) 185 | (aeq 'mod 3 (mod -13 4)) 186 | (aeq 'mod -3 (mod 13 -4)) 187 | (aeq 'mod -1 (mod -13 -4)) 188 | 189 | #| Number entry |# 190 | 191 | (aeq 'hex -1 #xFFFFFFFF) 192 | (aeq 'hex 1 #x0001) 193 | (aeq 'hex 4112 #x1010) 194 | (aeq 'oct 511 #o777) 195 | (aeq 'oct 1 #o1) 196 | (aeq 'oct 65535 #o177777) 197 | (aeq 'bin -1 #b11111111111111111111111111111111) 198 | (aeq 'bin 10 #b1010) 199 | (aeq 'bin 0 #b0) 200 | (aeq 'hash 12 #'12) 201 | (aeq 'hash 6 (funcall #'(lambda (x) (+ x 2)) 4)) 202 | 203 | #| Boolean |# 204 | 205 | (aeq 'and 7 (and t t 7)) 206 | (aeq 'and nil (and t nil 7)) 207 | (aeq 'or t (or t nil 7)) 208 | (aeq 'or 1 (or 1 2 3)) 209 | (aeq 'or nil (or nil nil nil)) 210 | (aeq 'or 'a (or 'a 'b 'c)) 211 | (aeq 'or 1 (let ((x 0)) (or (incf x)) x)) 212 | 213 | #| Bitwise |# 214 | 215 | (aeq 'logand -1 (logand)) 216 | (aeq 'logand 170 (logand #xAA)) 217 | (aeq 'logand 0 (logand #xAAAA #x5555)) 218 | (aeq 'logior 0 (logior)) 219 | (aeq 'logior 170 (logior #xAA)) 220 | (aeq 'logior #xFFFF (logior #xAAAA #x5555)) 221 | (aeq 'logxor 0 (logxor)) 222 | (aeq 'logxor 170 (logior #xAA)) 223 | (aeq 'logxor 255 (logxor #xAAAA #xAA55)) 224 | (aeq 'lognot -43691 (lognot #xAAAA)) 225 | (aeq 'ash 492 (ash 123 2)) 226 | (aeq 'ash 65535 (ash #xFFFF 0)) 227 | (aeq 'ash 16383 (ash #xFFFF -2)) 228 | (aeq 'ash 262140 (ash #xFFFF 2)) 229 | (aeq 'ash 8191 (ash #x7FFF -2)) 230 | (aeq 'logbitp t (logbitp 0 1)) 231 | (aeq 'logbitp t (logbitp 1000 -1)) 232 | (aeq 'logbitp nil (logbitp 1000 0)) 233 | 234 | #| Tests |# 235 | 236 | (aeq 'atom t (atom nil)) 237 | (aeq 'atom t (atom t)) 238 | (aeq 'atom nil (atom '(1 2))) 239 | (aeq 'consp nil (consp 'b)) 240 | (aeq 'consp t (consp '(a b))) 241 | (aeq 'consp nil (consp nil)) 242 | (aeq 'listp nil (listp 'b)) 243 | (aeq 'listp t (listp '(a b))) 244 | (aeq 'listp t (listp nil)) 245 | (aeq 'numberp t (numberp (+ 1 2))) 246 | (aeq 'numberp nil (numberp 'b)) 247 | (aeq 'numberp nil (numberp nil)) 248 | (aeq 'symbolp t (symbolp 'b)) 249 | (aeq 'symbolp nil (symbolp 3)) 250 | (aeq 'symbolp t (symbolp nil)) 251 | (aeq 'streamp nil (streamp 'b)) 252 | (aeq 'streamp nil (streamp nil)) 253 | (aeq 'boundp t (let (x) (boundp 'x))) 254 | (aeq 'boundp nil (let (x) (boundp 'y))) 255 | 256 | #| cxr operations |# 257 | 258 | (aeq 'car 'a (car '(a b c))) 259 | (aeq 'car nil (car nil)) 260 | (aeq 'first 'a (first '(a b c))) 261 | (aeq 'first nil (first nil)) 262 | (aeq 'cdr 'b (cdr '(a . b))) 263 | (aeq 'cdr 'b (car (cdr '(a b)))) 264 | (aeq 'cdr nil (cdr nil)) 265 | (aeq 'rest 'b (rest '(a . b))) 266 | (aeq 'rest 'b (car (rest '(a b)))) 267 | (aeq 'rest nil (rest nil)) 268 | (aeq 'caaar 'a (caaar '(((a))))) 269 | (aeq 'caaar 'nil (caaar nil)) 270 | (aeq 'caadr 'b (caadr '(a (b)))) 271 | (aeq 'caadr 'nil (caadr nil)) 272 | (aeq 'caar 'a (caar '((a)))) 273 | (aeq 'caar 'nil (caar nil)) 274 | (aeq 'cadar 'c (cadar '((a c) (b)))) 275 | (aeq 'cadar 'nil (cadar nil)) 276 | (aeq 'caddr 'c (caddr '(a b c))) 277 | (aeq 'caddr 'nil (caddr nil)) 278 | (aeq 'cadr 'b (cadr '(a b))) 279 | (aeq 'second 'nil (second '(a))) 280 | (aeq 'second 'b (second '(a b))) 281 | (aeq 'cadr 'nil (cadr '(a))) 282 | (aeq 'caddr 'c (caddr '(a b c))) 283 | (aeq 'caddr 'nil (caddr nil)) 284 | (aeq 'third 'c (third '(a b c))) 285 | (aeq 'third 'nil (third nil)) 286 | (aeq 'cdaar 'b (car (cdaar '(((a b)) b c)))) 287 | (aeq 'cdaar 'nil (cdaar nil)) 288 | (aeq 'cdadr 'c (car (cdadr '(a (b c))))) 289 | (aeq 'cdadr 'nil (cdadr nil)) 290 | (aeq 'cdar 'b (car (cdar '((a b c))))) 291 | (aeq 'cdar 'nil (cdar nil)) 292 | (aeq 'cddar 'c (car (cddar '((a b c))))) 293 | (aeq 'cddar 'nil (cddar nil)) 294 | (aeq 'cdddr 'd (car (cdddr '(a b c d)))) 295 | (aeq 'cdddr nil (car (cdddr '(a b c)))) 296 | (aeq 'cddr 'c (car (cddr '(a b c)))) 297 | (aeq 'cddr 'nil (cddr '(a))) 298 | 299 | #| List operations |# 300 | 301 | (aeq 'cons 'a (car (cons 'a 'b))) 302 | (aeq 'cons nil (car (cons nil 'b))) 303 | (aeq 'append 6 (length (append '(a b c) '(d e f)))) 304 | (aeq 'append nil (append nil nil)) 305 | (aeq 'append '(1 2 3 4 5 . 6) (append '(1 2 3) '(4 5 . 6))) 306 | (aeq 'list nil (car (list nil))) 307 | (aeq 'list 'a (car (list 'a 'b 'c))) 308 | (aeq 'reverse 'c (car (reverse '(a b c)))) 309 | (aeq 'reverse nil (reverse nil)) 310 | (aeq 'length 0 (length nil)) 311 | (aeq 'length 4 (length '(a b c d))) 312 | (aeq 'length 2 (length '(nil nil))) 313 | (aeq 'assoc nil (assoc 'b nil)) 314 | (aeq 'assoc nil (assoc 'b '(nil nil))) 315 | (aeq 'assoc '(b . 12) (assoc 'b '((a . 10) (b . 12)))) 316 | (aeq 'assoc '(nil . 12) (assoc nil '((a . 10) (nil . 12)))) 317 | (aeq 'assoc '(b) (assoc 'b '((a . 10) (b)))) 318 | (aeq 'assoc '("three" . 3) (assoc "three" '(("one" . 1) ("two" . 2) ("three" . 3)) :test string=)) 319 | (aeq 'member '(3 4) (member 3 '(1 2 3 4))) 320 | (aeq 'member nil (member 5 '(1 2 3 4))) 321 | (aeq 'member '(3 4) (member 3 '(1 2 3 4) :test eq)) 322 | (aeq 'member '("three" "four") (member "three" '("one" "two" "three" "four") :test string=)) 323 | (aeq 'member '("two" "three" "four") (member "three" '("one" "two" "three" "four") :test string<)) 324 | 325 | #| map operations |# 326 | 327 | (aeq 'mapc 2 (cadr (mapc + '(1 2 3 4)))) 328 | (aeq 'mapc 10 (let ((x 0)) (mapc (lambda (y) (incf x y)) '(1 2 3 4)) x)) 329 | (aeq 'mapcar '(1 4 9 16) (mapcar (lambda (x) (* x x)) '(1 2 3 4))) 330 | (aeq 'mapcar '(1 4 9 16) (mapcar * '(1 2 3 4) '(1 2 3 4))) 331 | (aeq 'mapcar '(1 4 9 16 25) (mapcar (lambda (x) (* x x)) '(1 2 3 4 5))) 332 | (aeq 'mapcan '(1 4 2 5 3 6) (mapcan #'list '(1 2 3) '(4 5 6))) 333 | (aeq 'mapcan '(1 3 2 4) (mapcan list '(1 2) '(3 4))) 334 | (aeq 'mapcan '(1 5 9 2 6 10 3 7 11) (mapcan list '(1 2 3 4) '(5 6 7 8) '(9 10 11))) 335 | (aeq 'mapcan '(1 2 3 . 4) (mapcan (lambda (x) x) '((1) (2) (3 . 4)))) 336 | (aeq 'mapcan '(2 3 . 4) (mapcan (lambda (x) x) '(nil (2) (3 . 4)))) 337 | (aeq 'maplist '(((1 2 3) 6 7 8) ((2 3) 7 8) ((3) 8)) (maplist #'cons '(1 2 3) '(6 7 8))) 338 | (aeq 'maplist '(1 2 3) (mapl #'cons '(1 2 3) '(6 7 8))) 339 | (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))) 340 | 341 | #| let/let*/lambda |# 342 | 343 | (aeq 'let 7 (let ((x 7)) (let ((x 6) (y x)) y))) 344 | (aeq 'let* 6 (let* ((x 7)) (let* ((x 6) (y x)) y))) 345 | (aeq 'let t (let ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 346 | (aeq 'let* t (let* ((x t) (y nil) (w) z) (and x (null y) (null w) (null z)))) 347 | (aeq 'lambda 2 ((lambda (x y) (setq y x) y) 2 3)) 348 | (aeq 'lambda 9 ((lambda (&rest x) (apply + x)) 2 3 4)) 349 | (aeq 'lambda 8 ((lambda (x &optional (y 4)) (* x y)) 2)) 350 | (aeq 'lambda 6 ((lambda (x &optional (y 4)) (* x y)) 2 3)) 351 | (aeq 'lambda 6 ((lambda (x &optional y) (* x y)) 2 3)) 352 | (aeq 'lambda 123 ((lambda (list) list) 123)) 353 | 354 | #| loops and control |# 355 | 356 | (aeq 'progn 8 (let ((x 6)) (progn (incf x) (incf x)))) 357 | (aeq 'dotimes 21 (let ((x 6)) (dotimes (y 6 x) (setq x (+ x y))))) 358 | (aeq 'dotimes 6 (let ((x 6)) (dotimes (y 6 y) (setq x (+ x y))))) 359 | (aeq 'dotimes 0 (let ((x 6)) (dotimes (y 0 y) (setq x (+ x y))))) 360 | (aeq 'dolist 6 (let ((x 0)) (dolist (y '(1 2 3) x) (setq x (+ x y))))) 361 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3)) (setq x (+ x y))))) 362 | (aeq 'dolist nil (let ((x 0)) (dolist (y '(1 2 3) y) (setq x (+ x y))))) 363 | (aeq 'loop 6 (let ((x 0)) (loop (when (= x 6) (return x)) (incf x)))) 364 | (aeq 'loop 6 (let ((x 0)) (loop (unless (< x 6) (return x)) (incf x)))) 365 | (aeq 'return 'a (let ((a 7)) (loop (progn (return 'a))))) 366 | (aeq 'return nil (loop (return))) 367 | (aeq 'return 'a (let ((a 7)) (loop (progn (return 'a) nil)))) 368 | (aeq 'do 2 (do* ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x))) 369 | (aeq 'do 3 (do ((x 1 (1+ x)) (y 0 (1+ x))) ((= 3 y) x))) 370 | (aeq 'do 720 (do* ((n 6) (f 1 (* j f)) (j n (- j 1))) ((= j 0) f))) 371 | (aeq 'do 720 (let ((n 6)) (do ((f 1 (* j f)) (j n (- j 1)) ) ((= j 0) f)))) 372 | (aeq 'do 10 (do (a (b 1 (1+ b))) ((> b 10) a) (setq a b))) 373 | 374 | #| conditions |# 375 | 376 | (aeq 'if 3 (let ((a 2)) (if (= a 2) 3 4))) 377 | (aeq 'if 4 (let ((a 2)) (if (= a 3) 3 4))) 378 | (aeq 'if 4 (let ((a 3)) (if (= a 3) 4))) 379 | (aeq 'if nil (let ((a 4)) (if (= a 3) 4))) 380 | (aeq 'when 4 (let ((a 3)) (when (= a 3) 4))) 381 | (aeq 'when nil (let ((a 2)) (when (= a 3) 4))) 382 | (aeq 'unless nil (let ((a 3)) (unless (= a 3) 4))) 383 | (aeq 'unless 4 (let ((a 2)) (unless (= a 3) 4))) 384 | (aeq 'cond 8 (let ((a 2)) (cond ((= a 3) 7) ((= a 2) 8) (t 9)))) 385 | (aeq 'cond 9 (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8) (9)))) 386 | (aeq 'cond nil (let ((a 1)) (cond ((= a 3) 7) ((= a 2) 8)))) 387 | (aeq 'cond 12 (car (cond ((evenp 3) (list (* 2 3))) ((list (* 3 4)))))) 388 | (aeq 'case 222 (let ((j 1)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 389 | (aeq 'case 333 (let ((j t)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 390 | (aeq 'case 444 (let ((j 2)) (case j ((0 1) 111 222) ((t) 333) (t 444)))) 391 | 392 | #| eval/funcall/apply |# 393 | 394 | (aeq 'funcall 10 (funcall + 1 2 3 4)) 395 | (aeq 'funcall 'a (funcall car '(a b c d))) 396 | (aeq 'funcall 3 (let ((x 0)) (funcall (lambda (y) (incf x y)) 3) x)) 397 | (aeq 'apply 10 (apply + '(1 2 3 4))) 398 | (aeq 'apply 13 (apply + 1 2 '(1 2 3 4))) 399 | (aeq 'eval 10 (eval (list + 1 2 3 4))) 400 | (aeq 'eval nil (eval nil)) 401 | (aeq 'funcall 999 (let ((x 999)) (funcall (lambda (x) x) x))) 402 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (funcall fun (funcall fun x)))))) (funcall (x2 '1+) 2))) 403 | (aeq 'funcall 4 (let ((x2 (lambda (fun) (lambda (x) (fun (fun x)))))) ((x2 '1+) 2))) 404 | (aeq 'apply 5 (let* ((my (lambda (x y) (+ x y))) (han '(my))) (apply (first han) '(2 3)))) 405 | 406 | #| in-place operations |# 407 | 408 | (aeq 'incf 5 (let ((x 0)) (+ (incf x) (incf x 2) (incf x -2)))) 409 | (aeq 'decf -5 (let ((x 0)) (+ (decf x) (decf x 2) (decf x -2)))) 410 | (aeq 'incf 12 (let ((x 0)) (+ (incf x 2) (incf x 2) (incf x 2)))) 411 | (aeq 'incf 36 (let ((n 10)) (let* ((f1 (lambda () (incf n) n))) (+ (funcall f1) (funcall f1) (funcall f1))))) 412 | (aeq 'setf 25 (let ((a 3) (b 4)) (setf a (* a 3) b (* b 4)) (+ a b))) 413 | (aeq 'setf 9 (let ((a '(2 3))) (setf (car a) 6) (apply + a))) 414 | (aeq 'setf 12 (let ((a '(2 3))) (setf (cdr a) '(6)) (apply * a))) 415 | (aeq 'setf 220 (let ((a '(2 3 4))) (setf (nth 1 a) 11 (nth 2 a) 10) (apply * a))) 416 | 417 | #| recursion |# 418 | 419 | (aeq 'lambda 55 (let ((fib (lambda (n) (if (< n 3) 1 (+ (fib (- n 1)) (fib (- n 2))))))) (fib 10))) 420 | (aeq 'lambda 5040 (let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 7))) 421 | (aeq 'lambda 10 (let ((a 0)) (let ((f (lambda (n) (incf a n) (when (> n 0) (f (1- n)))))) (f 4)) a)) 422 | 423 | #| streams |# 424 | 425 | (aeq 'stream "" (with-output-to-string (s) (princ s s))) 426 | (aeq 'stream "12 23 34" (with-output-to-string (st) (format st "~a ~a ~a" 12 23 34))) 427 | 428 | #| features |# 429 | 430 | (aeq 'features t (not (not (member :floating-point *features*)))) 431 | (aeq 'features t (not (not (member :arrays *features*)))) 432 | 433 | #| printing |# 434 | 435 | (aeq 'princ "hello" (princ-to-string "hello")) 436 | (aeq 'princ "hello \"David\"" (princ-to-string "hello \"David\"")) 437 | (aeq 'prin1 "\"hello\"" (prin1-to-string "hello")) 438 | (aeq 'prin1 "\"hello \\\"David\\\"\"" (prin1-to-string "hello \"David\"")) 439 | 440 | #| prettyprinting |# 441 | 442 | (aeq 'princ "hello" (princ-to-string "hello")) 443 | (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)))))) 444 | 445 | #| documentation |# 446 | 447 | (aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list 'pro)) 448 | (aeq 'apropos '(progn apropos apropos-list unwind-protect) (apropos-list "pro")) 449 | (aeq 'documentation 7397 (let ((n 0)) (let ((st (documentation '?))) (dotimes (i (length st) n) (incf n (char-code (char st i))))))) 450 | 451 | #| format |# 452 | 453 | (aeq 'format "hello" (format nil "hello")) 454 | (aeq 'format "Hello23Goodbye" (format nil "Hello~aGoodbye" 23)) 455 | (aeq 'format " 17" (format nil "~5x" 23)) 456 | (aeq 'format " 10111" (format nil "~6b" 23)) 457 | (aeq 'format " 17 23 23 " (format nil "~5x ~5d ~5a" 23 23 23)) 458 | (aeq 'format "00017 00023" (format nil "~5,'0x ~5,'0d" 23 23)) 459 | (aeq 'format "01-45-07" (format nil "~2,'0d-~2,'0d-~2,'0d" 1 45 7)) 460 | (aeq 'format "Hello42" (format nil "Hello~a" 42)) 461 | (aeq 'format "[1,2,3]" (format nil "[~{~a~^,~}]" '(1 2 3))) 462 | (aeq 'format "0003.14159" (format nil "~10,'0g" 3.14159)) 463 | (aeq 'format "nil nil" (format nil "~a ~{ ~a ~} ~a" nil nil nil)) 464 | 465 | #| strings |# 466 | 467 | (aeq 'stringp t (stringp "hello")) 468 | (aeq 'stringp nil (stringp 5)) 469 | (aeq 'stringp nil (stringp '(a b))) 470 | (aeq 'numberp nil (numberp "hello")) 471 | (aeq 'atom t (atom "hello")) 472 | (aeq 'consp nil (consp "hello")) 473 | (aeq 'eq nil (eq "hello" "hello")) 474 | (aeq 'eq t (let ((a "hello")) (eq a a))) 475 | (aeq 'length 0 (length "")) 476 | (aeq 'length 5 (length "hello")) 477 | (aeq 'concatenate t (string= (concatenate 'string "A" "B") "AB")) 478 | (aeq 'concatenate 3 (length (concatenate 'string "A" "BC"))) 479 | (aeq 'concatenate 0 (length (concatenate 'string))) 480 | (aeq 'concatenate "ABCD" (concatenate 'string "AB" "CD")) 481 | (aeq 'concatenate "ABCDE" (concatenate 'string "AB" "CDE")) 482 | (aeq 'concatenate "ABCDE" (concatenate 'string "ABC" "DE")) 483 | (aeq 'concatenate "ABCDEF" (concatenate 'string "ABC" "DEF")) 484 | (aeq 'string= nil (string= "cat" "cat ")) 485 | (aeq 'string= t (string= "cat" "cat")) 486 | (aeq 'string/= 3 (string/= "cat" "catx")) 487 | (aeq 'string/= nil (string/= "cat" "cat")) 488 | (aeq 'string/= nil (string/= "catt" "catt")) 489 | (aeq 'string< nil (string< "cat" "cat")) 490 | (aeq 'string<= 3 (string<= "cat" "cat")) 491 | (aeq 'string< 3 (string< "cat" "cat ")) 492 | (aeq 'string< 4 (string< "fish" "fish ")) 493 | (aeq 'string> nil (string> "cat" "cat")) 494 | (aeq 'string>= 3 (string>= "cat" "cat")) 495 | (aeq 'string>= 5 (string>= "cattx" "cattx")) 496 | (aeq 'string> 0 (string> "c" "a")) 497 | (aeq 'string> 1 (string> "fc" "fa")) 498 | (aeq 'string> 2 (string> "ffc" "ffa")) 499 | (aeq 'string> 3 (string> "fffc" "fffa")) 500 | (aeq 'string> 4 (string> "ffffc" "ffffa")) 501 | (aeq 'string> 5 (string> "fffffc" "fffffa")) 502 | (aeq 'string> nil (string< "fffffc" "fffffa")) 503 | (aeq 'string "albatross" (string "albatross")) 504 | (aeq 'string "x" (string #\x)) 505 | (aeq 'string "cat" (string 'cat)) 506 | (aeq 'string "albatross" (string 'albatross)) 507 | 508 | 509 | #| subseq and search |# 510 | 511 | (aeq 'subseq "hello" (subseq "hellofromdavid" 0 5)) 512 | (aeq 'subseq "fromdavid" (subseq "hellofromdavid" 5)) 513 | (aeq 'subseq '(2 3 4) (subseq '(0 1 2 3 4) 2)) 514 | (aeq 'subseq '(2) (subseq '(0 1 2 3 4) 2 3)) 515 | (aeq 'subseq nil (subseq '() 0)) 516 | (aeq 'search 4 (search "cat" "the cat sat on the mat")) 517 | (aeq 'search 19 (search "mat" "the cat sat on the mat")) 518 | (aeq 'search nil (search "hat" "the cat sat on the mat")) 519 | (aeq 'search 1 (search '(1 2) '( 0 1 2 3 4))) 520 | (aeq 'search nil (search '(2 1 2 3 4 5) '(2 1 2 3 4))) 521 | 522 | #| characters |# 523 | 524 | (aeq 'char-code 97 (char-code #\a)) 525 | (aeq 'char-code 13 (char-code #\return)) 526 | (aeq 'char-code 255 (char-code #\255)) 527 | (aeq 'code-char #\return (code-char 13)) 528 | (aeq 'code-char #\a (code-char 97)) 529 | (aeq 'code-char #\255 (code-char 255)) 530 | (aeq 'eq t (eq #\b #\b)) 531 | (aeq 'eq nil (eq #\b #\B)) 532 | (aeq 'numberp nil (numberp #\b)) 533 | (aeq 'characterp t (characterp #\b)) 534 | (aeq 'char #\o (char "hello" 4)) 535 | (aeq 'char #\h (char "hello" 0)) 536 | (aeq 'char "A" (princ-to-string (code-char 65))) 537 | (aeq 'char "[#\\Bell]" (format nil "[~s]" (code-char 7))) 538 | (aeq 'char "[#\\Return]" (format nil "[~s]" #\return)) 539 | (aeq 'char "[#\\127]" (format nil "[~s]" #\127)) 540 | (aeq 'char "[#\\255]" (format nil "[~s]" #\255)) 541 | 542 | #| read-from-string |# 543 | 544 | (aeq 'read-from-string 123 (read-from-string "123")) 545 | (aeq 'read-from-string 144 (eval (read-from-string "((lambda (x) (* x x)) 12)"))) 546 | (aeq 'read-from-string t (eval (read-from-string "(eq (+ 2 3) 5)"))) 547 | (aeq 'read-from-string nil (read-from-string "()")) 548 | 549 | #| closures |# 550 | 551 | (aeq 'closure 'lex (let ((lex nil)) (funcall (let ((lex t)) (lambda () (if lex 'lex 'dyn)))))) 552 | (aeq 'closure 103 (let* ((c 100) (two (lambda (d) (+ c d))) (one (lambda (c) (funcall two 3)))) (funcall one 1))) 553 | (aeq 'closure 4 (let ((x 0)) (funcall (lambda (y) (incf x y)) 4) x)) 554 | (aeq 'closure 0 (let ((x 0)) (funcall (let ((x 7)) (lambda (y) (setq x (+ x y) ))) 4) x)) 555 | (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)))) 556 | (aeq 'closure 3 (let ((y 0) (test (lambda (x) (+ x 1)))) (dotimes (x 3 y) (progn (test (+ x 2))) (incf y x)))) 557 | 558 | #| arrays |# 559 | 560 | (aeq 'array '(0 0) (array-dimensions #2a())) 561 | (aeq 'array '(1 0) (array-dimensions #2a(()))) 562 | (aeq 'array '(2 0) (array-dimensions #2a(() ()))) 563 | (aeq 'array '(0) (array-dimensions (make-array '(0)))) 564 | (aeq 'array '(0) (array-dimensions (make-array 0))) 565 | (aeq 'array 1 (let ((a (make-array 3 :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2))) 566 | (aeq 'array 1 (let ((a (make-array '(3) :initial-element 0))) (incf (aref a (+ 1 1))) (aref a 2))) 567 | (aeq 'array 1 (let ((a (make-array '(2 3) :initial-element 0))) (incf (aref a 1 (+ 1 1))) (aref a 1 2))) 568 | (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))) 569 | (aeq 'array 10 (length (make-array 10 :initial-element 1))) 570 | 571 | #| bit arrays |# 572 | 573 | (aeq 'array '(0) (array-dimensions (make-array '(0) :element-type 'bit))) 574 | (aeq 'array '(1 1) (array-dimensions (make-array '(1 1) :element-type 'bit))) 575 | (aeq 'array 10 (length (make-array '(10) :element-type 'bit))) 576 | (aeq 'array 10 (length (make-array 10 :element-type 'bit))) 577 | (aeq 'array 1 (let ((a (make-array 3 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2))) 578 | (aeq 'array 1 (let ((a (make-array 3 :initial-element 0 :element-type 'bit))) (incf (aref a (+ 1 1))) (aref a 2))) 579 | (aeq 'array 0 (let ((a (make-array 10 :element-type 'bit :initial-element 1))) (decf (aref a 4)) (aref a 4))) 580 | (aeq 'array 1 (let ((a (make-array 40 :element-type 'bit :initial-element 0))) (incf (aref a 39)) (aref a 39))) 581 | (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))) 582 | 583 | #| repl |# 584 | 585 | (aeq 'repl 23 (read-from-string "23(2)")) 586 | (aeq 'repl nil (read-from-string "()23")) 587 | (aeq 'repl 23 (read-from-string "23\"Hi\"")) 588 | (aeq 'repl "Hi" (read-from-string "\"Hi\"23")) 589 | (aeq 'repl #\1 (read-from-string " #\\1\"Hi\"")) 590 | (aeq 'repl "Hi" (read-from-string (format nil "\"Hi\"~a~a" #\# "*0101"))) 591 | 592 | #| equal |# 593 | 594 | (aeq 'equal t (equal '(1 2 3) '(1 2 3))) 595 | (aeq 'equal t (equal '(1 2 (4) 3) '(1 2 (4) 3))) 596 | (aeq 'equal nil (equal '(1 2 (4) 3) '(1 2 (4 nil) 3))) 597 | (aeq 'equal t (equal "cat" "cat")) 598 | (aeq 'equal nil (equal "cat" "Cat")) 599 | (aeq 'equal t (equal 'cat 'Cat)) 600 | (aeq 'equal t (equal 2 (+ 1 1))) 601 | (aeq 'equal t (equal '("cat" "dog") '("cat" "dog"))) 602 | (aeq 'equal nil (equal '("cat" "dog") '("cat" "dig"))) 603 | (aeq 'equal nil (equal '("cat" "dog") '("cat" "Dog"))) 604 | 605 | #| keywords |# 606 | 607 | (aeq 'keywordp t (keywordp :led-builtin)) 608 | (aeq 'keywordp nil (keywordp print)) 609 | (aeq 'keywordp nil (keywordp nil)) 610 | (aeq 'keywordp nil (keywordp 12)) 611 | (aeq 'keywordp t (keywordp :fred)) 612 | (aeq 'keywordp t (keywordp :initial-element)) 613 | (aeq 'keywordp t (keywordp :element-type)) 614 | 615 | #| errors |# 616 | 617 | (aeq 'error 7 (let ((x 7)) (ignore-errors (setq x (/ 1 0))) x)) 618 | (aeq 'error 5 (unwind-protect (+ 2 3) 13)) 619 | 620 | #| Printing floats |# 621 | 622 | (aeq 'print t (string= (princ-to-string 101.0) "101.0")) 623 | (aeq 'print t (string= (princ-to-string 1010.0) "1010.0")) 624 | (aeq 'print t (string= (princ-to-string 10100.0) "10100.0")) 625 | (aeq 'print t (string= (princ-to-string 101000.0) "1.01e5")) 626 | (aeq 'print t (string= (princ-to-string 1010000.0) "1.01e6")) 627 | (aeq 'print t (string= (princ-to-string 1.01E7) "1.01e7")) 628 | (aeq 'print t (string= (princ-to-string 1.01E8) "1.01e8")) 629 | (aeq 'print t (string= (princ-to-string 7.0) "7.0")) 630 | (aeq 'print t (string= (princ-to-string 70.0) "70.0")) 631 | (aeq 'print t (string= (princ-to-string 700.0) "700.0")) 632 | (aeq 'print t (string= (princ-to-string 7000.0) "7000.0")) 633 | (aeq 'print t (string= (princ-to-string 70000.0) "70000.0")) 634 | (aeq 'print t (string= (princ-to-string 700000.0) "7.0e5")) 635 | (aeq 'print t (string= (princ-to-string 0.7) "0.7")) 636 | (aeq 'print t (string= (princ-to-string 0.07) "0.07")) 637 | (aeq 'print t (string= (princ-to-string 0.007) "0.007")) 638 | (aeq 'print t (string= (princ-to-string 7.0E-4) "7.0e-4")) 639 | (aeq 'print t (string= (princ-to-string 7.0E-5) "7.0e-5")) 640 | (aeq 'print t (string= (princ-to-string 7.0E-6) "7.0e-6")) 641 | (aeq 'print t (string= (princ-to-string 0.9) "0.9")) 642 | (aeq 'print t (string= (princ-to-string 0.99) "0.99")) 643 | (aeq 'print t (string= (princ-to-string 0.999) "0.999")) 644 | (aeq 'print t (string= (princ-to-string 0.9999) "0.9999")) 645 | (aeq 'print t (string= (princ-to-string 0.99999) "0.99999")) 646 | (aeq 'print t (string= (princ-to-string 0.999999) "0.999999")) 647 | (aeq 'print t (string= (princ-to-string 0.9999999) "1.0")) 648 | (aeq 'print t (string= (princ-to-string 1.0) "1.0")) 649 | (aeq 'print t (string= (princ-to-string 10.0) "10.0")) 650 | (aeq 'print t (string= (princ-to-string 100.0) "100.0")) 651 | (aeq 'print t (string= (princ-to-string 1000.0) "1000.0")) 652 | (aeq 'print t (string= (princ-to-string 10000.0) "10000.0")) 653 | (aeq 'print t (string= (princ-to-string 100000.0) "1.0e5")) 654 | (aeq 'print t (string= (princ-to-string 9.0) "9.0")) 655 | (aeq 'print t (string= (princ-to-string 90.0) "90.0")) 656 | (aeq 'print t (string= (princ-to-string 900.0) "900.0")) 657 | (aeq 'print t (string= (princ-to-string 9000.0) "9000.0")) 658 | (aeq 'print t (string= (princ-to-string 90000.0) "90000.0")) 659 | (aeq 'print t (string= (princ-to-string 900000.0) "9.0e5")) 660 | (aeq 'print t (string= (princ-to-string -9.0) "-9.0")) 661 | (aeq 'print t (string= (princ-to-string -90.0) "-90.0")) 662 | (aeq 'print t (string= (princ-to-string -900.0) "-900.0")) 663 | (aeq 'print t (string= (princ-to-string -9000.0) "-9000.0")) 664 | (aeq 'print t (string= (princ-to-string -90000.0) "-90000.0")) 665 | (aeq 'print t (string= (princ-to-string -900000.0) "-9.0e5")) 666 | (aeq 'print t (string= (princ-to-string 1.0) "1.0")) 667 | (aeq 'print t (string= (princ-to-string 1.01) "1.01")) 668 | (aeq 'print t (string= (princ-to-string 1.001) "1.001")) 669 | (aeq 'print t (string= (princ-to-string 1.0001) "1.0001")) 670 | (aeq 'print t (string= (princ-to-string 1.00001) "1.00001")) 671 | (aeq 'print t (string= (princ-to-string 1.000001) "1.0")) 672 | (aeq 'print t (string= (princ-to-string 0.0012345678) "0.00123457")) 673 | (aeq 'print t (string= (princ-to-string 1.2345678E-4) "1.23457e-4")) 674 | (aeq 'print t (string= (princ-to-string 1234567.9) "1.23457e6")) 675 | (aeq 'print t (string= (princ-to-string 1.2345679E7) "1.23457e7")) 676 | (aeq 'print t (string= (princ-to-string 1.2E-9) "1.2e-9")) 677 | (aeq 'print t (string= (princ-to-string 9.9E-8) "9.9e-8")) 678 | (aeq 'print t (string= (princ-to-string 9.9999E-5) "9.9999e-5")) 679 | (aeq 'print t (string= (princ-to-string 9.01) "9.01")) 680 | (aeq 'print t (string= (princ-to-string 0.9999999) "1.0")) 681 | (aeq 'print t (string= (princ-to-string 0.8999999) "0.9")) 682 | (aeq 'print t (string= (princ-to-string 0.01) "0.01")) 683 | (aeq 'print t (string= (princ-to-string 1.2345679) "1.23457")) 684 | (aeq 'print t (string= (princ-to-string 12.345679) "12.3457")) 685 | (aeq 'print t (string= (princ-to-string 123.45679) "123.457")) 686 | (aeq 'print t (string= (princ-to-string 1234.5679) "1234.57")) 687 | (aeq 'print t (string= (princ-to-string 12345.679) "12345.7")) 688 | (aeq 'print t (string= (princ-to-string 123456.79) "1.23457e5")) 689 | (aeq 'print t (string= (princ-to-string 1234567.9) "1.23457e6")) 690 | (aeq 'print t (string= (princ-to-string 0.12345679) "0.123457")) 691 | (aeq 'print t (string= (princ-to-string 0.012345679) "0.0123457")) 692 | (aeq 'print t (string= (princ-to-string 0.0012345678) "0.00123457")) 693 | (aeq 'print t (string= (princ-to-string 1.2345679E-4) "1.23457e-4")) 694 | 695 | #| Arithmetic |# 696 | 697 | (aeq '= t (= (- 4 2 1 1) 0)) 698 | (aeq '* 9 (* -3 -3)) 699 | (aeq '* 32580 (* 180 181)) 700 | (aeq '* 1 (*)) 701 | (aeq '* t (string= "-4.29497e9" (princ-to-string (* 2 -2147483648)))) 702 | (aeq '* -2147483648 (* 2 -1073741824)) 703 | (aeq '+ 32767 (+ 32765 1 1)) 704 | (aeq '+ 0 (+)) 705 | (aeq '+ -2 (+ -1 -1)) 706 | (aeq '- -4 (- 4)) 707 | (aeq '/ 2 (/ 60 10 3)) 708 | (aeq '1+ 2.5 (1+ 1.5)) 709 | (aeq '1+ 2147483647 (1+ 2147483646)) 710 | (aeq '1+ t (string= "2.14748e9" (princ-to-string (1+ 2147483647)))) 711 | (aeq '1- 0.5 (1- 1.5)) 712 | (aeq '1- -2147483648 (1- -2147483647)) 713 | (aeq '1- t (string= "-2.14748e9" (princ-to-string (1- -2147483648)))) 714 | 715 | #| Arithmetic |# 716 | 717 | (aeq '/ 1.75 (/ 3.5 2)) 718 | (aeq '/ 1.75 (/ 3.5 2.0)) 719 | (aeq '/ 0.0625 (/ 1 16)) 720 | (aeq '/ 0.0625 (/ 1.0 16)) 721 | (aeq '/ 0.0625 (/ 1 16.0)) 722 | (aeq '/ 2 (/ 12 2 3)) 723 | (aeq '/ 2.0 (/ 12.0 2 3)) 724 | (aeq '/ 2.0 (/ 12 2.0 3)) 725 | (aeq '/ 2.0 (/ 12 2 3.0)) 726 | (aeq '/ 1 (/ 1)) 727 | (aeq '/ t (string= "2.14748e9" (princ-to-string (/ -2147483648 -1)))) 728 | (aeq '/ 2147483647 (/ -2147483647 -1)) 729 | (aeq '/ 0.5 (/ 2)) 730 | (aeq '* 1.0 (* 0.0625 16)) 731 | (aeq '* 1.0 (* 0.0625 16.0)) 732 | 733 | #| Place |# 734 | 735 | (aeq 'incf 5.4 (let ((x 0)) (+ (incf x) (incf x 0.2) (incf x 2)))) 736 | (aeq 'decf -5.4 (let ((x 0)) (+ (decf x) (decf x 0.2) (decf x 2)))) 737 | (aeq 'incf 30.6 (let ((n 10)) (let* ((f1 (lambda () (incf n 0.1) n))) (+ (funcall f1) (funcall f1) (funcall f1))))) 738 | (aeq 'setf "hellx" (let ((s "hello")) (setf (char s 4) #\x) s)) 739 | 740 | #| Comparisons |# 741 | 742 | (aeq '< t (< 1 2 3 4)) 743 | (aeq '< nil (< 1 2 3 2)) 744 | (aeq '< t (< 1.0 2 3 4)) 745 | (aeq '< nil (< 1 2 3 2)) 746 | (aeq '< t (< 1.0 1.001 3 4)) 747 | (aeq '< nil (< 1.001 1.0 3 4)) 748 | (aeq '< t (< 1.001 1.002 1.003 1.004)) 749 | (aeq '< t (< 1. 2. 3. 4.)) 750 | (aeq '< nil (< 1. 2. 2. 4.)) 751 | (aeq '< t (<= 1. 2. 2. 4.)) 752 | (aeq '< nil (<= 1. 3. 2. 4.)) 753 | (aeq '< t (> 4. 3. 2. 1.)) 754 | (aeq '< nil (> 4. 2. 2. 1.)) 755 | (aeq '< t (>= 4. 2. 2. 1.)) 756 | (aeq '< nil (>= 4. 2. 3. 1.)) 757 | (aeq '/= t (= 1. 1. 1. 1.)) 758 | (aeq '/= nil (= 1. 1. 2. 1.)) 759 | (aeq '/= nil (/= 1. 2. 3. 1.)) 760 | (aeq '/= t (/= 1. 2. 3. 4.)) 761 | 762 | #| Transcendental |# 763 | 764 | (aeq 'sin 0.84147096 (sin 1)) 765 | (aeq 'sin 0.0 (sin 0)) 766 | (aeq 'sin 0.84147096 (sin 1.0)) 767 | (aeq 'sin 0.0 (sin 0.0)) 768 | (aeq 'cos 0.540302 (cos 1)) 769 | (aeq 'cos 0.540302 (cos 1.0)) 770 | (aeq 'tan 1.55741 (tan 1)) 771 | (aeq 'tan 1.55741 (tan 1.0)) 772 | (aeq 'asin 1.5707964 (asin 1)) 773 | (aeq 'asin 1.5707964 (asin 1)) 774 | (aeq 'asin 0.0 (asin 0)) 775 | (aeq 'asin 0.0 (asin 0.0)) 776 | (aeq 'acos 0.0 (acos 1)) 777 | (aeq 'acos 0.0 (acos 1.0)) 778 | (aeq 'acos 1.0471976 (acos 0.5)) 779 | (aeq 'atan 0.4636476 (atan 0.5)) 780 | (aeq 'atan 0.110657 (atan 1 9)) 781 | (aeq 'atan 0.049958397 (atan 1 20)) 782 | (aeq 'atan 0.785398 (atan 1 1)) 783 | (aeq 'atan 0.785398 (atan .5 .5))x 784 | (aeq 'sinh 1.1752 (sinh 1)) 785 | (aeq 'sinh 1.1752 (sinh 1.0)) 786 | (aeq 'sinh 0.0 (sinh 0)) 787 | (aeq 'sinh 0.0 (sin 0.0)) 788 | (aeq 'cosh 1.5430807 (cosh 1)) 789 | (aeq 'cosh 1.5430807 (cosh 1.0)) 790 | (aeq 'tanh 0.7615942 (tanh 1)) 791 | (aeq 'tanh 0.7615942 (tanh 1.0)) 792 | 793 | #| Rounding |# 794 | 795 | (aeq 'truncate 3 (truncate 10 3)) 796 | (aeq 'truncate 3 (truncate 3.3333333)) 797 | (aeq 'ceiling 4 (ceiling 10 3)) 798 | (aeq 'ceiling 4 (ceiling 3.3333333)) 799 | (aeq 'round 3 (round 10 3)) 800 | (aeq 'round 3 (round 3.3333333)) 801 | (aeq 'floor 3 (floor 10 3)) 802 | (aeq 'floor 3 (floor 3.3333333)) 803 | (aeq 'truncate -3 (truncate -10 3)) 804 | (aeq 'truncate -3 (truncate -3.3333333)) 805 | (aeq 'ceiling -3 (ceiling -10 3)) 806 | (aeq 'ceiling -3 (ceiling -3.3333333)) 807 | (aeq 'round -3 (round -10 3)) 808 | (aeq 'round -3 (round -3.3333333)) 809 | (aeq 'floor -4 (floor -10 3)) 810 | (aeq 'floor -4 (floor -3.3333333)) 811 | (aeq 'abs 10.0 (abs 10.0)) 812 | (aeq 'abs 10.0 (abs -10.0)) 813 | (aeq 'abs t (string= "2.14748e9" (princ-to-string (abs -2147483648)))) 814 | (aeq 'abs 2147483647 (abs -2147483647)) 815 | (aeq 'mod 1.0 (mod 13.0 4)) 816 | (aeq 'mod 3.0 (mod -13.0 4)) 817 | (aeq 'mod -3.0 (mod 13.0 -4)) 818 | (aeq 'mod -1.0 (mod -13.0 -4)) 819 | (aeq 'mod -3.0 (mod 13.0 -4)) 820 | (aeq 'mod 1.0 (mod -12.5 1.5)) 821 | (aeq 'mod 0.5 (mod 12.5 1.5)) 822 | 823 | #| Log and exp |# 824 | 825 | (aeq 'exp 2.7182818 (exp 1)) 826 | (aeq 'exp 2.7182818 (exp 1.0)) 827 | (aeq 'exp 0.36787945 (exp -1)) 828 | (aeq 'exp 0.36787945 (exp -1.0)) 829 | (aeq 'exp 0.36787945 (exp -1.0)) 830 | (aeq 'log 0.0 (log 1.0)) 831 | (aeq 'log 4.0 (log 16 2)) 832 | (aeq 'log 4.0 (log 16.0 2)) 833 | (aeq 'log 4.0 (log 16 2.0)) 834 | (aeq 'log 4.0 (log 16.0 2.0)) 835 | (aeq 'log 1.0 (log 2 2)) 836 | (aeq 'log 1.0 (log 2.5 2.5)) 837 | (aeq 'log 2.3025852 (log 10)) 838 | (aeq 'log 2.3025852 (log 10)) 839 | (aeq 'expt 1024 (expt 2 10)) 840 | (aeq 'expt 1024.0 (expt 2.0 10.0)) 841 | (aeq 'expt 1073741824 (expt 2 30)) 842 | (aeq 'expt t (string= "2.14748e9" (princ-to-string (expt 2 31)))) 843 | (aeq 'expt t (string= "4.29497e9" (princ-to-string (expt 2 32)))) 844 | (aeq 'expt 1024 (expt -2 10)) 845 | (aeq 'expt -2048 (expt -2 11)) 846 | 847 | #| Tests |# 848 | 849 | (aeq 'floatp nil (floatp 1)) 850 | (aeq 'floatp nil (floatp nil)) 851 | (aeq 'floatp t (floatp 2.3)) 852 | (aeq 'integerp t (integerp 1)) 853 | (aeq 'integerp nil (integerp nil)) 854 | (aeq 'integerp nil (integerp 2.3)) 855 | 856 | #| error checks |# 857 | 858 | (aeq 'dolist nothing (ignore-errors (dolist 12 (print x)))) 859 | (aeq 'dolist nothing (ignore-errors (dolist () (print x)))) 860 | (aeq 'dolist nothing (ignore-errors (dolist (x) (print x)))) 861 | (aeq 'dolist nothing (ignore-errors (dolist (x nil x x) (print x)))) 862 | (aeq 'dotimes nothing (ignore-errors (dotimes 12 (print x)))) 863 | (aeq 'dotimes nothing (ignore-errors (dotimes () (print x)))) 864 | (aeq 'dotimes nothing (ignore-errors (dotimes (x) (print x)))) 865 | (aeq 'dotimes nothing (ignore-errors (dotimes (x 1 x x) (print x)))) 866 | (aeq 'for-millis nothing (ignore-errors (for-millis 12 (print 12)))) 867 | (aeq 'for-millis nothing (ignore-errors (for-millis (12 12) (print 12)))) 868 | (aeq 'push nothing (ignore-errors (let ((a #*00000000)) (push 1 (aref a 1)) a))) 869 | (aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 5) #\x) s))) 870 | (aeq 'setf nothing (ignore-errors (let ((s "hello")) (setf (char s 20) #\x) s))) 871 | 872 | #| errors |# 873 | 874 | (aeq 'errors 0 ers) 875 | 876 | "#) 877 | 878 | (defun run-tests (&optional usb) 879 | (let ((name (cond 880 | ((numberp usb) (format nil "/dev/cu.usbmodem~a" usb)) 881 | ((eq usb :esp) "/dev/cu.SLAB_USBtoUART") 882 | ((eq usb :ftdi) "/dev/cu.usbserial-A104OVGT") 883 | ;((eq usb :maix) "/dev/cu.usbserial-495223D74D0") 884 | ((eq usb :maix) "/dev/cu.usbserial-xel_sipeed0") 885 | ((eq usb :dock) "/dev/cu.wchusbserial1410") 886 | ((eq usb :teensy) "/dev/cu.usbmodem7705521") 887 | (t usb))) 888 | (speed 1)) 889 | (flet ((serial-write-exp (string stream) 890 | (write-string string stream) 891 | (write-char #\newline stream)) 892 | ;; 893 | (echo (s) 894 | (sleep speed) 895 | (loop 896 | (let ((c (read-char-no-hang s))) 897 | (unless c (return)) 898 | (unless (eq c #\return) (write-char c)))) 899 | (format t "~%")) 900 | ;; 901 | (read-serial (s) 902 | (sleep speed) 903 | (let ((string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) 904 | (loop 905 | (let ((c (read-char-no-hang s))) 906 | (unless c (return string)) 907 | (vector-push-extend c string)))))) 908 | ;; 909 | (with-open-stream (s (make-instance 'serial-stream :name name)) 910 | (echo s) 911 | (echo s) 912 | (serial-write-exp "(defvar ers 0)" s) 913 | (echo s) 914 | (serial-write-exp 915 | "(defun aeq (tst x y) 916 | (unless (or 917 | (and (floatp x) (floatp y) (< (abs (- x y)) 0.000005)) 918 | (equal x y)) 919 | (incf ers) 920 | (format t \"~a=~a/~a~%\" tst x y)))" 921 | s) 922 | (echo s) 923 | ;; 924 | ;; tests 925 | ;; 926 | (with-input-from-string (str *tests*) 927 | (loop 928 | (let ((line (read-line str nil nil))) 929 | (unless line (return)) 930 | (serial-write-exp line s) 931 | (let ((output (read-serial s))) 932 | (let* ((m1 (position #\return output)) 933 | (m2 (when m1 (position #\return output :start (+ 2 m1))))) 934 | (cond 935 | ((null m2) (format t "~a~%" output)) 936 | ((string= (subseq output (+ 2 m1) m2) "nil") nil) 937 | (t (format t "*** ~a: ~a~%" (subseq output (+ 2 m1) m2) (subseq output 0 m1))))))))))))) 938 | --------------------------------------------------------------------------------