From 52debcf04522d6d85e828d3acc4b65bf158ec1f6 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Wed, 2 Apr 2025 18:18:55 -0700 Subject: [PATCH] Quality of life improvements: - Add standard library - Update display --- LispLibrary.h | 176 ++++ PICOCALC.md | 3 + ulisp-arm.ino | 2301 ++++++++++++++++++++++++++---------------- ulisp-extensions.ino | 52 +- 4 files changed, 1659 insertions(+), 873 deletions(-) create mode 100644 LispLibrary.h diff --git a/LispLibrary.h b/LispLibrary.h new file mode 100644 index 0000000..f179cdb --- /dev/null +++ b/LispLibrary.h @@ -0,0 +1,176 @@ +// Library of additional Lisp functions with integral documentation +// LispLibrary.h - Version 2 - 5th November 2023 + +const char LispLibrary[] PROGMEM = R"lisplibrary( + +(defun every (tst lst) + "(every tst lst) +Returns t if tst is true for every item in lst, or nil on the first false item." + (if (null lst) t + (and (funcall tst (car lst)) (every tst (cdr lst))))) + +(defun load (filename) + "(load filename) +Open the Lisp file on the SD card and load the contents into the workspace." + (with-sd-card (str filename) + (loop + (let ((form (read str))) + (unless form (return)) + (print (second form)) + (eval form))))) + +(defun rgb (r g b) + "(rgb r g b) +Define a colour from its RGB components." + (logior (ash (logand r #xf8) 8) (ash (logand g #xfc) 3) (ash b -3))) + +(defun hsv (h s v) + "(hsv h s v) +Specify colours in the alternative HSV colour system." + (let* ((chroma (* v s)) + (x (* chroma (- 1 (abs (- (mod (/ h 60) 2) 1))))) + (m (- v chroma)) + (i (truncate h 60)) + (params (list chroma x 0 0 x chroma)) + (r (+ m (nth i params))) + (g (+ m (nth (mod (+ i 4) 6) params))) + (b (+ m (nth (mod (+ i 2) 6) params)))) + (rgb (round (* r 255)) (round (* g 255)) (round (* b 255))))) + +(defun col (n) + "(col n) +Defines a different colour for each value of n from 0 to 7." + (rgb (* (logand n 1) 160) (* (logand n 2) 80) (* (logand n 4) 40))) + +(defun butlast (lst) + "(butlast lst) +Returns all but the last item in lst." + (unless (null lst) (subseq lst 0 (1- (length lst))))) + +(defun count (x lst) + "(count x lst) +Counts the number of items eq to x in lst." + (if (null lst) 0 + (+ (if (eq x (car lst)) 1 0) (count x (cdr lst))))) + +(defun count-if (tst lst) + "(count-if tst lst) +Counts the number of items in lst for which tst is true." + (if (null lst) 0 + (+ (if (funcall tst (car lst)) 1 0) (count-if tst (cdr lst))))) + +(defun count-if-not (tst lst) + "(count-if-not tst lst) +Counts the number of items in lst for which tst is false." + (if (null lst) 0 + (+ (if (funcall tst (car lst)) 0 1) (count-if-not tst (cdr lst))))) + +(defun find (x lst) + "(find x lst) +Returns x if x is in lst, or nil otherwise." + (car (member x lst))) + +(defun find-if (tst lst) + "(find-if tst lst) +Returns the first item in lst for which tst is true, or nil otherwise." + (cond + ((null lst) nil) + ((funcall tst (car lst)) (car lst)) + (t (find-if tst (cdr lst))))) + +(defun find-if-not (tst lst) + "(find-if-not tst lst) +Returns the first item in lst for which tst is false, or nil otherwise." + (cond + ((null lst) nil) + ((not (funcall tst (car lst))) (car lst)) + (t (find-if-not tst (cdr lst))))) + +(defun identity (x) + "(identity x) +Returns its argument." + x) + +(defun last (lst) + "(last lst) +Returns the last cdr of lst." + (unless (null lst) (subseq lst (1- (length lst))))) + +(defun mapl (fn lst) + "(mapl fn lst) +Applies fn to successive cdrs of lst, and returns lst." + (mapl2 fn lst) + lst) + +(defun mapl2 (fn lst) + (cond + ((null lst) nil) + (t (funcall fn lst) + (mapl2 fn (cdr lst))))) + +(defun maplist (fn lst) + "(maplist fn lst) +Applies fn to successive cdrs of lst, and returns a list of the results." + (if (null lst) nil + (cons (funcall fn lst) (maplist fn (cdr lst))))) + +(defun nconc (&rest lst) + "(nconc lst*) +Destructively appends its arguments together, which must be lists." + (mapcan #'(lambda (x) x) lst)) + +(defun nthcdr (n lst) + "(nthcdr n lst) +Returns the nth cdr of lst." + (if (zerop n) lst + (nthcdr (1- n) (cdr lst)))) + +(defun position (x lst &optional (n 0)) + "(position x lst) +Returns the position of the first x in lst, or nil if it's not found." + (cond + ((null lst) nil) + ((eq x (car lst)) n) + (t (position x (cdr lst) (1+ n))))) + +(defun position-if (tst lst &optional (n 0)) + "(position-if tst lst) +Returns the position of the first item in lst for which tst is true, +or nil if none is found." + (cond + ((null lst) nil) + ((funcall tst (car lst)) n) + (t (position-if tst (cdr lst) (1+ n))))) + +(defun position-if-not (tst lst &optional (n 0)) + "(position-if-not tst lst) +Returns the position of the first item in lst for which tst is false, +or nil if none is found." + (cond + ((null lst) nil) + ((not (funcall tst (car lst))) n) + (t (position-if-not tst (cdr lst) (1+ n))))) + +(defun reduce (fn lst) + "(reduce fn lst) +Returns the result of applying fn to successive pairs of items from lst." + (if (null (cdr lst)) (car lst) + (funcall fn (car lst) (reduce fn (cdr lst))))) + +(defun remove (x lst) + "(remove x lst) +Returns a list with all occurrences of x removed from lst." + (mapcan #'(lambda (y) (unless (eq x y) (list y))) lst)) + +(defun remove-if (tst lst) + "(remove-if tst lst) +Returns a list with all items for which tst is true removed from lst." + (mapcan #'(lambda (x) (unless (funcall tst x) (list x))) lst)) + +(defun remove-if-not (tst lst) + "(remove-if-not tst lst) +Returns a list with all items for which tst is false removed from lst." + (mapcan #'(lambda (x) (when (funcall tst x) (list x))) lst)) + +)lisplibrary"; + diff --git a/PICOCALC.md b/PICOCALC.md index f8450fc..7fb519e 100644 --- a/PICOCALC.md +++ b/PICOCALC.md @@ -13,3 +13,6 @@ Future work: - Clean up code and error messages. - Lots of formatting fixes. - Support an RTC. +- Improve error handling - instead of hanging, print error message + and return to top-level. + - Note: appears to return control to serial, not kbd/display. diff --git a/ulisp-arm.ino b/ulisp-arm.ino index abe8ce0..11dabdc 100644 --- a/ulisp-arm.ino +++ b/ulisp-arm.ino @@ -5,12 +5,13 @@ */ // Lisp Library -const char LispLibrary[] PROGMEM = ""; +// Loaded from LispLibrary.h +// const char LispLibrary[] PROGMEM = ""; // Compile options #define resetautorun -#define printfreespace +// #define printfreespace // #define printgcs #define sdcardsupport #define gfxsupport @@ -26,15 +27,25 @@ const char LispLibrary[] PROGMEM = ""; // Includes -// #include "LispLibrary.h" +#include "LispLibrary.h" #include #include #include #include +#if defined(ARDUINO_RASPBERRY_PI_PICO) || \ + defined(ARDUINO_RASPBERRY_PI_PICO_2W) || \ + defined(ARDUINO_RASPBERRY_PI_PICO_W) || \ + defined(ARDUINO_RASPBERRY_PI_PICO_2) +#define RASPBERRY_PI_PICO_PLATFORM +#if defined(CPI_PICOCALC) +#define IS_PICOCALC +#endif +#endif + #if defined(sdcardsupport) -#if defined(ARDUINO_RASPBERRY_PI_PICO) || defined (ARDUINO_RASPBERRY_PI_PICO_2W) +#if defined(RASPBERRY_PI_PICO_PLATFORM) #include #endif #include @@ -115,7 +126,7 @@ const char LispLibrary[] PROGMEM = ""; #define SDCARD_SS_PIN 10 #define CPU_ATSAMD51 #if defined(gfxsupport) - const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0, TFT_BACKLIGHT = 47; + const int TFT_BACKLIGHT = 47; #include // Core graphics library #include // Hardware-specific library for ST7735 Adafruit_ST7735 tft = Adafruit_ST7735(44, 45, 41, 42, 46); @@ -130,7 +141,6 @@ const char LispLibrary[] PROGMEM = ""; #define CPU_ATSAMD51 #define EXTERNAL_FLASH_USE_QSPI #if defined(gfxsupport) - const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; #include // Hardware-specific library TFT_eSPI tft = TFT_eSPI(); #endif @@ -182,7 +192,6 @@ const char LispLibrary[] PROGMEM = ""; #define STACKDIFF 8 #define CPU_NRF52840 #if defined(gfxsupport) - const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; #include #include Adafruit_ST7789 tft = Adafruit_ST7789(&SPI1, PIN_TFT_CS, PIN_TFT_DC, PIN_TFT_RST); @@ -235,15 +244,6 @@ const char LispLibrary[] PROGMEM = ""; #define STACKDIFF 320 #define CPU_RP2040 #if defined(gfxsupport) - const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; - /* - #include // Core graphics library - #include // Hardware-specific library for ST7789 - Adafruit_ST7789 tft = Adafruit_ST7789(5, 1, 3, 2, 0); // TTGO RP2040 TFT - #define TFT_BACKLIGHT 4 - #define TFT_I2C_POWER 22 - */ - #include // Hardware-specific library #if defined(CPI_PICOCALC) #include @@ -317,12 +317,6 @@ const char LispLibrary[] PROGMEM = ""; #define FS_FILE_READ "r" #define CPU_RP2350j #if defined(gfxsupport) - const int COLOR_WHITE = 0xffff, COLOR_BLACK = 0; - // #include // Core graphics library - // #include // Hardware-specific library for ST7789 - // Adafruit_ST7789 tft = Adafruit_ST7789(5, 1, 3, 2, 0); // TTGO RP2040 TFT - // #define TFT_BACKLIGHT 4 - // #define TFT_I2C_POWER 22 #include // Hardware-specific library #if defined(CPI_PICOCALC) #include @@ -400,6 +394,16 @@ const char LispLibrary[] PROGMEM = ""; #error "Board not supported!" #endif +#if defined(gfxsupport) +const int COLOR_WHITE = 0xffff; +const int COLOR_BLACK = 0; +const int COLOR_GREEN = 0x0600; +const int TEXT_COLOR = COLOR_GREEN; +const int BG_COLOR = COLOR_BLACK; +#endif + + + // C Macros #define nil NULL @@ -563,88 +567,134 @@ int modbacktrace (int n) { /* printbacktrace - prints a call backtrace for error messages and break. */ -void printbacktrace () { - if (TraceStart != TraceTop) pserial('['); - int tracesize = modbacktrace(TraceTop-TraceStart); - for (int i=1; i<=tracesize; i++) { - printsymbol(symbol(Backtrace[modbacktrace(TraceTop-i)]), pserial); - if (i!=tracesize) pfstring(" <- ", pserial); - } - if (TraceStart != TraceTop) pserial(']'); +void +printbacktrace () +{ + if (TraceStart != TraceTop) { + pserial('['); + } + + int tracesize = modbacktrace(TraceTop-TraceStart); + + for (int i=1; i<=tracesize; i++) { + printsymbol(symbol(Backtrace[modbacktrace(TraceTop-i)]), pserial); + if (i!=tracesize) { + pfstring(" <- ", pserial); + } + } + + if (TraceStart != TraceTop) { + pserial(']'); + } } /* errorsub - used by all the error routines. - Prints: "Error: 'fname' string", where fname is the name of the Lisp function in which the error occurred. + Prints: "Error: 'fname' string", where fname is the name of the + Lisp function in which the error occurred. */ -void errorsub (symbol_t fname, const char *string) { - pfl(pserial); pfstring("Error", pserial); - if (TraceStart != TraceTop) pserial(' '); - printbacktrace(); - pfstring(": ", pserial); - if (fname != sym(NIL)) { - pserial('\''); - psymbol(fname, pserial); - pserial('\''); pserial(' '); - } - pfstring(string, pserial); +void +errorsub(symbol_t fname, const char *string) +{ + pfl(pserial); pfstring("Error", pserial); + + if (TraceStart != TraceTop) { + pserial(' '); + } + + printbacktrace(); + pfstring(": ", pserial); + + if (fname != sym(NIL)) { + pserial('\''); + psymbol(fname, pserial); + pserial('\''); pserial(' '); + } + + pfstring(string, pserial); } -void errorend () { GCStack = NULL; longjmp(*handler, 1); } +void +errorend() +{ + GCStack = NULL; + longjmp(*handler, 1); +} /* errorsym - prints an error message and reenters the REPL. - Prints: "Error: 'fname' string: symbol", where fname is the name of the user Lisp function in which the error occurred, - and symbol is the object generating the error. + Prints: "Error: 'fname' string: symbol", where fname is the name + of the user Lisp function in which the error occurred, + and symbol is the object generating the error. */ -void errorsym (symbol_t fname, const char *string, object *symbol) { - if (!tstflag(MUFFLEERRORS)) { - errorsub(fname, string); - pserial(':'); pserial(' '); - printobject(symbol, pserial); - pln(pserial); - } - errorend(); +void +errorsym(symbol_t fname, const char *string, object *symbol) +{ + if (!tstflag(MUFFLEERRORS)) { + errorsub(fname, string); + pserial(':'); + pserial(' '); + printobject(symbol, pserial); + pln(pserial); + } + + errorend(); } /* errorsym2 - prints an error message and reenters the REPL. - Prints: "Error: 'fname' string", where fname is the name of the user Lisp function in which the error occurred. + Prints: "Error: 'fname' string", where fname is the name of the + user Lisp function in which the error occurred. */ -void errorsym2 (symbol_t fname, const char *string) { - if (!tstflag(MUFFLEERRORS)) { - errorsub(fname, string); - pln(pserial); - } - errorend(); +void +errorsym2(symbol_t fname, const char *string) +{ + if (!tstflag(MUFFLEERRORS)) { + errorsub(fname, string); + pln(pserial); + } + + errorend(); } /* error - prints an error message and reenters the REPL. - Prints: "Error: 'Context' string: symbol", where Context is the name of the built-in Lisp function in which the error occurred, - and symbol is the object generating the error. + Prints: "Error: 'Context' string: symbol", where Context is the + name of the built-in Lisp function in which the error occurred, + and symbol is the object generating the error. */ -void error (const char *string, object *symbol) { - errorsym(sym(Context), string, symbol); +void +error(const char *string, object *symbol) +{ + errorsym(sym(Context), string, symbol); } /* error2 - prints an error message and reenters the REPL. - Prints: "Error: 'Context' string", where Context is the name of the built-in Lisp function in which the error occurred. + Prints: "Error: 'Context' string", where Context is the name of + the built-in Lisp function in which the error occurred. */ -void error2 (const char *string) { - errorsym2(sym(Context), string); +void +error2(const char *string) +{ + errorsym2(sym(Context), string); } /* formaterr - displays a format error with a ^ pointing to the error */ -void formaterr (object *formatstr, const char *string, uint8_t p) { - pln(pserial); indent(4, ' ', pserial); printstring(formatstr, pserial); pln(pserial); - indent(p+5, ' ', pserial); pserial('^'); - error2(string); - pln(pserial); - errorend(); +void +formaterr(object *formatstr, const char *string, uint8_t p) +{ + pln(pserial); + indent(4, ' ', pserial); + printstring(formatstr, pserial); + pln(pserial); + + indent(p+5, ' ', pserial); pserial('^'); + error2(string); + pln(pserial); + errorend(); } // Save space as these are used multiple times @@ -672,42 +722,55 @@ const char canttakecar[] = "can't take car"; const char canttakecdr[] = "can't take cdr"; const char unknownstreamtype[] = "unknown stream type"; + // Set up workspace /* initworkspace - initialises the workspace into a linked list of free objects */ -void initworkspace () { - Freelist = NULL; - for (int i=WORKSPACESIZE-1; i>=0; i--) { - object *obj = &Workspace[i]; - car(obj) = NULL; - cdr(obj) = Freelist; - Freelist = obj; - Freespace++; - } +void +initworkspace() +{ + Freelist = NULL; + + for (int i=WORKSPACESIZE-1; i>=0; i--) { + object *obj = &Workspace[i]; + car(obj) = NULL; + cdr(obj) = Freelist; + Freelist = obj; + Freespace++; + } } /* myalloc - returns the first object from the linked list of free objects */ -object *myalloc () { - if (Freespace == 0) { Context = NIL; error2("no room"); } - object *temp = Freelist; - Freelist = cdr(Freelist); - Freespace--; - return temp; +object * +myalloc() +{ + if (Freespace == 0) { + Context = NIL; + error2("no room"); + } + + object *temp = Freelist; + Freelist = cdr(Freelist); + Freespace--; + + return temp; } /* myfree - adds obj to the linked list of free objects. inline makes gc significantly faster */ -inline void myfree (object *obj) { - car(obj) = NULL; - cdr(obj) = Freelist; - Freelist = obj; - Freespace++; +inline void +myfree(object *obj) +{ + car(obj) = NULL; + cdr(obj) = Freelist; + Freelist = obj; + Freespace++; } // Make each type of object @@ -715,138 +778,191 @@ inline void myfree (object *obj) { /* number - make an integer object with value n and return it */ -object *number (int n) { - object *ptr = myalloc(); - ptr->type = NUMBER; - ptr->integer = n; - return ptr; +object * +number(int n) +{ + object *ptr = myalloc(); + ptr->type = NUMBER; + ptr->integer = n; + + return ptr; } /* makefloat - make a floating point object with value f and return it */ -object *makefloat (float f) { - object *ptr = myalloc(); - ptr->type = FLOAT; - ptr->single_float = f; - return ptr; +object * +makefloat(float f) +{ + object *ptr = myalloc(); + ptr->type = FLOAT; + ptr->single_float = f; + + return ptr; } /* character - make a character object with value c and return it */ -object *character (uint8_t c) { - object *ptr = myalloc(); - ptr->type = CHARACTER; - ptr->chars = c; - return ptr; +object * +character(uint8_t c) +{ + object *ptr = myalloc(); + ptr->type = CHARACTER; + ptr->chars = c; + + return ptr; } /* cons - make a cons with arg1 and arg2 return it */ -object *cons (object *arg1, object *arg2) { - object *ptr = myalloc(); - ptr->car = arg1; - ptr->cdr = arg2; - return ptr; +object * +cons(object *arg1, object *arg2) +{ + object *ptr = myalloc(); + ptr->car = arg1; + ptr->cdr = arg2; + + return ptr; } /* symbol - make a symbol object with value name and return it */ -object *symbol (symbol_t name) { - object *ptr = myalloc(); - ptr->type = SYMBOL; - ptr->name = name; - return ptr; +object * +symbol(symbol_t name) +{ + object *ptr = myalloc(); + ptr->type = SYMBOL; + ptr->name = name; + + return ptr; } /* bsymbol - make a built-in symbol */ -inline object *bsymbol (builtin_t name) { - return intern(twist(name+BUILTINS)); +inline object * +bsymbol(builtin_t name) +{ + return intern(twist(name+BUILTINS)); } /* codehead - make a code header object with value entry and return it */ -object *codehead (int entry) { - object *ptr = myalloc(); - ptr->type = CODE; - ptr->integer = entry; - return ptr; +object * +codehead(int entry) +{ + object *ptr = myalloc(); + ptr->type = CODE; + ptr->integer = entry; + + return ptr; } /* - intern - unless PSRAM: looks through the workspace for an existing occurrence of symbol name and returns it, - otherwise calls symbol(name) to create a new symbol. + intern - unless PSRAM: looks through the workspace for an existing + occurrence of symbol name and returns it, otherwise calls + symbol(name) to create a new symbol. */ -object *intern (symbol_t name) { - #if !defined(BOARD_HAS_PSRAM) - for (int i=0; itype == SYMBOL && obj->name == name) return obj; - } - #endif - return symbol(name); +object * +intern (symbol_t name) +{ +#if !defined(BOARD_HAS_PSRAM) + for (int i=0; itype == SYMBOL && obj->name == name) { + return obj; + } + } +#endif + + return symbol(name); } /* eqsymbols - compares the long string/symbol obj with the string in buffer. */ -bool eqsymbols (object *obj, char *buffer) { - object *arg = cdr(obj); - int i = 0; - while (!(arg == NULL && buffer[i] == 0)) { - if (arg == NULL || buffer[i] == 0) return false; - chars_t test = 0; int shift = 24; - for (int j=0; j<4; j++, i++) { - if (buffer[i] == 0) break; - test = test | buffer[i]<chars != test) return false; - arg = car(arg); - } - return true; +bool +eqsymbols(object *obj, char *buffer) +{ + int i = 0; + object *arg = cdr(obj); + + while (!(arg == NULL && buffer[i] == 0)) { + if (arg == NULL || buffer[i] == 0) { + return false; + } + + chars_t test = 0; + int shift = 24; + + for (int j=0; j<4; j++, i++) { + if (buffer[i] == 0) break; + test = test | buffer[i]<chars != test) { + return false; + } + + arg = car(arg); + } + + return true; } /* - internlong - unless PSRAM looks through the workspace for an existing occurrence of the long symbol in buffer and returns it, - otherwise calls lispstring(buffer) to create a new symbol. + internlong - unless PSRAM looks through the workspace for an + existing occurrence of the long symbol in buffer and returns it, + otherwise calls lispstring(buffer) to create a new symbol. */ -object *internlong (char *buffer) { - #if !defined(BOARD_HAS_PSRAM) - for (int i=0; itype == SYMBOL && longsymbolp(obj) && eqsymbols(obj, buffer)) return obj; - } - #endif - object *obj = lispstring(buffer); - obj->type = SYMBOL; - return obj; +object * +internlong (char *buffer) +{ +#if !defined(BOARD_HAS_PSRAM) + for (int i=0; itype == SYMBOL && longsymbolp(obj) && eqsymbols(obj, buffer)) { + return obj; + } + } +#endif + object *obj = lispstring(buffer); + obj->type = SYMBOL; + return obj; } /* - stream - makes a stream object defined by streamtype and address, and returns it + stream - makes a stream object defined by streamtype and address, + and returns it */ -object *stream (uint8_t streamtype, uint8_t address) { - object *ptr = myalloc(); - ptr->type = STREAM; - ptr->integer = streamtype<<8 | address; - return ptr; +object * +stream(uint8_t streamtype, uint8_t address) +{ + object *ptr = myalloc(); + ptr->type = STREAM; + ptr->integer = streamtype<<8 | address; + + return ptr; } /* newstring - makes an empty string object and returns it */ -object *newstring () { - object *ptr = myalloc(); - ptr->type = STRING; - ptr->chars = 0; - return ptr; +object * +newstring() +{ + object *ptr = myalloc(); + ptr->type = STRING; + ptr->chars = 0; + + return ptr; } // Features @@ -862,24 +978,26 @@ const char sdcard[] = ":sd-card"; const char arm[] = ":arm"; const char riscv[] = ":risc-v"; -object *features () { - object *result = NULL; - #if defined(__riscv) - push(internlong((char *)riscv), result); - #else - push(internlong((char *)arm), result); - #endif - #if defined(sdcardsupport) - push(internlong((char *)sdcard), result); - #endif - push(internlong((char *)gfx), result); - push(internlong((char *)wifi), result); - push(internlong((char *)errorhandling), result); - push(internlong((char *)machinecode), result); - push(internlong((char *)doc), result); - push(internlong((char *)arrays), result); - push(internlong((char *)floatingpoint), result); - return result; +object * +features() +{ + object *result = NULL; +#if defined(__riscv) + push(internlong((char *)riscv), result); +#else + push(internlong((char *)arm), result); +#endif +#if defined(sdcardsupport) + push(internlong((char *)sdcard), result); +#endif + push(internlong((char *)gfx), result); + push(internlong((char *)wifi), result); + push(internlong((char *)errorhandling), result); + push(internlong((char *)machinecode), result); + push(internlong((char *)doc), result); + push(internlong((char *)arrays), result); + push(internlong((char *)floatingpoint), result); + return result; } // Garbage collection @@ -887,142 +1005,202 @@ object *features () { /* markobject - recursively marks reachable objects, starting from obj */ -void markobject (object *obj) { - MARK: - if (obj == NULL) return; - if (marked(obj)) return; +void +markobject(object *obj) +{ +MARK: + if (obj == NULL) return; + if (marked(obj)) return; - object* arg = car(obj); - unsigned int type = obj->type; - mark(obj); + object* arg = car(obj); + unsigned int type = obj->type; + mark(obj); - if (type >= PAIR || type == ZZERO) { // cons - markobject(arg); - obj = cdr(obj); - goto MARK; - } + if (type >= PAIR || type == ZZERO) { // cons + markobject(arg); + obj = cdr(obj); - if (type == ARRAY) { - obj = cdr(obj); - goto MARK; - } + goto MARK; + } - if ((type == STRING) || (type == SYMBOL && longsymbolp(obj))) { - obj = cdr(obj); - while (obj != NULL) { - arg = car(obj); - mark(obj); - obj = arg; - } - } + if (type == ARRAY) { + obj = cdr(obj); + + goto MARK; + } + + if ((type == STRING) || (type == SYMBOL && longsymbolp(obj))) { + obj = cdr(obj); + + while (obj != NULL) { + arg = car(obj); + mark(obj); + obj = arg; + } + } } /* - sweep - goes through the workspace freeing objects that have not been marked, - and unmarks marked objects + sweep - goes through the workspace freeing objects that have not + been marked, and unmarks marked objects */ -void sweep () { - Freelist = NULL; - Freespace = 0; - for (int i=WORKSPACESIZE-1; i>=0; i--) { - object *obj = &Workspace[i]; - if (!marked(obj)) myfree(obj); else unmark(obj); - } +void +sweep() +{ + Freelist = NULL; + Freespace = 0; + + for (int i=WORKSPACESIZE-1; i>=0; i--) { + object *obj = &Workspace[i]; + if (!marked(obj)) { + myfree(obj); + } else { + unmark(obj); + } + } } /* - gc - performs garbage collection by calling markobject() on each of the pointers to objects in use, - followed by sweep() to free unused objects. + gc - performs garbage collection by calling markobject() on each + of the pointers to objects in use, followed by sweep() to free + unused objects. */ -void gc (object *form, object *env) { - #if defined(printgcs) - int start = Freespace; - #endif - markobject(tee); - markobject(GlobalEnv); - markobject(GCStack); - markobject(form); - markobject(env); - sweep(); - #if defined(printgcs) - pfl(pserial); pserial('{'); pint(Freespace - start, pserial); pserial('}'); - #endif +void +gc(object *form, object *env) +{ +#if defined(printgcs) + int start = Freespace; +#endif + + markobject(tee); + markobject(GlobalEnv); + markobject(GCStack); + markobject(form); + markobject(env); + sweep(); + +#if defined(printgcs) + pfl(pserial); + pserial('{'); + pint(Freespace - start, pserial); + pserial('}'); +#endif } // Compact image /* - movepointer - Corrects pointers to an object that has been moved from 'from' to 'to'. - Only need to scan addresses below 'from' as there are no accessible objects above that. + movepointer - Corrects pointers to an object that has been moved + from 'from' to 'to'. Only need to scan addresses below 'from' + as there are no accessible objects above that. */ -void movepointer (object *from, object *to) { - uintptr_t limit = ((uintptr_t)(from) - (uintptr_t)(Workspace))/sizeof(uintptr_t); - for (uintptr_t i=0; itype) & ~MARKBIT; - if (marked(obj) && (type >= ARRAY || type==ZZERO || (type == SYMBOL && longsymbolp(obj)))) { - if (car(obj) == (object *)((uintptr_t)from | MARKBIT)) - car(obj) = (object *)((uintptr_t)to | MARKBIT); - if (cdr(obj) == from) cdr(obj) = to; - } - } - // Fix strings and long symbols - for (uintptr_t i=0; itype) & ~MARKBIT; - if (type == STRING || (type == SYMBOL && longsymbolp(obj))) { - obj = cdr(obj); - while (obj != NULL) { - if (cdr(obj) == to) cdr(obj) = from; - obj = (object *)((uintptr_t)(car(obj)) & ~MARKBIT); - } - } - } - } +void +movepointer(object *from, object *to) +{ + uintptr_t limit = ((uintptr_t)(from) - (uintptr_t)(Workspace))/sizeof(uintptr_t); + for (uintptr_t i=0; itype) & ~MARKBIT; + if (marked(obj) && (type >= ARRAY || type==ZZERO || \ + (type == SYMBOL && longsymbolp(obj)))) { + if (car(obj) == (object *)((uintptr_t)from | MARKBIT)) { + car(obj) = (object *)((uintptr_t)to | MARKBIT); + } + + if (cdr(obj) == from) { + cdr(obj) = to; + } + } + } + + // Fix strings and long symbols for (uintptr_t i=0; itype) & ~MARKBIT; + if (type == STRING || (type == SYMBOL && longsymbolp(obj))) { + obj = cdr(obj); + while (obj != NULL) { + if (cdr(obj) == to) { + cdr(obj) = from; + } + + obj = (object *)((uintptr_t)(car(obj)) & ~MARKBIT); + } + } + } + } } /* - compactimage - Marks all accessible objects. Moves the last marked object down to the first free space gap, correcting - pointers by calling movepointer(). Then repeats until there are no more gaps. + compactimage - Marks all accessible objects. Moves the last marked + object down to the first free space gap, correcting pointers by + calling movepointer(). Then repeats until there are no more gaps. */ -uintptr_t compactimage (object **arg) { - markobject(tee); - markobject(GlobalEnv); - markobject(GCStack); - object *firstfree = Workspace; - while (marked(firstfree)) firstfree++; - object *obj = &Workspace[WORKSPACESIZE-1]; - while (firstfree < obj) { - if (marked(obj)) { - car(firstfree) = car(obj); - cdr(firstfree) = cdr(obj); - unmark(obj); - movepointer(obj, firstfree); - if (GlobalEnv == obj) GlobalEnv = firstfree; - if (GCStack == obj) GCStack = firstfree; - if (*arg == obj) *arg = firstfree; - while (marked(firstfree)) firstfree++; - } - obj--; - } - sweep(); - return firstfree - Workspace; +uintptr_t +compactimage(object **arg) +{ + markobject(tee); + markobject(GlobalEnv); + markobject(GCStack); + object *firstfree = Workspace; + + while (marked(firstfree)) { + firstfree++; + } + + object *obj = &Workspace[WORKSPACESIZE-1]; + + while (firstfree < obj) { + if (marked(obj)) { + car(firstfree) = car(obj); + cdr(firstfree) = cdr(obj); + unmark(obj); + movepointer(obj, firstfree); + + if (GlobalEnv == obj) { + GlobalEnv = firstfree; + } + + if (GCStack == obj) { + GCStack = firstfree; + } + + if (*arg == obj) { + *arg = firstfree; + } + + while (marked(firstfree)) { + firstfree++; + } + } + obj--; + } + + sweep(); + return firstfree - Workspace; } // Make SD card filename -char *MakeFilename (object *arg, char *buffer) { - int max = BUFFERSIZE-1; - buffer[0]='/'; - int i = 1; - do { - char c = nthchar(arg, i-1); - if (c == '\0') break; - buffer[i++] = c; - } while (i>8 & 0xFF); - file.write(data>>16 & 0xFF); file.write(data>>24 & 0xFF); +void +SDWrite32(File file, int data) +{ + file.write(data & 0xFF); + file.write(data>>8 & 0xFF); + file.write(data>>16 & 0xFF); + file.write(data>>24 & 0xFF); } -int SDRead32 (File file) { - uintptr_t b0 = file.read(); uintptr_t b1 = file.read(); - uintptr_t b2 = file.read(); uintptr_t b3 = file.read(); - return b0 | b1<<8 | b2<<16 | b3<<24; +int +SDRead32(File file) +{ + uintptr_t b0 = file.read(); + uintptr_t b1 = file.read(); + uintptr_t b2 = file.read(); + uintptr_t b3 = file.read(); + + return b0 | b1<<8 | b2<<16 | b3<<24; } + #elif defined(LITTLEFS) -void FSWrite32 (File file, uint32_t data) { - union { uint32_t data2; uint8_t u8[4]; }; - data2 = data; - if (file.write(u8, 4) != 4) error2("not enough room"); +void +FSWrite32(File file, uint32_t data) +{ + union { + uint32_t data2; + uint8_t u8[4]; + }; + + data2 = data; + if (file.write(u8, 4) != 4) { + error2("not enough room"); + } } -uint32_t FSRead32 (File file) { - union { uint32_t data; uint8_t u8[4]; }; - file.read(u8, 4); - return data; +uint32_t +FSRead32(File file) +{ + union { + uint32_t data; + uint8_t u8[4]; + }; + + file.read(u8, 4); + return data; } + #elif defined(DATAFLASH) // Winbond DataFlash support for Adafruit M4 Express boards #define PAGEPROG 0x02 @@ -1078,438 +1283,647 @@ const int sck = 38, ssel = 39, mosi = 37, miso = 36; const int sck = PIN_QSPI_SCK, ssel = PIN_QSPI_CS, mosi = PIN_QSPI_IO0, miso = PIN_QSPI_IO1; #endif -void FlashBusy () { - digitalWrite(ssel, 0); - FlashWrite(READSTATUS); - while ((FlashReadByte() & 1) != 0); - digitalWrite(ssel, 1); +void +FlashBusy() +{ + digitalWrite(ssel, 0); + FlashWrite(READSTATUS); + + while ((FlashReadByte() & 1) != 0); + + digitalWrite(ssel, 1); } -inline void FlashWrite (uint8_t data) { - shiftOut(mosi, sck, MSBFIRST, data); +inline void +FlashWrite(uint8_t data) +{ + shiftOut(mosi, sck, MSBFIRST, data); } -inline uint8_t FlashReadByte () { - return shiftIn(miso, sck, MSBFIRST); +inline uint8_t +FlashReadByte() +{ + return shiftIn(miso, sck, MSBFIRST); } -void FlashWriteByte (uint32_t *addr, uint8_t data) { - // New page - if (((*addr) & 0xFF) == 0) { - digitalWrite(ssel, 1); - FlashBusy(); - FlashWriteEnable(); - digitalWrite(ssel, 0); - FlashWrite(PAGEPROG); - FlashWrite((*addr)>>16); - FlashWrite((*addr)>>8); - FlashWrite(0); - } - FlashWrite(data); - (*addr)++; +void +FlashWriteByte(uint32_t *addr, uint8_t data) +{ + // New page + if (((*addr) & 0xFF) == 0) { + digitalWrite(ssel, 1); + FlashBusy(); + FlashWriteEnable(); + digitalWrite(ssel, 0); + FlashWrite(PAGEPROG); + FlashWrite((*addr)>>16); + FlashWrite((*addr)>>8); + FlashWrite(0); + } + + FlashWrite(data); + (*addr)++; } -void FlashWriteEnable () { - digitalWrite(ssel, 0); - FlashWrite(WRITEENABLE); - digitalWrite(ssel, 1); +void +FlashWriteEnable() +{ + digitalWrite(ssel, 0); + FlashWrite(WRITEENABLE); + digitalWrite(ssel, 1); } -bool FlashCheck () { - uint8_t devID; - digitalWrite(ssel, HIGH); pinMode(ssel, OUTPUT); - pinMode(sck, OUTPUT); - pinMode(mosi, OUTPUT); - pinMode(miso, INPUT); - digitalWrite(sck, LOW); digitalWrite(mosi, HIGH); - digitalWrite(ssel, LOW); - FlashWrite(READID); - for (uint8_t i=0; i<4; i++) FlashReadByte(); - devID = FlashReadByte(); - digitalWrite(ssel, HIGH); - return (devID >= 0x14 && devID <= 0x17); // true = found correct device +bool +FlashCheck() +{ + uint8_t devID; + + digitalWrite(ssel, HIGH); pinMode(ssel, OUTPUT); + pinMode(sck, OUTPUT); + pinMode(mosi, OUTPUT); + pinMode(miso, INPUT); + digitalWrite(sck, LOW); digitalWrite(mosi, HIGH); + digitalWrite(ssel, LOW); + FlashWrite(READID); + + for (uint8_t i=0; i<4; i++) { + FlashReadByte(); + } + + devID = FlashReadByte(); + digitalWrite(ssel, HIGH); + + return (devID >= 0x14 && devID <= 0x17); // true = found correct device } -void FlashBeginWrite (uint32_t *addr, uint32_t bytes) { - *addr = 0; - uint8_t blocks = (bytes+65535)/65536; - // Erase 64K - for (uint8_t b=0; b>8 & 0xFF); - FlashWriteByte(addr, data>>16 & 0xFF); FlashWriteByte(addr, data>>24 & 0xFF); +void +FlashWrite32(uint32_t *addr, uint32_t data) +{ + FlashWriteByte(addr, data & 0xFF); + FlashWriteByte(addr, data>>8 & 0xFF); + FlashWriteByte(addr, data>>16 & 0xFF); + FlashWriteByte(addr, data>>24 & 0xFF); } -inline void FlashEndWrite (uint32_t *addr) { - (void) addr; - digitalWrite(ssel, 1); - FlashBusy(); +inline void +FlashEndWrite (uint32_t *addr) +{ + (void) addr; + digitalWrite(ssel, 1); + FlashBusy(); } -void FlashBeginRead (uint32_t *addr) { - *addr = 0; - FlashBusy(); - digitalWrite(ssel, 0); - FlashWrite(READDATA); - FlashWrite(0); FlashWrite(0); FlashWrite(0); +void +FlashBeginRead(uint32_t *addr) +{ + *addr = 0; + FlashBusy(); + digitalWrite(ssel, 0); + FlashWrite(READDATA); + FlashWrite(0); + FlashWrite(0); + FlashWrite(0); } -uint32_t FlashRead32 (uint32_t *addr) { - (void) addr; - uint8_t b0 = FlashReadByte(); uint8_t b1 = FlashReadByte(); - uint8_t b2 = FlashReadByte(); uint8_t b3 = FlashReadByte(); - return b0 | b1<<8 | b2<<16 | b3<<24; +uint32_t +FlashRead32(uint32_t *addr) +{ + (void) addr; + uint8_t b0 = FlashReadByte(); + uint8_t b1 = FlashReadByte(); + uint8_t b2 = FlashReadByte(); + uint8_t b3 = FlashReadByte(); + + return b0 | b1<<8 | b2<<16 | b3<<24; } -inline void FlashEndRead(uint32_t *addr) { - (void) addr; - digitalWrite(ssel, 1); +inline void +FlashEndRead(uint32_t *addr) +{ + (void) addr; + digitalWrite(ssel, 1); } #elif defined(CPUFLASH) // For ATSAMD21 __attribute__((__aligned__(256))) static const uint8_t flash_store[FLASHSIZE] = { }; -void row_erase (const volatile void *addr) { - NVMCTRL->ADDR.reg = ((uint32_t)addr) / 2; - NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_ER; - while (!NVMCTRL->INTFLAG.bit.READY); +void +row_erase(const volatile void *addr) +{ + NVMCTRL->ADDR.reg = ((uint32_t)addr) / 2; + NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_ER; + + while (!NVMCTRL->INTFLAG.bit.READY); } -void page_clear () { - // Execute "PBC" Page Buffer Clear - NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_PBC; - while (NVMCTRL->INTFLAG.bit.READY == 0); +void +page_clear() +{ + // Execute "PBC" Page Buffer Clear + NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_PBC; + while (NVMCTRL->INTFLAG.bit.READY == 0); } -void page_write () { - NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_WP; - while (NVMCTRL->INTFLAG.bit.READY == 0); +void +page_write() +{ + NVMCTRL->CTRLA.reg = NVMCTRL_CTRLA_CMDEX_KEY | NVMCTRL_CTRLA_CMD_WP; + while (NVMCTRL->INTFLAG.bit.READY == 0); } -bool FlashCheck() { - return true; +bool +FlashCheck() +{ + return true; } -void FlashBeginWrite(uint32_t *addr, uint32_t bytes) { - (void) bytes; - *addr = (uint32_t)flash_store; - // Disable automatic page write - NVMCTRL->CTRLB.bit.MANW = 1; +void +FlashBeginWrite(uint32_t *addr, uint32_t bytes) +{ + (void) bytes; + *addr = (uint32_t)flash_store; + + // Disable automatic page write + NVMCTRL->CTRLB.bit.MANW = 1; } -void FlashWrite32 (uint32_t *addr, uint32_t data) { - if (((*addr) & 0xFF) == 0) row_erase((const volatile void *)(*addr)); - if (((*addr) & 0x3F) == 0) page_clear(); - *(volatile uint32_t *)(*addr) = data; - (*addr) = (*addr) + 4; - if (((*addr) & 0x3F) == 0) page_write(); +void +FlashWrite32(uint32_t *addr, uint32_t data) +{ + if (((*addr) & 0xFF) == 0) { + row_erase((const volatile void *)(*addr)); + } + + if (((*addr) & 0x3F) == 0) { + page_clear(); + } + + *(volatile uint32_t *)(*addr) = data; + (*addr) = (*addr) + 4; + + if (((*addr) & 0x3F) == 0) { + page_write(); + } } -void FlashEndWrite (uint32_t *addr) { - if (((*addr) & 0x3F) != 0) page_write(); +void +FlashEndWrite(uint32_t *addr) +{ + if (((*addr) & 0x3F) != 0) { + page_write(); + } } -void FlashBeginRead(uint32_t *addr) { - *addr = (uint32_t)flash_store; +void +FlashBeginRead(uint32_t *addr) +{ + *addr = (uint32_t)flash_store; } -uint32_t FlashRead32 (uint32_t *addr) { - uint32_t data = *(volatile const uint32_t *)(*addr); - (*addr) = (*addr) + 4; - return data; +uint32_t +FlashRead32(uint32_t *addr) +{ + uint32_t data = *(volatile const uint32_t *)(*addr); + (*addr) = (*addr) + 4; + + return data; } -void FlashEndRead (uint32_t *addr) { - (void) addr; +void +FlashEndRead(uint32_t *addr) +{ + (void) addr; } + #elif defined(EEPROMFLASH) - -bool FlashCheck() { - return (EEPROM.length() == FLASHSIZE); +bool +FlashCheck() +{ + return (EEPROM.length() == FLASHSIZE); } -void FlashBeginWrite(uint32_t *addr, uint32_t bytes) { - (void) bytes; - *addr = 0; +void +FlashBeginWrite(uint32_t *addr, uint32_t bytes) +{ + (void) bytes; + *addr = 0; } -void FlashWrite32 (uint32_t *addr, uint32_t data) { - EEPROM.put(*addr, data); - (*addr) = (*addr) + 4; +void +FlashWrite32(uint32_t *addr, uint32_t data) +{ + EEPROM.put(*addr, data); + (*addr) = (*addr) + 4; } -void FlashEndWrite (uint32_t *addr) { - (void) addr; +void +FlashEndWrite(uint32_t *addr) +{ + (void) addr; } -void FlashBeginRead(uint32_t *addr) { - *addr = 0; +void +FlashBeginRead(uint32_t *addr) +{ + *addr = 0; } -uint32_t FlashRead32 (uint32_t *addr) { - uint32_t data; - EEPROM.get(*addr, data); - (*addr) = (*addr) + 4; - return data; +uint32_t +FlashRead32(uint32_t *addr) +{ + uint32_t data; + EEPROM.get(*addr, data); + (*addr) = (*addr) + 4; + + return data; } -void FlashEndRead (uint32_t *addr) { - (void) addr; +void +FlashEndRead(uint32_t *addr) +{ + (void) addr; } #endif /* - saveimage - saves an image of the workspace to the persistent storage selected for the platform. + saveimage - saves an image of the workspace to the persistent + storage selected for the platform. */ -int saveimage (object *arg) { +int +saveimage(object *arg) +{ #if defined(sdcardsupport) - unsigned int imagesize = compactimage(&arg); - #if defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_2W) - #if defined(CPI_PICOCALC) - if(!SD.begin(SDCARD_SS_PIN, (uint32_t) SPI_HALF_SPEED, SPI)){ - error2(PSTR("problem init SD card")); - return 0; - } - #else - SD.begin(SDCARD_SS_PIN,(uint32_t) SPI_HALF_SPEED, SPI1); - #endif - #else - SDBegin(); - #endif + unsigned int imagesize = compactimage(&arg); +#if defined(RASPBERRY_PI_PICO_PLATFORM) +#if defined(CPI_PICOCALC) + if(!SD.begin(SDCARD_SS_PIN, (uint32_t) SPI_HALF_SPEED, SPI)){ + error2(PSTR("failed to init SD card")); - File file; - if (stringp(arg)) { - char buffer[BUFFERSIZE]; - file = SD.open(MakeFilename(arg, buffer), O_RDWR | O_CREAT | O_TRUNC); - if (!file) error2("problem saving to SD card or invalid filename"); - arg = NULL; - } else if (arg == NULL || listp(arg)) { - file = SD.open("/ULISP.IMG", O_RDWR | O_CREAT | O_TRUNC); - if (!file) error2("problem saving to SD card"); - } else error(invalidarg, arg); - SDWrite32(file, (uintptr_t)arg); - SDWrite32(file, imagesize); - SDWrite32(file, (uintptr_t)GlobalEnv); - SDWrite32(file, (uintptr_t)GCStack); - for (int i=0; i FLASHSIZE) error("image too large", number(imagesize)); - uint32_t addr; - FlashBeginWrite(&addr, bytesneeded); - FlashWrite32(&addr, (uintptr_t)arg); - FlashWrite32(&addr, imagesize); - FlashWrite32(&addr, (uintptr_t)GlobalEnv); - FlashWrite32(&addr, (uintptr_t)GCStack); - for (int i=0; i FLASHSIZE) { + error("image too large", number(imagesize)); + } + + uint32_t addr; + FlashBeginWrite(&addr, bytesneeded); + FlashWrite32(&addr, (uintptr_t)arg); + FlashWrite32(&addr, imagesize); + FlashWrite32(&addr, (uintptr_t)GlobalEnv); + FlashWrite32(&addr, (uintptr_t)GCStack); + + for (int i=0; itype; - return type >= PAIR || type == ZZERO; +bool +consp(object *x) +{ + if (x == NULL) { + return false; + } + + unsigned int type = x->type; + return type >= PAIR || type == ZZERO; } /* @@ -1571,10 +2014,15 @@ bool consp (object *x) { /* listp - implements Lisp listp */ -bool listp (object *x) { - if (x == NULL) return true; - unsigned int type = x->type; - return type >= PAIR || type == ZZERO; +bool +listp(object *x) +{ + if (x == NULL) { + return true; + } + + unsigned int type = x->type; + return type >= PAIR || type == ZZERO; } /* @@ -1582,8 +2030,10 @@ bool listp (object *x) { */ #define improperp(x) (!listp(x)) -object *quote (object *arg) { - return cons(bsymbol(QUOTE), cons(arg,NULL)); +object * +quote(object *arg) +{ + return cons(bsymbol(QUOTE), cons(arg,NULL)); } // Radix 40 encoding @@ -1591,128 +2041,241 @@ object *quote (object *arg) { /* builtin - converts a symbol name to builtin */ -builtin_t builtin (symbol_t name) { - return (builtin_t)(untwist(name) - BUILTINS); +builtin_t +builtin(symbol_t name) +{ + return (builtin_t)(untwist(name) - BUILTINS); } /* sym - converts a builtin to a symbol name */ -symbol_t sym (builtin_t x) { - return twist(x + BUILTINS); +symbol_t +sym (builtin_t x) +{ + return twist(x + BUILTINS); } /* toradix40 - returns a number from 0 to 39 if the character can be encoded, or -1 otherwise. */ -int8_t toradix40 (char ch) { - if (ch == 0) return 0; - if (ch >= '0' && ch <= '9') return ch-'0'+1; - if (ch == '-') return 37; if (ch == '*') return 38; if (ch == '$') return 39; - ch = ch | 0x20; - if (ch >= 'a' && ch <= 'z') return ch-'a'+11; - return -1; // Invalid +int8_t +toradix40(char ch) +{ + if (ch == 0) { + return 0; + } + + if (ch >= '0' && ch <= '9') { + return ch-'0'+1; + } + + if (ch == '-') { + return 37; + } + + if (ch == '*') { + return 38; + } + + if (ch == '$') { + return 39; + } + + ch = ch | 0x20; + if (ch >= 'a' && ch <= 'z') { + return ch-'a'+11; + } + + return -1; // Invalid } /* fromradix40 - returns the character encoded by the number n. */ -char fromradix40 (char n) { - if (n >= 1 && n <= 10) return '0'+n-1; - if (n >= 11 && n <= 36) return 'a'+n-11; - if (n == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$'; - return 0; +char +fromradix40(char n) +{ + if (n >= 1 && n <= 10) { + return '0'+n-1; + } + + if (n >= 11 && n <= 36) { + return 'a'+n-11; + } + + if (n == 37) { + return '-'; + } + + if (n == 38) { + return '*'; + } + + if (n == 39) { + return '$'; + } + + return 0; } /* - pack40 - packs six radix40-encoded characters from buffer into a 32-bit number and returns it. + pack40 - packs six radix40-encoded characters from buffer into a + 32-bit number and returns it. */ -uint32_t pack40 (char *buffer) { - int x = 0, j = 0; - for (int i=0; i<6; i++) { - x = x * 40 + toradix40(buffer[j]); - if (buffer[j] != 0) j++; - } - return x; +uint32_t +pack40(char *buffer) +{ + int x = 0, j = 0; + for (int i=0; i<6; i++) { + x = x * 40 + toradix40(buffer[j]); + if (buffer[j] != 0) { + j++; + } + } + + return x; } /* - valid40 - returns true if the symbol in buffer can be encoded as six radix40-encoded characters. + valid40 - returns true if the symbol in buffer can be encoded as + six radix40-encoded characters. */ -bool valid40 (char *buffer) { - int t = 11; - for (int i=0; i<6; i++) { - if (toradix40(buffer[i]) < t) return false; - if (buffer[i] == 0) break; - t = 0; - } - return true; +bool +valid40(char *buffer) +{ + int t = 11; + + for (int i=0; i<6; i++) { + if (toradix40(buffer[i]) < t) { + return false; + } + + if (buffer[i] == 0) { + break; + } + + t = 0; + } + + return true; } /* - digitvalue - returns the numerical value of a hexadecimal digit, or 16 if invalid. + digitvalue - returns the numerical value of a hexadecimal digit, + or 16 if invalid. */ -int8_t digitvalue (char d) { - if (d>='0' && d<='9') return d-'0'; - d = d | 0x20; - if (d>='a' && d<='f') return d-'a'+10; - return 16; +int8_t +digitvalue(char d) +{ + if (d>='0' && d<='9') { + return d-'0'; + } + + d = d | 0x20; + if (d>='a' && d<='f') { + return d-'a'+10; + } + + return 16; } /* checkinteger - check that obj is an integer and return it */ -int checkinteger (object *obj) { - if (!integerp(obj)) error(notaninteger, obj); - return obj->integer; +int +checkinteger(object *obj) +{ + if (!integerp(obj)) { + error(notaninteger, obj); + } + + return obj->integer; } /* - checkbitvalue - check that obj is an integer equal to 0 or 1 and return it + checkbitvalue - check that obj is an integer equal to 0 or 1 and + return it */ -int checkbitvalue (object *obj) { - if (!integerp(obj)) error(notaninteger, obj); - int n = obj->integer; - if (n & ~1) error("argument is not a bit value", obj); - return n; +int +checkbitvalue(object *obj) +{ + if (!integerp(obj)) { + error(notaninteger, obj); + } + + int n = obj->integer; + if (n & ~1) { + error("argument is not a bit value", obj); + } + + return n; } /* - checkintfloat - check that obj is an integer or floating-point number and return the number + checkintfloat - check that obj is an integer or floating-point + number and return the number */ -float checkintfloat (object *obj) { - if (integerp(obj)) return (float)obj->integer; - if (!floatp(obj)) error(notanumber, obj); - return obj->single_float; +float +checkintfloat(object *obj) +{ + if (integerp(obj)) { + return (float)obj->integer; + } + + if (!floatp(obj)) { + error(notanumber, obj); + } + + return obj->single_float; } /* - checkchar - check that obj is a character and return the character + checkchar - check that obj is a character and return the character */ -int checkchar (object *obj) { - if (!characterp(obj)) error("argument is not a character", obj); - return obj->chars; +int +checkchar(object *obj) +{ + if (!characterp(obj)) { + error("argument is not a character", obj); + } + + return obj->chars; } /* checkstring - check that obj is a string */ -object *checkstring (object *obj) { - if (!stringp(obj)) error(notastring, obj); - return obj; +object * +checkstring(object *obj) +{ + if (!stringp(obj)) { + error(notastring, obj); + } + + return obj; } -int isstream (object *obj){ - if (!streamp(obj)) error("not a stream", obj); - return obj->integer; +int +isstream(object *obj) +{ + if (!streamp(obj)) { + error("not a stream", obj); + } + + return obj->integer; } -int isbuiltin (object *obj, builtin_t n) { - return symbolp(obj) && obj->name == sym(n); +int +isbuiltin(object *obj, builtin_t n) +{ + return symbolp(obj) && obj->name == sym(n); } -bool builtinp (symbol_t name) { - return (untwist(name) >= BUILTINS); +bool +builtinp(symbol_t name) +{ + return (untwist(name) >= BUILTINS); } int checkkeyword (object *obj) { @@ -2989,7 +3552,7 @@ inline int WiFiread () { LastChar = 0; return temp; } - while (!client.available()) testescape(); + while (!server.accept()) testescape(); return client.read(); } #endif @@ -4124,7 +4687,7 @@ object *sp_withsdcard (object *args, object *env) { #if defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_2W) #if defined(CPI_PICOCALC) if(!SD.begin(SDCARD_SS_PIN,(uint32_t) SPI_HALF_SPEED, SPI )){ - error2(PSTR("problem init SD card")); + error2(PSTR("failed to init SD card")); return nil; } #else @@ -6154,21 +6717,33 @@ object *fn_backtrace (object *args, object *env) { /* (save-image [symbol]) - Saves the current uLisp image to non-volatile memory or SD card so it can be loaded using load-image. + Saves the current uLisp image to non-volatile memory or SD card + so it can be loaded using load-image. */ -object *fn_saveimage (object *args, object *env) { - if (args != NULL) args = eval(first(args), env); - return number(saveimage(args)); +object * +fn_saveimage(object *args, object *env) +{ + if (args != NULL) { + args = eval(first(args), env); + } + + return number(saveimage(args)); } /* (load-image [filename]) Loads a saved uLisp image from non-volatile memory or SD card. */ -object *fn_loadimage (object *args, object *env) { - (void) env; - if (args != NULL) args = first(args); - return number(loadimage(args)); +object * +fn_loadimage(object *args, object *env) +{ + (void) env; + + if (args != NULL) { + args = first(args); + } + + return number(loadimage(args)); } /* @@ -6766,7 +7341,7 @@ object *sp_withclient (object *args, object *env) { params = cdr(params); int n; if (params == NULL) { - client = server.available(); + client = server.accept(); if (!client) return nil; n = 2; } else { @@ -6941,7 +7516,7 @@ object *sp_withgfx (object *args, object *env) { object *fn_drawpixel (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t colour = COLOR_WHITE; + uint16_t colour = TEXT_COLOR; if (cddr(args) != NULL) colour = checkinteger(third(args)); tft.drawPixel(checkinteger(first(args)), checkinteger(second(args)), colour); #else @@ -6957,7 +7532,7 @@ object *fn_drawpixel (object *args, object *env) { object *fn_drawline (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[4], colour = COLOR_WHITE; + uint16_t params[4], colour = TEXT_COLOR; for (int i=0; i<4; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.drawLine(params[0], params[1], params[2], params[3], colour); @@ -6975,7 +7550,7 @@ object *fn_drawline (object *args, object *env) { object *fn_drawrect (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[4], colour = COLOR_WHITE; + uint16_t params[4], colour = TEXT_COLOR; for (int i=0; i<4; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.drawRect(params[0], params[1], params[2], params[3], colour); @@ -6993,7 +7568,7 @@ object *fn_drawrect (object *args, object *env) { object *fn_fillrect (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[4], colour = COLOR_WHITE; + uint16_t params[4], colour = TEXT_COLOR; for (int i=0; i<4; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.fillRect(params[0], params[1], params[2], params[3], colour); @@ -7011,7 +7586,7 @@ object *fn_fillrect (object *args, object *env) { object *fn_drawcircle (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[3], colour = COLOR_WHITE; + uint16_t params[3], colour = TEXT_COLOR; for (int i=0; i<3; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.drawCircle(params[0], params[1], params[2], colour); @@ -7029,7 +7604,7 @@ object *fn_drawcircle (object *args, object *env) { object *fn_fillcircle (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[3], colour = COLOR_WHITE; + uint16_t params[3], colour = TEXT_COLOR; for (int i=0; i<3; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.fillCircle(params[0], params[1], params[2], colour); @@ -7047,7 +7622,7 @@ object *fn_fillcircle (object *args, object *env) { object *fn_drawroundrect (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[5], colour = COLOR_WHITE; + uint16_t params[5], colour = TEXT_COLOR; for (int i=0; i<5; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.drawRoundRect(params[0], params[1], params[2], params[3], params[4], colour); @@ -7065,7 +7640,7 @@ object *fn_drawroundrect (object *args, object *env) { object *fn_fillroundrect (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[5], colour = COLOR_WHITE; + uint16_t params[5], colour = TEXT_COLOR; for (int i=0; i<5; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.fillRoundRect(params[0], params[1], params[2], params[3], params[4], colour); @@ -7083,7 +7658,7 @@ object *fn_fillroundrect (object *args, object *env) { object *fn_drawtriangle (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[6], colour = COLOR_WHITE; + uint16_t params[6], colour = TEXT_COLOR; for (int i=0; i<6; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.drawTriangle(params[0], params[1], params[2], params[3], params[4], params[5], colour); @@ -7101,7 +7676,7 @@ object *fn_drawtriangle (object *args, object *env) { object *fn_filltriangle (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t params[6], colour = COLOR_WHITE; + uint16_t params[6], colour = TEXT_COLOR; for (int i=0; i<6; i++) { params[i] = checkinteger(car(args)); args = cdr(args); } if (args != NULL) colour = checkinteger(car(args)); tft.fillTriangle(params[0], params[1], params[2], params[3], params[4], params[5], colour); @@ -7121,7 +7696,7 @@ object *fn_filltriangle (object *args, object *env) { object *fn_drawchar (object *args, object *env) { (void) env; #if defined(gfxsupport) - uint16_t colour = COLOR_WHITE, bg = COLOR_BLACK, size = 1; + uint16_t colour = TEXT_COLOR, bg = BG_COLOR, size = 1; object *more = cdr(cddr(args)); if (more != NULL) { colour = checkinteger(car(more)); @@ -9286,28 +9861,34 @@ void prin1object (object *form, pfun_t pfun) { /* glibrary - reads a character from the Lisp Library */ -int glibrary () { - if (LastChar) { - char temp = LastChar; - LastChar = 0; - return temp; - } - char c = LispLibrary[GlobalStringIndex++]; - return (c != 0) ? c : -1; // -1? +int +glibrary() +{ + if (LastChar) { + char temp = LastChar; + LastChar = 0; + + return temp; + } + + char c = LispLibrary[GlobalStringIndex++]; + return (c != 0) ? c : -1; // -1? } /* loadfromlibrary - reads and evaluates a form from the Lisp Library */ -void loadfromlibrary (object *env) { - GlobalStringIndex = 0; - object *line = read(glibrary); - while (line != NULL) { - protect(line); - eval(line, env); - unprotect(); - line = read(glibrary); - } +void +loadfromlibrary(object *env) +{ + GlobalStringIndex = 0; + object *line = read(glibrary); + while (line != NULL) { + protect(line); + eval(line, env); + unprotect(); + line = read(glibrary); + } } // PicoCalc terminal and keyboard support @@ -9461,7 +10042,9 @@ int gserial () { */ object *nextitem (gfun_t gfun) { int ch = gfun(); - while(issp(ch)) ch = gfun(); + while(issp(ch)) { + ch = gfun(); + } if (ch == ';') { do { ch = gfun(); if (ch == ';' || ch == '(') setflag(NOECHO); } @@ -9618,9 +10201,15 @@ object *readrest (gfun_t gfun) { object *read (gfun_t gfun) { object *item = nextitem(gfun); if (item == (object *)KET) error2("incomplete list"); - if (item == (object *)BRA) return readrest(gfun); - if (item == (object *)DOT) return read(gfun); - if (item == (object *)QUO) return cons(bsymbol(QUOTE), cons(read(gfun), NULL)); + if (item == (object *)BRA) { + return readrest(gfun); + } + if (item == (object *)DOT) { + return read(gfun); + } + if (item == (object *)QUO) { + return cons(bsymbol(QUOTE), cons(read(gfun), NULL)); + } return item; } @@ -9633,9 +10222,9 @@ void PlotChar (uint8_t ch, uint8_t line, uint8_t column) { uint16_t x = column*6; ScrollBuf[column][(line+Scroll) % Lines] = ch; if (ch & 0x80) { - tft.drawChar(x, y, ch & 0x7f, TFT_BLACK, TFT_GREEN, 1); + tft.drawChar(x, y, ch & 0x7f, BG_COLOR, TEXT_COLOR, 1); } else { - tft.drawChar(x, y, ch & 0x7f, TFT_WHITE, TFT_BLACK, 1); + tft.drawChar(x, y, ch & 0x7f, TEXT_COLOR, BG_COLOR, 1); } #endif } @@ -9650,9 +10239,9 @@ void ScrollDisplay () { char c2 = ScrollBuf[x][(y+Scroll+1) % Lines]; if (c != c2) { if (c2 & 0x80) { - tft.drawChar(x*6, y*Leading, c2 & 0x7f, TFT_BLACK, TFT_GREEN, 1); + tft.drawChar(x*6, y*Leading, c2 & 0x7f, BG_COLOR, TFT_GREEN, 1); } else { - tft.drawChar(x*6, y*Leading, c2 & 0x7f, TFT_WHITE, TFT_BLACK, 1); + tft.drawChar(x*6, y*Leading, c2 & 0x7f, TEXT_COLOR, BG_COLOR, 1); } c = c2; } @@ -9814,33 +10403,36 @@ void initenv () { /* initgfx - initialises the graphics */ -void initgfx () { - #if defined(gfxsupport) - #if defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) - tft.initR(INITR_BLACKTAB); - tft.setRotation(1); - pinMode(TFT_BACKLIGHT, OUTPUT); - digitalWrite(TFT_BACKLIGHT, HIGH); - tft.fillScreen(0); - #elif defined(ARDUINO_WIO_TERMINAL) - tft.init(); - tft.setRotation(3); - tft.fillScreen(TFT_BLACK); - #elif defined(ARDUINO_NRF52840_CLUE) - tft.init(240, 240); - tft.setRotation(1); - tft.fillScreen(0); - pinMode(34, OUTPUT); // Backlight - digitalWrite(34, HIGH); - #elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_2) || defined(ARDUINO_RASPBERRY_PI_PICO_2W) - tft.init(); - #if defined(CPI_PICOCALC) - tft.setRotation(0); - tft.invertDisplay(1); - #endif - tft.fillScreen(TFT_BLACK); - #endif - #endif +void +initgfx() +{ +#if defined(gfxsupport) +#if defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) + tft.initR(INITR_BLACKTAB); + tft.setRotation(1); + pinMode(TFT_BACKLIGHT, OUTPUT); + digitalWrite(TFT_BACKLIGHT, HIGH); + tft.fillScreen(0); +#elif defined(ARDUINO_WIO_TERMINAL) + tft.init(); + tft.setRotation(3); + tft.fillScreen(TFT_BLACK); +#elif defined(ARDUINO_NRF52840_CLUE) + tft.init(240, 240); + tft.setRotation(1); + tft.fillScreen(0); + pinMode(34, OUTPUT); // Backlight + digitalWrite(34, HIGH); +#elif defined(RASPBERRY_PI_PICO_PLATFORM) + tft.init(); +#if defined(CPI_PICOCALC) + tft.setRotation(0); + tft.invertDisplay(1); +#endif + tft.fillScreen(TFT_BLACK); + tft.setTextColor(TEXT_COLOR); +#endif +#endif } void setup () { @@ -9932,17 +10524,22 @@ void repl (object *env) { /* loop - the Arduino IDE main execution loop */ -void loop () { - if (!setjmp(toplevel_handler)) { - #if defined(resetautorun) - volatile int autorun = 12; // Fudge to keep code size the same - #else - volatile int autorun = 13; - #endif - if (autorun == 12) autorunimage(); - } - ulisperror(); - repl(NULL); +void +loop() +{ + if (!setjmp(toplevel_handler)) { +#if defined(resetautorun) + volatile int autorun = 12; // Fudge to keep code size the same +#else + volatile int autorun = 13; +#endif + if (autorun == 12) { + autorunimage(); + } + } + + ulisperror(); + repl(NULL); } void ulisperror () { diff --git a/ulisp-extensions.ino b/ulisp-extensions.ino index 7c5599e..2da59f3 100644 --- a/ulisp-extensions.ino +++ b/ulisp-extensions.ino @@ -3,24 +3,30 @@ */ // Definitions -object *fn_now (object *args, object *env) { - (void) env; - static unsigned long Offset; - unsigned long now = millis()/1000; - int nargs = listlength(args); +object * +fn_now(object *args, object *env) +{ + (void) env; + static unsigned long Offset; + unsigned long now = millis()/1000; + int nargs = listlength(args); - // Set time - if (nargs == 3) { - Offset = (unsigned long)((checkinteger(first(args))*60 + checkinteger(second(args)))*60 - + checkinteger(third(args)) - now); - } else if (nargs > 0) error2(PSTR("wrong number of arguments")); - - // Return time - unsigned long secs = Offset + now; - object *seconds = number(secs%60); - object *minutes = number((secs/60)%60); - object *hours = number((secs/3600)%24); - return cons(hours, cons(minutes, cons(seconds, NULL))); + // Set time + if (nargs == 3) { + Offset = (unsigned long)((checkinteger(first(args))*60 \ + + checkinteger(second(args)))*60 \ + + checkinteger(third(args)) - now); + } else if (nargs > 0) { + error2(PSTR("wrong number of arguments")); + } + + // Return time + unsigned long secs = Offset + now; + object *seconds = number(secs%60); + object *minutes = number((secs/60)%60); + object *hours = number((secs/3600)%24); + + return cons(hours, cons(minutes, cons(seconds, NULL))); } // Symbol names @@ -41,10 +47,14 @@ const tbl_entry_t lookup_table2[] PROGMEM = { tbl_entry_t *tables[] = {lookup_table, lookup_table2}; const unsigned int tablesizes[] = { arraysize(lookup_table), arraysize(lookup_table2) }; -const tbl_entry_t *table (int n) { - return tables[n]; +const tbl_entry_t * +table(int n) +{ + return tables[n]; } -unsigned int tablesize (int n) { - return tablesizes[n]; +unsigned int +tablesize(int n) +{ + return tablesizes[n]; }