Skip to content

Instantly share code, notes, and snippets.

@andreer

andreer/sketch_mar03a.ino

Last active March 4, 2022 00:05
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save andreer/e6bf7798df38cc79ac9473b431e157d6 to your computer and use it in GitHub Desktop.
Save andreer/e6bf7798df38cc79ac9473b431e157d6 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
sketch_mar03a.ino
// This is a slightly edited version of uLisp for the Adafruit nrf52840 express board,
// connected to a 4.4 inch 320x240px SHARP memory display.
// It uses the "Adafruit SHARP Memory Display" arduino library - tested with version 1.1.0 only.
// Display was wired using the breakout board as in this [1] tutorial, but I connected the larger
// 4.4 inch LS044Q7DH01 display instead.
// There are way too many calls to tft.refresh() which makes it slow - deciding when to refresh
// is probably better left to the user code.
// WARNING: The screen should be refreshed regularly to avoid image burn-in - see the datasheet.
// [1] https://learn.adafruit.com/diy-rpn-desktop-calculator-with-circuitpython/3d-printing-wiring-assembly
/* uLisp ARM Version 4.1a - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 15th February 2022
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/
// Lisp Library
const char LispLibrary[] PROGMEM = "";
// Compile options
// #define resetautorun
#define printfreespace
// #define printgcs
// #define sdcardsupport
#define gfxsupport
// #define lisplibrary
#define assemblerlist
// #define lineeditor
// #define vt100
// Includes
// #include "LispLibrary.h"
#include <setjmp.h>
#include <SPI.h>
#include <Wire.h>
#include <limits.h>
#if defined(gfxsupport)
#include <Adafruit_GFX.h> // Core graphics library
//#include <Adafruit_ST7735.h> // Hardware-specific library for ST7735
#include <Adafruit_SharpMem.h>
#define COLOR_WHITE 0xffff
#define COLOR_BLACK 0
#define SHARP_SCK PIN_SPI_SCK
#define SHARP_MOSI PIN_SPI_MOSI
#define SHARP_SS PIN_SERIAL1_RX
// Adafruit PyBadge/PyGamer
//#define TFT_CS 44 // Chip select
//#define TFT_RST 46 // Display reset
//#define TFT_DC 45 // Display data/command select
//#define TFT_BACKLIGHT 47 // Display backlight pin
//#define TFT_MOSI 41 // Data out
//#define TFT_SCLK 42 // Clock out
Adafruit_SharpMem tft(SHARP_SCK, SHARP_MOSI, SHARP_SS, 320, 240);
#endif
#if defined(sdcardsupport)
#include <SD.h>
#define SDSIZE 91
#else
#define SDSIZE 0
#endif
// Platform specific settings
#define WORDALIGNED __attribute__((aligned (4)))
#define BUFFERSIZE 36 // Number of bits+4
#define RAMFUNC __attribute__ ((section (".ramfunctions")))
#define MEMBANK
#if defined(ARDUINO_GEMMA_M0) || defined(ARDUINO_SEEED_XIAO_M0) || defined(ARDUINO_QTPY_M0)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define EEPROMFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS)
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 128 /* Bytes */
#define SDCARD_SS_PIN 4
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ADAFRUIT_FEATHER_M0) /* Feather M0 without DataFlash */
#define WORKSPACESIZE (2816-SDSIZE) /* Objects (8*bytes) */
#define EEPROMFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define SDCARD_SS_PIN 4
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) || defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4)
#define WORKSPACESIZE (20608-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define SDCARD_SS_PIN 10
#define STACKDIFF 400
#define CPU_ATSAMD51
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
#define WORKSPACESIZE (28800-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 8192000 /* 8 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 400
#define CPU_ATSAMD51
#elif defined(ARDUINO_SAMD_MKRZERO)
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define EEPROMFLASH
#define FLASHSIZE 32768 /* Bytes */
#define SYMBOLTABLESIZE 512 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 840
#define CPU_ATSAMD21
#elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */
#define WORKSPACESIZE (2640-SDSIZE) /* Objects (8*bytes) */
#define EEPROMFLASH
#define FLASHSIZE 32768 /* Bytes */
#define CODESIZE 128 /* Bytes */
#define SDCARD_SS_PIN 10
#define STACKDIFF 320
#define CPU_ATSAMD21
#elif defined(ARDUINO_BBC_MICROBIT)
#define WORKSPACESIZE 1344 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
#elif defined(ARDUINO_BBC_MICROBIT_V2)
#define WORKSPACESIZE 12928 /* Objects (8*bytes) */
#define CODESIZE 128 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF52833
#elif defined(ARDUINO_CALLIOPE_MINI)
#define WORKSPACESIZE 3392 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
#elif defined(ARDUINO_SINOBIT)
#define WORKSPACESIZE 1344 /* Objects (8*bytes) */
#define CODESIZE 64 /* Bytes */
#define STACKDIFF 320
#define CPU_NRF51822
#elif defined(ARDUINO_NRF52840_ITSYBITSY) || defined(ARDUINO_NRF52840_CLUE)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 1200
#define CPU_NRF52840
#elif defined(ARDUINO_NRF52840_FEATHER)
#define WORKSPACESIZE (21120-SDSIZE) /* Objects (8*bytes) */
#define DATAFLASH
#define FLASHSIZE 2048000 /* 2 MBytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 1200
#define CPU_NRF52840
#elif defined(MAX32620)
#define WORKSPACESIZE (24704-SDSIZE) /* Objects (8*bytes) */
#define SYMBOLTABLESIZE 1024 /* Bytes */
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 320
#define CPU_MAX32620
#define Wire1 Wire2
#elif defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define WORKSPACESIZE 60000 /* Objects (8*bytes) */
#define LITTLEFS (960 * 1024)
#include <LittleFS.h>
LittleFS_Program LittleFS;
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 15000
#define CPU_iMXRT1062
#define SDCARD_SS_PIN BUILTIN_SDCARD
#define BitOrder uint8_t
#undef RAMFUNC
#define RAMFUNC FASTRUN
#undef MEMBANK
#define MEMBANK DMAMEM
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040)
#define WORKSPACESIZE (22912-SDSIZE) /* Objects (8*bytes) */
#define LITTLEFS
#include <LittleFS.h>
#define FILE_WRITE_BEGIN "w"
#define FILE_READ "r"
#define CODESIZE 256 /* Bytes */
#define STACKDIFF 320
#define CPU_RP2040
#else
#error "Board not supported!"
#endif
// C Macros
#define nil NULL
#define car(x) (((object *) (x))->car)
#define cdr(x) (((object *) (x))->cdr)
#define first(x) (((object *) (x))->car)
#define second(x) (car(cdr(x)))
#define cddr(x) (cdr(cdr(x)))
#define third(x) (car(cdr(cdr(x))))
#define push(x, y) ((y) = cons((x),(y)))
#define pop(y) ((y) = cdr(y))
#define integerp(x) ((x) != NULL && (x)->type == NUMBER)
#define floatp(x) ((x) != NULL && (x)->type == FLOAT)
#define symbolp(x) ((x) != NULL && (x)->type == SYMBOL)
#define stringp(x) ((x) != NULL && (x)->type == STRING)
#define characterp(x) ((x) != NULL && (x)->type == CHARACTER)
#define arrayp(x) ((x) != NULL && (x)->type == ARRAY)
#define streamp(x) ((x) != NULL && (x)->type == STREAM)
#define mark(x) (car(x) = (object *)(((uintptr_t)(car(x))) | MARKBIT))
#define unmark(x) (car(x) = (object *)(((uintptr_t)(car(x))) & ~MARKBIT))
#define marked(x) ((((uintptr_t)(car(x))) & MARKBIT) != 0)
#define MARKBIT 1
#define setflag(x) (Flags = Flags | 1<<(x))
#define clrflag(x) (Flags = Flags & ~(1<<(x)))
#define tstflag(x) (Flags & 1<<(x))
#define issp(x) (x == ' ' || x == '\n' || x == '\r' || x == '\t')
#define longsymbolp(x) (((x)->name & 0x03) == 0)
#define twist(x) ((uint32_t)((x)<<2) | (((x) & 0xC0000000)>>30))
#define untwist(x) (((x)>>2 & 0x3FFFFFFF) | ((x) & 0x03)<<30)
#define PACKEDS 0x43238000
#define BUILTINS 0xF4240000
// Code marker stores start and end of code block
#define startblock(x) ((x->integer) & 0xFFFF)
#define endblock(x) ((x->integer) >> 16 & 0xFFFF)
// Constants
const int TRACEMAX = 3; // Number of traced functions
enum type { ZZERO=0, SYMBOL=2, CODE=4, NUMBER=6, STREAM=8, CHARACTER=10, FLOAT=12, ARRAY=14, STRING=16, PAIR=18 }; // ARRAY STRING and PAIR must be last
enum token { UNUSED, BRA, KET, QUO, DOT };
enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM, STRINGSTREAM, GFXSTREAM };
// Stream names used by printobject
const char serialstream[] PROGMEM = "serial";
const char i2cstream[] PROGMEM = "i2c";
const char spistream[] PROGMEM = "spi";
const char sdstream[] PROGMEM = "sd";
const char stringstream[] PROGMEM = "string";
const char gfxstream[] PROGMEM = "gfx";
const char *const streamname[] PROGMEM = {serialstream, i2cstream, spistream, sdstream, stringstream, gfxstream};
// Typedefs
typedef uint32_t symbol_t;
typedef struct sobject {
union {
struct {
sobject *car;
sobject *cdr;
};
struct {
unsigned int type;
union {
symbol_t name;
int integer;
int chars; // For strings
float single_float;
};
};
};
} object;
typedef object *(*fn_ptr_type)(object *, object *);
typedef void (*mapfun_t)(object *, object **);
typedef int (*intfn_ptr_type)(int w, int x, int y, int z);
typedef const struct {
const char *string;
fn_ptr_type fptr;
uint8_t minmax;
} tbl_entry_t;
typedef int (*gfun_t)();
typedef void (*pfun_t)(char);
enum builtin_t { NIL, TEE, NOTHING, OPTIONAL, INITIALELEMENT, ELEMENTTYPE, BIT, AMPREST, LAMBDA, LET,
LETSTAR, CLOSURE, PSTAR, SPECIAL_FORMS, QUOTE, OR, DEFUN, DEFVAR, SETQ, LOOP, RETURN, PUSH, POP, INCF,
DECF, SETF, DOLIST, DOTIMES, TRACE, UNTRACE, FORMILLIS, TIME, WITHOUTPUTTOSTRING, WITHSERIAL, WITHI2C,
WITHSPI, WITHSDCARD, WITHGFX, DEFCODE, TAIL_FORMS, PROGN, IF, COND, WHEN, UNLESS, CASE, AND, FUNCTIONS,
NOT, NULLFN, CONS, ATOM, LISTP, CONSP, SYMBOLP, ARRAYP, BOUNDP, SETFN, STREAMP, EQ, CAR, FIRST, CDR, REST,
CAAR, CADR, SECOND, CDAR, CDDR, CAAAR, CAADR, CADAR, CADDR, THIRD, CDAAR, CDADR, CDDAR, CDDDR, LENGTH,
ARRAYDIMENSIONS, LIST, MAKEARRAY, REVERSE, NTH, AREFF, ASSOC, MEMBER, APPLY, FUNCALL, APPEND, MAPC, MAPCAR,
MAPCAN, ADD, SUBTRACT, MULTIPLY, DIVIDE, MOD, ONEPLUS, ONEMINUS, ABS, RANDOM, MAXFN, MINFN, NOTEQ, NUMEQ,
LESS, LESSEQ, GREATER, GREATEREQ, PLUSP, MINUSP, ZEROP, ODDP, EVENP, INTEGERP, NUMBERP, FLOATFN, FLOATP,
SIN, COS, TAN, ASIN, ACOS, ATAN, SINH, COSH, TANH, EXP, SQRT, LOG, EXPT, CEILING, FLOOR, TRUNCATE, ROUND,
CHAR, CHARCODE, CODECHAR, CHARACTERP, STRINGP, STRINGEQ, STRINGLESS, STRINGGREATER, SORT, STRINGFN,
CONCATENATE, SUBSEQ, READFROMSTRING, PRINCTOSTRING, PRIN1TOSTRING, LOGAND, LOGIOR, LOGXOR, LOGNOT, ASH,
LOGBITP, EVAL, GLOBALS, LOCALS, MAKUNBOUND, BREAK, READ, PRIN1, PRINT, PRINC, TERPRI, READBYTE, READLINE,
WRITEBYTE, WRITESTRING, WRITELINE, RESTARTI2C, GC, ROOM, SAVEIMAGE, LOADIMAGE, CLS, PINMODE, DIGITALREAD,
DIGITALWRITE, ANALOGREAD, ANALOGREFERENCE, ANALOGREADRESOLUTION, ANALOGWRITE, ANALOGWRITERESOLUTION,
DELAY, MILLIS, SLEEP, NOTE, REGISTER, EDIT, PPRINT, PPRINTALL, FORMAT, REQUIRE, LISTLIBRARY, DRAWPIXEL,
DRAWLINE, DRAWRECT, FILLRECT, DRAWCIRCLE, FILLCIRCLE, DRAWROUNDRECT, FILLROUNDRECT, DRAWTRIANGLE,
FILLTRIANGLE, DRAWCHAR, SETCURSOR, SETTEXTCOLOR, SETTEXTSIZE, SETTEXTWRAP, FILLSCREEN, SETROTATION,
INVERTDISPLAY, KEYWORDS,
K_LED_BUILTIN, K_HIGH, K_LOW,
#if defined(CPU_ATSAMD21)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_AR_DEFAULT, K_AR_INTERNAL1V0, K_AR_INTERNAL1V65,
K_AR_INTERNAL2V23, K_AR_EXTERNAL, K_PA_DIR, K_PA_DIRCLR, K_PA_DIRSET, K_PA_DIRTGL, K_PA_OUT, K_PA_OUTCLR,
K_PA_OUTSET, K_PA_OUTTGL, K_PA_IN, K_PB_DIR, K_PB_DIRCLR, K_PB_DIRSET, K_PB_DIRTGL, K_PB_OUT, K_PB_OUTCLR,
K_PB_OUTSET, K_PB_OUTTGL, K_PB_IN,
#elif defined(CPU_ATSAMD51)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_AR_DEFAULT, K_AR_INTERNAL1V0, K_AR_INTERNAL1V1,
K_AR_INTERNAL1V2, K_AR_INTERNAL1V25, K_AR_INTERNAL1V65, K_AR_INTERNAL2V0, K_AR_INTERNAL2V2,
K_AR_INTERNAL2V23, K_AR_INTERNAL2V4, K_AR_INTERNAL2V5, K_AR_EXTERNAL, K_PA_DIR, K_PA_DIRCLR, K_PA_DIRSET,
K_PA_DIRTGL, K_PA_OUT, K_PA_OUTCLR, K_PA_OUTSET, K_PA_OUTTGL, K_PA_IN, K_PB_DIR, K_PB_DIRCLR, K_PB_DIRSET,
K_PB_DIRTGL, K_PB_OUT, K_PB_OUTCLR, K_PB_OUTSET, K_PB_OUTTGL, K_PB_IN,
#elif defined(CPU_NRF51822)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_AR_DEFAULT, K_AR_VBG, K_AR_SUPPLY_ONE_HALF,
K_AR_SUPPLY_ONE_THIRD, K_AR_EXT0, K_AR_EXT1, K_P0_OUT, K_P0_OUTSET, K_P0_OUTCLR, K_P0_IN, K_P0_DIR,
K_P0_DIRSET, K_P0_DIRCLR,
#elif defined(CPU_NRF52840)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_AR_DEFAULT, K_AR_INTERNAL, K_AR_INTERNAL_3_0,
K_AR_INTERNAL_2_4, K_AR_INTERNAL_1_8, K_AR_INTERNAL_1_2, K_AR_VDD4, K_P0_OUT, K_P0_OUTSET, K_P0_OUTCLR,
K_P0_IN, K_P0_DIR, K_P0_DIRSET, K_P0_DIRCLR, K_P1_OUT, K_P1_OUTSET, K_P1_OUTCLR, K_P1_IN, K_P1_DIR,
K_P1_DIRSET, K_P1_DIRCLR,
#elif defined(CPU_NRF52833)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_AR_DEFAULT, K_AR_INTERNAL, K_AR_VDD4, K_P0_OUT,
K_P0_OUTSET, K_P0_OUTCLR, K_P0_IN, K_P0_DIR, K_P0_DIRSET, K_P0_DIRCLR, K_P1_OUT, K_P1_OUTSET, K_P1_OUTCLR,
K_P1_IN, K_P1_DIR, K_P1_DIRSET, K_P1_DIRCLR,
#elif defined(CPU_iMXRT1062)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT, K_OUTPUT_OPENDRAIN,
#elif defined(CPU_MAX32620)
K_INPUT, K_INPUT_PULLUP, K_OUTPUT, K_DEFAULT, K_EXTERNAL,
#elif defined(CPU_RP2040)
K_INPUT, K_INPUT_PULLUP, K_INPUT_PULLDOWN, K_OUTPUT,
K_GPIO_IN, K_GPIO_OUT, K_GPIO_OUT_SET, K_GPIO_OUT_CLR, K_GPIO_OUT_XOR, K_GPIO_OE, K_GPIO_OE_SET, K_GPIO_OE_CLR, K_GPIO_OE_XOR,
#endif
USERFUNCTIONS, ENDFUNCTIONS, SET_SIZE = INT_MAX };
// Global variables
object Workspace[WORKSPACESIZE] WORDALIGNED MEMBANK;
#if defined(CODESIZE)
RAMFUNC uint8_t MyCode[CODESIZE] WORDALIGNED;
#endif
jmp_buf exception;
unsigned int Freespace = 0;
object *Freelist;
unsigned int I2CCount;
unsigned int TraceFn[TRACEMAX];
unsigned int TraceDepth[TRACEMAX];
object *GlobalEnv;
object *GCStack = NULL;
object *GlobalString;
object *GlobalStringTail;
int GlobalStringIndex = 0;
uint8_t PrintCount = 0;
uint8_t BreakLevel = 0;
char LastChar = 0;
char LastPrint = 0;
// Flags
enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED, NOESC, NOECHO };
volatile uint8_t Flags = 0b00001; // PRINTREADABLY set by default
// Forward references
object *tee;
// Error handling
void errorsub (symbol_t fname, PGM_P string) {
pfl(pserial); pfstring(PSTR("Error: "), pserial);
if (fname != sym(NIL)) {
pserial('\'');
psymbol(fname, pserial);
pserial('\''); pserial(' ');
}
pfstring(string, pserial);
}
void errorsym (symbol_t fname, PGM_P string, object *symbol) {
errorsub(fname, string);
pserial(':'); pserial(' ');
printobject(symbol, pserial);
errorend();
}
void errorsym2 (symbol_t fname, PGM_P string) {
errorsub(fname, string);
errorend();
}
void error (builtin_t fname, PGM_P string, object *symbol) {
errorsym(sym(fname), string, symbol);
}
void error2 (builtin_t fname, PGM_P string) {
errorsym2(sym(fname), string);
}
void errorend () { pln(pserial); GCStack = NULL; longjmp(exception, 1); }
// Save space as these are used multiple times
const char notanumber[] PROGMEM = "argument is not a number";
const char notaninteger[] PROGMEM = "argument is not an integer";
const char notastring[] PROGMEM = "argument is not a string";
const char notalist[] PROGMEM = "argument is not a list";
const char notasymbol[] PROGMEM = "argument is not a symbol";
const char notproper[] PROGMEM = "argument is not a proper list";
const char toomanyargs[] PROGMEM = "too many arguments";
const char toofewargs[] PROGMEM = "too few arguments";
const char noargument[] PROGMEM = "missing argument";
const char nostream[] PROGMEM = "missing stream argument";
const char overflow[] PROGMEM = "arithmetic overflow";
const char divisionbyzero[] PROGMEM = "division by zero";
const char indexnegative[] PROGMEM = "index can't be negative";
const char invalidarg[] PROGMEM = "invalid argument";
const char invalidkey[] PROGMEM = "invalid keyword";
const char illegalclause[] PROGMEM = "illegal clause";
const char invalidpin[] PROGMEM = "invalid pin";
const char oddargs[] PROGMEM = "odd number of arguments";
const char indexrange[] PROGMEM = "index out of range";
const char canttakecar[] PROGMEM = "can't take car";
const char canttakecdr[] PROGMEM = "can't take cdr";
const char unknownstreamtype[] PROGMEM = "unknown stream type";
// Set up workspace
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++;
}
}
object *myalloc () {
if (Freespace == 0) error2(NIL, PSTR("no room"));
object *temp = Freelist;
Freelist = cdr(Freelist);
Freespace--;
return temp;
}
inline void myfree (object *obj) {
car(obj) = NULL;
cdr(obj) = Freelist;
Freelist = obj;
Freespace++;
}
// Make each type of object
object *number (int n) {
object *ptr = myalloc();
ptr->type = NUMBER;
ptr->integer = n;
return ptr;
}
object *makefloat (float f) {
object *ptr = myalloc();
ptr->type = FLOAT;
ptr->single_float = f;
return ptr;
}
object *character (uint8_t c) {
object *ptr = myalloc();
ptr->type = CHARACTER;
ptr->chars = c;
return ptr;
}
object *cons (object *arg1, object *arg2) {
object *ptr = myalloc();
ptr->car = arg1;
ptr->cdr = arg2;
return ptr;
}
object *symbol (symbol_t name) {
object *ptr = myalloc();
ptr->type = SYMBOL;
ptr->name = name;
return ptr;
}
inline object *bsymbol (builtin_t name) {
return intern(twist(name+BUILTINS));
}
object *codehead (int entry) {
object *ptr = myalloc();
ptr->type = CODE;
ptr->integer = entry;
return ptr;
}
object *intern (symbol_t name) {
for (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
if (obj->type == SYMBOL && obj->name == name) return obj;
}
return symbol(name);
}
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 ||
arg->chars != (buffer[i]<<24 | buffer[i+1]<<16 | buffer[i+2]<<8 | buffer[i+3])) return false;
arg = car(arg);
i = i + 4;
}
return true;
}
object *internlong (char *buffer) {
for (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
if (obj->type == SYMBOL && longsymbolp(obj) && eqsymbols(obj, buffer)) return obj;
}
object *obj = lispstring(buffer);
obj->type = SYMBOL;
return obj;
}
object *stream (uint8_t streamtype, uint8_t address) {
object *ptr = myalloc();
ptr->type = STREAM;
ptr->integer = streamtype<<8 | address;
return ptr;
}
object *newstring () {
object *ptr = myalloc();
ptr->type = STRING;
ptr->chars = 0;
return ptr;
}
// Garbage collection
void markobject (object *obj) {
MARK:
if (obj == NULL) return;
if (marked(obj)) return;
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 == 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;
}
}
}
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 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
void movepointer (object *from, object *to) {
for (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
unsigned int type = (obj->type) & ~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 (int i=0; i<WORKSPACESIZE; i++) {
object *obj = &Workspace[i];
if (marked(obj)) {
unsigned int type = (obj->type) & ~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);
}
}
}
}
}
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<max);
buffer[i] = '\0';
return buffer;
}
// Save-image and load-image
#if defined(sdcardsupport)
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;
}
#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(SAVEIMAGE, PSTR("not enough room"));
}
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
#define READSTATUS 0x05
#define READDATA 0x03
#define WRITEENABLE 0x06
#define BLOCK64K 0xD8
#define READID 0x90
// Arduino pins used for dataflash
#if defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_SAMD_FEATHER_M0_EXPRESS)
const int sck = 38, ssel = 39, mosi = 37, miso = 36;
#elif defined(EXTERNAL_FLASH_USE_QSPI)
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);
}
inline void FlashWrite (uint8_t data) {
shiftOut(mosi, sck, MSBFIRST, data);
}
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 FlashWriteEnable () {
digitalWrite(ssel, 0);
FlashWrite(WRITEENABLE);
digitalWrite(ssel, 1);
}
bool FlashCheck () {
uint8_t manID, 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++) manID = FlashReadByte();
devID = FlashReadByte();
digitalWrite(ssel, HIGH);
return (devID == 0x14 || devID == 0x15 || devID == 0x16); // true = found correct device
}
void FlashBeginWrite (uint32_t *addr, uint32_t bytes) {
*addr = 0;
uint32_t blocks = (bytes+65535)/65536;
// Erase 64K
for (int b=0; b<blocks; b++) {
FlashWriteEnable();
digitalWrite(ssel, 0);
FlashWrite(BLOCK64K);
FlashWrite(b); FlashWrite(0); FlashWrite(0);
digitalWrite(ssel, 1);
FlashBusy();
}
}
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();
}
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;
}
inline void FlashEndRead(uint32_t *addr) {
(void) addr;
digitalWrite(ssel, 1);
}
#elif defined(EEPROMFLASH)
// 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 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);
}
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 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 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;
}
void FlashEndRead (uint32_t *addr) {
(void) addr;
}
#endif
int saveimage (object *arg) {
#if defined(sdcardsupport)
unsigned int imagesize = compactimage(&arg);
SD.begin(SDCARD_SS_PIN);
File file;
if (stringp(arg)) {
char buffer[BUFFERSIZE];
file = SD.open(MakeFilename(arg, buffer), O_RDWR | O_CREAT | O_TRUNC);
if (!file) error2(SAVEIMAGE, PSTR("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(SAVEIMAGE, PSTR("problem saving to SD card"));
}
else error(SAVEIMAGE, 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<CODESIZE; i++) file.write(MyCode[i]);
for (unsigned int i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
SDWrite32(file, (uintptr_t)car(obj));
SDWrite32(file, (uintptr_t)cdr(obj));
}
file.close();
return imagesize;
#elif defined(LITTLEFS)
unsigned int imagesize = compactimage(&arg);
LittleFS.begin(LITTLEFS);
File file;
if (stringp(arg)) {
char buffer[BUFFERSIZE];
file = LittleFS.open(MakeFilename(arg, buffer), FILE_WRITE_BEGIN);
if (!file) error2(SAVEIMAGE, PSTR("problem saving to LittleFS or invalid filename"));
arg = NULL;
} else if (arg == NULL || listp(arg)) {
file = LittleFS.open("/ULISP.IMG", FILE_WRITE_BEGIN);
if (!file) error2(SAVEIMAGE, PSTR("problem saving to LittleFS"));
} else error(SAVEIMAGE, invalidarg, arg);
FSWrite32(file, (uintptr_t)arg);
FSWrite32(file, imagesize);
FSWrite32(file, (uintptr_t)GlobalEnv);
FSWrite32(file, (uintptr_t)GCStack);
if (file.write(MyCode, CODESIZE) != CODESIZE) error2(SAVEIMAGE, PSTR("not enough room"));
for (unsigned int i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
FSWrite32(file, (uintptr_t)car(obj));
FSWrite32(file, (uintptr_t)cdr(obj));
}
file.close();
return imagesize;
#elif defined(DATAFLASH) || defined(EEPROMFLASH)
unsigned int imagesize = compactimage(&arg);
if (!(arg == NULL || listp(arg))) error(SAVEIMAGE, invalidarg, arg);
if (!FlashCheck()) error2(SAVEIMAGE, PSTR("flash not available"));
// Save to flash
uint32_t bytesneeded = 16 + CODESIZE + imagesize*8;
if (bytesneeded > FLASHSIZE) error(SAVEIMAGE, PSTR("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<CODESIZE; i=i+4) {
union { uint32_t u32; uint8_t u8[4]; };
u8[0] = MyCode[i]; u8[1] = MyCode[i+1]; u8[2] = MyCode[i+2]; u8[3] = MyCode[i+3];
FlashWrite32(&addr, u32);
}
for (unsigned int i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
FlashWrite32(&addr, (uintptr_t)car(obj));
FlashWrite32(&addr, (uintptr_t)cdr(obj));
}
FlashEndWrite(&addr);
return imagesize;
#else
(void) arg;
error2(SAVEIMAGE, PSTR("not available"));
return 0;
#endif
}
int loadimage (object *arg) {
#if defined(sdcardsupport)
SD.begin(SDCARD_SS_PIN);
File file;
if (stringp(arg)) {
char buffer[BUFFERSIZE];
file = SD.open(MakeFilename(arg, buffer));
if (!file) error2(LOADIMAGE, PSTR("problem loading from SD card or invalid filename"));
}
else if (arg == NULL) {
file = SD.open("/ULISP.IMG");
if (!file) error2(LOADIMAGE, PSTR("problem loading from SD card"));
}
else error(LOADIMAGE, invalidarg, arg);
SDRead32(file);
unsigned int imagesize = SDRead32(file);
GlobalEnv = (object *)SDRead32(file);
GCStack = (object *)SDRead32(file);
for (int i=0; i<CODESIZE; i++) MyCode[i] = file.read();
for (unsigned int i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
car(obj) = (object *)SDRead32(file);
cdr(obj) = (object *)SDRead32(file);
}
file.close();
gc(NULL, NULL);
return imagesize;
#elif defined(LITTLEFS)
LittleFS.begin(LITTLEFS);
File file;
if (stringp(arg)) {
char buffer[BUFFERSIZE];
file = LittleFS.open(MakeFilename(arg, buffer), FILE_READ);
if (!file) error2(LOADIMAGE, PSTR("problem loading from LittleFS or invalid filename"));
}
else if (arg == NULL) {
file = LittleFS.open("/ULISP.IMG", FILE_READ);
if (!file) error2(LOADIMAGE, PSTR("problem loading from LittleFS"));
}
else error(LOADIMAGE, invalidarg, arg);
FSRead32(file);
unsigned int imagesize = FSRead32(file);
GlobalEnv = (object *)FSRead32(file);
GCStack = (object *)FSRead32(file);
file.read(MyCode, CODESIZE);
for (unsigned int i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
car(obj) = (object *)FSRead32(file);
cdr(obj) = (object *)FSRead32(file);
}
file.close();
gc(NULL, NULL);
return imagesize;
#elif defined(DATAFLASH) || defined(EEPROMFLASH) || defined(EEPROMLIBRARY)
if (!FlashCheck()) error2(LOADIMAGE, PSTR("flash not available"));
uint32_t addr;
FlashBeginRead(&addr);
FlashRead32(&addr); // Skip eval address
uint32_t imagesize = FlashRead32(&addr);
if (imagesize == 0 || imagesize == 0xFFFFFFFF) error2(LOADIMAGE, PSTR("no saved image"));
GlobalEnv = (object *)FlashRead32(&addr);
GCStack = (object *)FlashRead32(&addr);
for (int i=0; i<CODESIZE; i=i+4) {
union { uint32_t u32; uint8_t u8[4]; };
u32 = FlashRead32(&addr);
MyCode[i] = u8[0]; MyCode[i+1] = u8[1]; MyCode[i+2] = u8[2]; MyCode[i+3] = u8[3];
}
for (uint32_t i=0; i<imagesize; i++) {
object *obj = &Workspace[i];
car(obj) = (object *)FlashRead32(&addr);
cdr(obj) = (object *)FlashRead32(&addr);
}
FlashEndRead(&addr);
gc(NULL, NULL);
return imagesize;
#else
(void) arg;
error2(LOADIMAGE, PSTR("not available"));
return 0;
#endif
}
void autorunimage () {
#if defined(sdcardsupport)
SD.begin(SDCARD_SS_PIN);
File file = SD.open("/ULISP.IMG");
if (!file) error2(NIL, PSTR("problem autorunning from SD card"));
object *autorun = (object *)SDRead32(file);
file.close();
if (autorun != NULL) {
loadimage(NULL);
apply(NIL, autorun, NULL, NULL);
}
#elif defined(LITTLEFS)
LittleFS.begin(LITTLEFS);
File file = LittleFS.open("/ULISP.IMG", FILE_READ);
if (!file) error2(NIL, PSTR("problem autorunning from LittleFS"));
object *autorun = (object *)FSRead32(file);
file.close();
if (autorun != NULL) {
loadimage(NULL);
apply(NIL, autorun, NULL, NULL);
}
#elif defined(DATAFLASH) || defined(EEPROMFLASH) || defined(EEPROMLIBRARY)
if (!FlashCheck()) error2(NIL, PSTR("flash not available"));
uint32_t addr;
FlashBeginRead(&addr);
object *autorun = (object *)FlashRead32(&addr);
FlashEndRead(&addr);
if (autorun != NULL && (unsigned int)autorun != 0xFFFFFFFF) {
loadimage(nil);
apply(NIL, autorun, NULL, NULL);
}
#else
error2(NIL, PSTR("autorun not available"));
#endif
}
// Tracing
int tracing (symbol_t name) {
int i = 0;
while (i < TRACEMAX) {
if (TraceFn[i] == name) return i+1;
i++;
}
return 0;
}
void trace (symbol_t name) {
if (tracing(name)) error(TRACE, PSTR("already being traced"), symbol(name));
int i = 0;
while (i < TRACEMAX) {
if (TraceFn[i] == 0) { TraceFn[i] = name; TraceDepth[i] = 0; return; }
i++;
}
error2(TRACE, PSTR("already tracing 3 functions"));
}
void untrace (symbol_t name) {
int i = 0;
while (i < TRACEMAX) {
if (TraceFn[i] == name) { TraceFn[i] = 0; return; }
i++;
}
error(UNTRACE, PSTR("not tracing"), symbol(name));
}
// Helper functions
bool consp (object *x) {
if (x == NULL) return false;
unsigned int type = x->type;
return type >= PAIR || type == ZZERO;
}
#define atom(x) (!consp(x))
bool listp (object *x) {
if (x == NULL) return true;
unsigned int type = x->type;
return type >= PAIR || type == ZZERO;
}
#define improperp(x) (!listp(x))
object *quote (object *arg) {
return cons(bsymbol(QUOTE), cons(arg,NULL));
}
// Radix 40 encoding
builtin_t builtin (symbol_t name) {
return (builtin_t)(untwist(name) - BUILTINS);
}
symbol_t sym (builtin_t x) {
return twist(x + BUILTINS);
}
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
}
char fromradix40 (char n) {
if (n >= 1 && n <= 9) 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;
}
uint32_t pack40 (char *buffer) {
int x = 0;
for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]);
return x;
}
bool valid40 (char *buffer) {
if (toradix40(buffer[0]) < 11) return false;
for (int i=1; i<6; i++) if (toradix40(buffer[i]) < 0) return false;
return true;
}
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;
}
int checkinteger (builtin_t name, object *obj) {
if (!integerp(obj)) error(name, notaninteger, obj);
return obj->integer;
}
int checkbitvalue (builtin_t name, object *obj) {
if (!integerp(obj)) error(name, notaninteger, obj);
int n = obj->integer;
if (n & ~1) error(name, PSTR("argument is not a bit value"), obj);
return n;
}
float checkintfloat (builtin_t name, object *obj){
if (integerp(obj)) return obj->integer;
if (!floatp(obj)) error(name, notanumber, obj);
return obj->single_float;
}
int checkchar (builtin_t name, object *obj) {
if (!characterp(obj)) error(name, PSTR("argument is not a character"), obj);
return obj->chars;
}
object *checkstring (builtin_t name, object *obj) {
if (!stringp(obj)) error(name, notastring, obj);
return obj;
}
int isstream (object *obj){
if (!streamp(obj)) error(NIL, PSTR("not a stream"), obj);
return obj->integer;
}
int isbuiltin (object *obj, builtin_t n) {
return symbolp(obj) && obj->name == sym(n);
}
bool builtinp (symbol_t name) {
return (untwist(name) > BUILTINS && untwist(name) < ENDFUNCTIONS+BUILTINS);
}
int keywordp (object *obj) {
if (!symbolp(obj)) return false;
builtin_t name = builtin(obj->name);
return ((name > KEYWORDS) && (name < USERFUNCTIONS));
}
int checkkeyword (builtin_t name, object *obj) {
if (!keywordp(obj)) error(name, PSTR("argument is not a keyword"), obj);
builtin_t kname = builtin(obj->name);
uint8_t context = getminmax(kname);
if (context != 0 && context != name) error(name, invalidkey, obj);
return ((int)lookupfn(kname));
}
void checkargs (builtin_t name, object *args) {
int nargs = listlength(name, args);
checkminmax(name, nargs);
}
int eq (object *arg1, object *arg2) {
if (arg1 == arg2) return true; // Same object
if ((arg1 == nil) || (arg2 == nil)) return false; // Not both values
if (arg1->cdr != arg2->cdr) return false; // Different values
if (symbolp(arg1) && symbolp(arg2)) return true; // Same symbol
if (integerp(arg1) && integerp(arg2)) return true; // Same integer
if (floatp(arg1) && floatp(arg2)) return true; // Same float
if (characterp(arg1) && characterp(arg2)) return true; // Same character
return false;
}
int listlength (builtin_t name, object *list) {
int length = 0;
while (list != NULL) {
if (improperp(list)) error2(name, notproper);
list = cdr(list);
length++;
}
return length;
}
// Association lists
object *assoc (object *key, object *list) {
while (list != NULL) {
if (improperp(list)) error(ASSOC, notproper, list);
object *pair = first(list);
if (!listp(pair)) error(ASSOC, PSTR("element is not a list"), pair);
if (pair != NULL && eq(key,car(pair))) return pair;
list = cdr(list);
}
return nil;
}
object *delassoc (object *key, object **alist) {
object *list = *alist;
object *prev = NULL;
while (list != NULL) {
object *pair = first(list);
if (eq(key,car(pair))) {
if (prev == NULL) *alist = cdr(list);
else cdr(prev) = cdr(list);
return key;
}
prev = list;
list = cdr(list);
}
return nil;
}
// Array utilities
int nextpower2 (int n) {
n--; n |= n >> 1; n |= n >> 2; n |= n >> 4;
n |= n >> 8; n |= n >> 16; n++;
return n<2 ? 2 : n;
}
object *buildarray (int n, int s, object *def) {
int s2 = s>>1;
if (s2 == 1) {
if (n == 2) return cons(def, def);
else if (n == 1) return cons(def, NULL);
else return NULL;
} else if (n >= s2) return cons(buildarray(s2, s2, def), buildarray(n - s2, s2, def));
else return cons(buildarray(n, s2, def), nil);
}
object *makearray (builtin_t name, object *dims, object *def, bool bitp) {
int size = 1;
object *dimensions = dims;
while (dims != NULL) {
int d = car(dims)->integer;
if (d < 0) error2(name, PSTR("dimension can't be negative"));
size = size * d;
dims = cdr(dims);
}
// Bit array identified by making first dimension negative
if (bitp) { size = (size + 31)/32; car(dimensions) = number(-(car(dimensions)->integer)); }
object *ptr = myalloc();
ptr->type = ARRAY;
object *tree = nil;
if (size != 0) tree = buildarray(size, nextpower2(size), def);
ptr->cdr = cons(tree, dimensions);
return ptr;
}
object **arrayref (object *array, int index, int size) {
int mask = nextpower2(size)>>1;
object **p = &car(cdr(array));
while (mask) {
if ((index & mask) == 0) p = &(car(*p)); else p = &(cdr(*p));
mask = mask>>1;
}
return p;
}
object **getarray (builtin_t name, object *array, object *subs, object *env, int *bit) {
int index = 0, size = 1, s;
*bit = -1;
bool bitp = false;
object *dims = cddr(array);
while (dims != NULL && subs != NULL) {
int d = car(dims)->integer;
if (d < 0) { d = -d; bitp = true; }
if (env) s = checkinteger(name, eval(car(subs), env)); else s = checkinteger(name, car(subs));
if (s < 0 || s >= d) error(name, PSTR("subscript out of range"), car(subs));
size = size * d;
index = index * d + s;
dims = cdr(dims); subs = cdr(subs);
}
if (dims != NULL) error2(name, PSTR("too few subscripts"));
if (subs != NULL) error2(name, PSTR("too many subscripts"));
if (bitp) {
size = (size + 31)/32;
*bit = index & 0x1F; index = index>>5;
}
return arrayref(array, index, size);
}
void rslice (object *array, int size, int slice, object *dims, object *args) {
int d = first(dims)->integer;
for (int i = 0; i < d; i++) {
int index = slice * d + i;
if (!consp(args)) error2(NIL, PSTR("initial contents don't match array type"));
if (cdr(dims) == NULL) {
object **p = arrayref(array, index, size);
*p = car(args);
} else rslice(array, size, index, cdr(dims), car(args));
args = cdr(args);
}
}
object *readarray (int d, object *args) {
object *list = args;
object *dims = NULL; object *head = NULL;
int size = 1;
for (int i = 0; i < d; i++) {
if (!listp(list)) error2(NIL, PSTR("initial contents don't match array type"));
int l = listlength(NIL, list);
if (dims == NULL) { dims = cons(number(l), NULL); head = dims; }
else { cdr(dims) = cons(number(l), NULL); dims = cdr(dims); }
size = size * l;
if (list != NULL) list = car(list);
}
object *array = makearray(NIL, head, NULL, false);
rslice(array, size, 0, head, args);
return array;
}
object *readbitarray (gfun_t gfun) {
char ch = gfun();
object *head = NULL;
object *tail = NULL;
while (!issp(ch) && ch != ')' && ch != '(') {
if (ch != '0' && ch != '1') error2(NIL, PSTR("illegal character in bit array"));
object *cell = cons(number(ch - '0'), NULL);
if (head == NULL) head = cell;
else tail->cdr = cell;
tail = cell;
ch = gfun();
}
LastChar = ch;
int size = listlength(NIL, head);
object *array = makearray(NIL, cons(number(size), NULL), 0, true);
size = (size + 31) / 32;
int index = 0;
while (head != NULL) {
object **loc = arrayref(array, index>>5, size);
int bit = index & 0x1F;
*loc = number((((*loc)->integer) & ~(1<<bit)) | (car(head)->integer)<<bit);
index++;
head = cdr(head);
}
return array;
}
void pslice (object *array, int size, int slice, object *dims, pfun_t pfun, bool bitp) {
bool spaces = true;
if (slice == -1) { spaces = false; slice = 0; }
int d = first(dims)->integer;
if (d < 0) d = -d;
for (int i = 0; i < d; i++) {
if (i && spaces) pfun(' ');
int index = slice * d + i;
if (cdr(dims) == NULL) {
if (bitp) pint(((*arrayref(array, index>>5, size))->integer)>>(index & 0x1f) & 1, pfun);
else printobject(*arrayref(array, index, size), pfun);
} else { pfun('('); pslice(array, size, index, cdr(dims), pfun, bitp); pfun(')'); }
}
}
void printarray (object *array, pfun_t pfun) {
object *dimensions = cddr(array);
object *dims = dimensions;
bool bitp = false;
int size = 1, n = 0;
while (dims != NULL) {
int d = car(dims)->integer;
if (d < 0) { bitp = true; d = -d; }
size = size * d;
dims = cdr(dims); n++;
}
if (bitp) size = (size+31)/32;
pfun('#');
if (n == 1 && bitp) { pfun('*'); pslice(array, size, -1, dimensions, pfun, bitp); }
else {
if (n > 1) { pint(n, pfun); pfun('A'); }
pfun('('); pslice(array, size, 0, dimensions, pfun, bitp); pfun(')');
}
}
// String utilities
void indent (uint8_t spaces, char ch, pfun_t pfun) {
for (uint8_t i=0; i<spaces; i++) pfun(ch);
}
object *startstring (builtin_t name) {
(void) name;
object *string = newstring();
GlobalString = string;
GlobalStringTail = string;
return string;
}
void buildstring (char ch, object **tail) {
object *cell;
if (cdr(*tail) == NULL) {
cell = myalloc(); cdr(*tail) = cell;
} else if (((*tail)->chars & 0xFFFFFF) == 0) {
(*tail)->chars = (*tail)->chars | ch<<16; return;
} else if (((*tail)->chars & 0xFFFF) == 0) {
(*tail)->chars = (*tail)->chars | ch<<8; return;
} else if (((*tail)->chars & 0xFF) == 0) {
(*tail)->chars = (*tail)->chars | ch; return;
} else {
cell = myalloc(); car(*tail) = cell;
}
car(cell) = NULL; cell->chars = ch<<24; *tail = cell;
}
object *copystring (object *arg) {
object *obj = newstring();
object *ptr = obj;
arg = cdr(arg);
while (arg != NULL) {
object *cell = myalloc(); car(cell) = NULL;
if (cdr(obj) == NULL) cdr(obj) = cell; else car(ptr) = cell;
ptr = cell;
ptr->chars = arg->chars;
arg = car(arg);
}
return obj;
}
object *readstring (uint8_t delim, gfun_t gfun) {
object *obj = newstring();
object *tail = obj;
int ch = gfun();
if (ch == -1) return nil;
while ((ch != delim) && (ch != -1)) {
if (ch == '\\') ch = gfun();
buildstring(ch, &tail);
ch = gfun();
}
return obj;
}
int stringlength (object *form) {
int length = 0;
form = cdr(form);
while (form != NULL) {
int chars = form->chars;
for (int i=(sizeof(int)-1)*8; i>=0; i=i-8) {
if (chars>>i & 0xFF) length++;
}
form = car(form);
}
return length;
}
uint8_t nthchar (object *string, int n) {
object *arg = cdr(string);
int top;
if (sizeof(int) == 4) { top = n>>2; n = 3 - (n&3); }
else { top = n>>1; n = 1 - (n&1); }
for (int i=0; i<top; i++) {
if (arg == NULL) return 0;
arg = car(arg);
}
if (arg == NULL) return 0;
return (arg->chars)>>(n*8) & 0xFF;
}
int gstr () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
char c = nthchar(GlobalString, GlobalStringIndex++);
if (c != 0) return c;
return '\n'; // -1?
}
void pstr (char c) {
buildstring(c, &GlobalStringTail);
}
object *lispstring (char *s) {
object *obj = newstring();
object *tail = obj;
while(1) {
char ch = *s++;
if (ch == 0) break;
if (ch == '\\') ch = *s++;
buildstring(ch, &tail);
}
return obj;
}
// Lookup variable in environment
object *value (symbol_t n, object *env) {
while (env != NULL) {
object *pair = car(env);
if (pair != NULL && car(pair)->name == n) return pair;
env = cdr(env);
}
return nil;
}
bool boundp (object *var, object *env) {
symbol_t varname = var->name;
if (value(varname, env) != NULL) return true;
if (value(varname, GlobalEnv) != NULL) return true;
return false;
}
object *findvalue (object *var, object *env) {
symbol_t varname = var->name;
object *pair = value(varname, env);
if (pair == NULL) pair = value(varname, GlobalEnv);
if (pair == NULL) error(NIL, PSTR("unknown variable"), var);
return pair;
}
// Handling closures
object *closure (int tc, symbol_t name, object *function, object *args, object **env) {
object *state = car(function);
function = cdr(function);
int trace = 0;
if (name) trace = tracing(name);
if (trace) {
indent(TraceDepth[trace-1]<<1, ' ', pserial);
pint(TraceDepth[trace-1]++, pserial);
pserial(':'); pserial(' '); pserial('('); printsymbol(symbol(name), pserial);
}
object *params = first(function);
if (!listp(params)) errorsym(name, notalist, params);
function = cdr(function);
// Dropframe
if (tc) {
if (*env != NULL && car(*env) == NULL) {
pop(*env);
while (*env != NULL && car(*env) != NULL) pop(*env);
} else push(nil, *env);
}
// Push state
while (consp(state)) {
object *pair = first(state);
push(pair, *env);
state = cdr(state);
}
// Add arguments to environment
bool optional = false;
while (params != NULL) {
object *value;
object *var = first(params);
if (isbuiltin(var, OPTIONAL)) optional = true;
else {
if (consp(var)) {
if (!optional) errorsym(name, PSTR("invalid default value"), var);
if (args == NULL) value = eval(second(var), *env);
else { value = first(args); args = cdr(args); }
var = first(var);
if (!symbolp(var)) errorsym(name, PSTR("illegal optional parameter"), var);
} else if (!symbolp(var)) {
errorsym(name, PSTR("illegal function parameter"), var);
} else if (isbuiltin(var, AMPREST)) {
params = cdr(params);
var = first(params);
value = args;
args = NULL;
} else {
if (args == NULL) {
if (optional) value = nil;
else errorsym2(name, toofewargs);
} else { value = first(args); args = cdr(args); }
}
push(cons(var,value), *env);
if (trace) { pserial(' '); printobject(value, pserial); }
}
params = cdr(params);
}
if (args != NULL) errorsym2(name, toomanyargs);
if (trace) { pserial(')'); pln(pserial); }
// Do an implicit progn
if (tc) push(nil, *env);
return tf_progn(function, *env);
}
object *apply (builtin_t name, object *function, object *args, object *env) {
if (symbolp(function)) {
builtin_t fname = builtin(function->name);
if ((fname > FUNCTIONS) && (fname < KEYWORDS)) {
checkargs(fname, args);
return ((fn_ptr_type)lookupfn(fname))(args, env);
} else function = eval(function, env);
}
if (consp(function) && isbuiltin(car(function), LAMBDA)) {
object *result = closure(0, sym(name), function, args, &env);
return eval(result, env);
}
if (consp(function) && isbuiltin(car(function), CLOSURE)) {
function = cdr(function);
object *result = closure(0, sym(name), function, args, &env);
return eval(result, env);
}
error(name, PSTR("illegal function"), function);
return NULL;
}
// In-place operations
object **place (builtin_t name, object *args, object *env, int *bit) {
*bit = -1;
if (atom(args)) return &cdr(findvalue(args, env));
object* function = first(args);
if (symbolp(function)) {
symbol_t sname = function->name;
if (sname == sym(CAR) || sname == sym(FIRST)) {
object *value = eval(second(args), env);
if (!listp(value)) error(name, canttakecar, value);
return &car(value);
}
if (sname == sym(CDR) || sname == sym(REST)) {
object *value = eval(second(args), env);
if (!listp(value)) error(name, canttakecdr, value);
return &cdr(value);
}
if (sname == sym(NTH)) {
int index = checkinteger(NTH, eval(second(args), env));
object *list = eval(third(args), env);
if (atom(list)) error(name, PSTR("second argument to nth is not a list"), list);
while (index > 0) {
list = cdr(list);
if (list == NULL) error2(name, PSTR("index to nth is out of range"));
index--;
}
return &car(list);
}
if (sname == sym(AREFF)) {
object *array = eval(second(args), env);
if (!arrayp(array)) error(AREFF, PSTR("first argument is not an array"), array);
return getarray(AREFF, array, cddr(args), env, bit);
}
}
error2(name, PSTR("illegal place"));
return nil;
}
// Checked car and cdr
object *carx (object *arg) {
if (!listp(arg)) error(NIL, canttakecar, arg);
if (arg == nil) return nil;
return car(arg);
}
object *cdrx (object *arg) {
if (!listp(arg)) error(NIL, canttakecdr, arg);
if (arg == nil) return nil;
return cdr(arg);
}
// I2C interface for up to two ports
void I2Cinit (TwoWire *port, bool enablePullup) {
(void) enablePullup;
port->begin();
}
int I2Cread (TwoWire *port) {
return port->read();
}
void I2Cwrite (TwoWire *port, uint8_t data) {
port->write(data);
}
bool I2Cstart (TwoWire *port, uint8_t address, uint8_t read) {
int ok = true;
if (read == 0) {
port->beginTransmission(address);
ok = (port->endTransmission(true) == 0);
port->beginTransmission(address);
}
else port->requestFrom(address, I2CCount);
return ok;
}
bool I2Crestart (TwoWire *port, uint8_t address, uint8_t read) {
int error = (port->endTransmission(false) != 0);
if (read == 0) port->beginTransmission(address);
else port->requestFrom(address, I2CCount);
return error ? false : true;
}
void I2Cstop (TwoWire *port, uint8_t read) {
if (read == 0) port->endTransmission(); // Check for error?
}
// Streams
// Simplify board differences
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) || defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(ARDUINO_RASPBERRY_PI_PICO)
#define ULISP_SPI1
#endif
#if defined(ARDUINO_BBC_MICROBIT_V2) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040)
#define ULISP_I2C1
#endif
#if defined(ARDUINO_SAM_DUE) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define ULISP_SERIAL3
#elif defined(ARDUINO_RASPBERRY_PI_PICO)
#define ULISP_SERIAL2
#elif !defined(CPU_NRF51822) && !defined(CPU_NRF52833) && !defined(ARDUINO_FEATHER_F405) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040)
#define ULISP_SERIAL1
#endif
inline int spiread () { return SPI.transfer(0); }
#if defined(ULISP_SPI1)
inline int spi1read () { return SPI1.transfer(0); }
#endif
inline int i2cread () { return I2Cread(&Wire); }
#if defined(ULISP_I2C1)
inline int i2c1read () { return I2Cread(&Wire1); }
#endif
#if defined(ULISP_SERIAL3)
inline int serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); }
#endif
#if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2)
inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); }
#endif
#if defined(ULISP_SERIAL3) || defined(ULISP_SERIAL2) || defined(ULISP_SERIAL1)
inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
#endif
#if defined(sdcardsupport)
File SDpfile, SDgfile;
inline int SDread () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
return SDgfile.read();
}
#endif
void serialbegin (int address, int baud) {
#if defined(ULISP_SERIAL3)
if (address == 1) Serial1.begin((long)baud*100);
else if (address == 2) Serial2.begin((long)baud*100);
else if (address == 3) Serial3.begin((long)baud*100);
#elif defined(ULISP_SERIAL2)
if (address == 1) Serial1.begin((long)baud*100);
else if (address == 2) Serial2.begin((long)baud*100);
#elif defined(ULISP_SERIAL1)
if (address == 1) Serial1.begin((long)baud*100);
#else
(void) baud;
if (false);
#endif
else error(WITHSERIAL, PSTR("port not supported"), number(address));
}
void serialend (int address) {
#if defined(ULISP_SERIAL3)
if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) {Serial2.flush(); Serial2.end(); }
else if (address == 3) {Serial3.flush(); Serial3.end(); }
#elif defined(ULISP_SERIAL2)
if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) {Serial2.flush(); Serial2.end(); }
#elif defined(ULISP_SERIAL1)
if (address == 1) {Serial1.flush(); Serial1.end(); }
#else
(void) baud;
if (false);
#endif
else error(WITHSERIAL, PSTR("port not supported"), number(address));
}
gfun_t gstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
gfun_t gfun = gserial;
if (args != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) gfun = i2cread;
#if defined(ULISP_I2C1)
else gfun = i2c1read;
#endif
} else if (streamtype == SPISTREAM) {
if (address < 128) gfun = spiread;
#if defined(ULISP_SPI1)
else gfun = spi1read;
#endif
}
else if (streamtype == SERIALSTREAM) {
if (address == 0) gfun = gserial;
#if defined(ULISP_SERIAL3)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
else if (address == 3) gfun = serial3read;
#elif defined(ULISP_SERIAL2)
else if (address == 1) gfun = serial1read;
else if (address == 2) gfun = serial2read;
#elif defined(ULISP_SERIAL1)
else if (address == 1) gfun = serial1read;
#endif
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) gfun = (gfun_t)SDread;
#endif
else error2(NIL, PSTR("unknown stream type"));
return gfun;
}
inline void spiwrite (char c) { SPI.transfer(c); }
#if defined(ULISP_SPI1)
inline void spi1write (char c) { SPI1.transfer(c); }
#endif
inline void i2cwrite (char c) { I2Cwrite(&Wire, c); }
#if defined(ULISP_I2C1)
inline void i2c1write (char c) { I2Cwrite(&Wire1, c); }
#endif
#if defined(SERIAL3)
inline void serial1write (char c) { Serial1.write(c); }
inline void serial2write (char c) { Serial2.write(c); }
inline void serial3write (char c) { Serial3.write(c); }
#elif defined(SERIAL1)
inline void serial1write (char c) { Serial1.write(c); }
#endif
#if defined(sdcardsupport)
inline void SDwrite (char c) { SDpfile.write(c); }
#endif
#if defined(gfxsupport)
inline void gfxwrite (char c) { tft.write(c); if (c=='\n') tft.refresh(); }
#endif
pfun_t pstreamfun (object *args) {
int streamtype = SERIALSTREAM;
int address = 0;
pfun_t pfun = pserial;
if (args != NULL && first(args) != NULL) {
int stream = isstream(first(args));
streamtype = stream>>8; address = stream & 0xFF;
}
if (streamtype == I2CSTREAM) {
if (address < 128) pfun = i2cwrite;
#if defined(ULISP_I2C1)
else pfun = i2c1write;
#endif
} else if (streamtype == SPISTREAM) {
if (address < 128) pfun = spiwrite;
#if defined(ULISP_SPI1)
else pfun = spi1write;
#endif
} else if (streamtype == SERIALSTREAM) {
if (address == 0) pfun = pserial;
#if defined(SERIAL3)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
else if (address == 3) pfun = serial3write;
#elif defined(SERIAL2)
else if (address == 1) pfun = serial1write;
else if (address == 2) pfun = serial2write;
#elif defined(SERIAL1)
else if (address == 1) pfun = serial1write;
#endif
}
else if (streamtype == STRINGSTREAM) {
pfun = pstr;
}
#if defined(sdcardsupport)
else if (streamtype == SDSTREAM) pfun = (pfun_t)SDwrite;
#endif
#if defined(gfxsupport)
else if (streamtype == GFXSTREAM) pfun = (pfun_t)gfxwrite;
#endif
else error2(NIL, PSTR("unknown stream type"));
return pfun;
}
// Check pins - these are board-specific not processor-specific
void checkanalogread (int pin) {
#if defined(ARDUINO_SAM_DUE)
if (!(pin>=54 && pin<=65)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_ZERO)
if (!(pin>=14 && pin<=19)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_MKRZERO)
if (!(pin>=15 && pin<=21)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M0)
if (!(pin>=14 && pin<=25)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_GEMMA_M0)
if (!(pin>=8 && pin<=10)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_QTPY_M0)
if (!((pin>=0 && pin<=3) || (pin>=6 && pin<=10))) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_SEEED_XIAO_M0)
if (!(pin>=0 && pin<=10)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_METRO_M4)
if (!(pin>=14 && pin<=21)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M4)
if (!(pin>=14 && pin<=20)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_FEATHER_M4)
if (!(pin>=14 && pin<=20)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
if (!((pin>=67 && pin<=74) || (pin>=54 && pin<=61))) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT)
if (!((pin>=0 && pin<=4) || pin==10)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT_V2)
if (!((pin>=0 && pin<=4) || pin==10 || pin==29)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_CALLIOPE_MINI)
if (!(pin==1 || pin==2 || (pin>=4 && pin<=6) || pin==21)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_SINOBIT)
if (!((pin>=0 && pin<=4) || pin==10)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_ITSYBITSY)
if (!(pin>=14 && pin<=20)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CLUE)
if (!((pin>=0 && pin<=4) || pin==10 || pin==12 || pin==16)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(MAX32620)
if (!(pin>=49 && pin<=52)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY40)
if (!((pin>=14 && pin<=27))) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY41)
if (!((pin>=14 && pin<=27) || (pin>=38 && pin<=41))) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
if (!(pin>=26 && pin<=29)) error(ANALOGREAD, invalidpin, number(pin));
#endif
}
void checkanalogwrite (int pin) {
#if defined(ARDUINO_SAM_DUE)
if (!((pin>=2 && pin<=13) || pin==66 || pin==67)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_ZERO)
if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || pin==14)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_SAMD_MKRZERO)
if (!((pin>=0 && pin<=8) || pin==10 || pin==18 || pin==19)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M0)
if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || (pin>=15 && pin<=16) || (pin>=22 && pin<=25))) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_GEMMA_M0)
if (!(pin==0 || pin==2 || pin==9 || pin==10)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_QTPY_M0)
if (!(pin==0 || (pin>=2 && pin<=10))) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_SEEED_XIAO_M0)
if (!(pin>=0 && pin<=10)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_METRO_M4)
if (!(pin>=0 && pin<=15)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_ITSYBITSY_M4)
if (!(pin==0 || pin==1 || pin==4 || pin==5 || pin==7 || (pin>=9 && pin<=15) || pin==21 || pin==22)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_FEATHER_M4)
if (!(pin==0 || pin==1 || (pin>=4 && pin<=6) || (pin>=9 && pin<=13) || pin==14 || pin==15 || pin==17 || pin==21 || pin==22)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_GRAND_CENTRAL_M4)
if (!((pin>=2 && pin<=9) || pin==11 || (pin>=13 && pin<=45) || pin==48 || (pin>=50 && pin<=53) || pin==58 || pin==61 || pin==68 || pin==69)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT)
if (!(pin>=0 && pin<=32)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_BBC_MICROBIT_V2)
if (!(pin>=0 && pin<=32)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_CALLIOPE_MINI)
if (!(pin>=0 && pin<=30)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_SINOBIT)
if (!(pin>=0 && pin<=32)) error(ANALOGREAD, invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_ITSYBITSY)
if (!(pin>=0 && pin<=25)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_NRF52840_CLUE)
if (!(pin>=0 && pin<=46)) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(MAX32620)
if (!((pin>=20 && pin<=29) || pin==32 || (pin>=40 && pin<=48))) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY40)
if (!((pin>=0 && pin<=15) || (pin>=18 && pin<=19) || (pin>=22 && pin<=25) || (pin>=28 && pin<=29) || (pin>=33 && pin<=39))) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_TEENSY41)
if (!((pin>=0 && pin<=15) || (pin>=18 && pin<=19) || (pin>=22 && pin<=25) || (pin>=28 && pin<=29) || pin==33 || (pin>=36 && pin<=37))) error(ANALOGWRITE, invalidpin, number(pin));
#elif defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
if (!(pin>=0 && pin<=29)) error(ANALOGWRITE, invalidpin, number(pin));
#endif
}
// Note
const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902};
void playnote (int pin, int note, int octave) {
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
if (!(pin>=26 && pin<=29)) error(ANALOGREAD, invalidpin, number(pin));
int prescaler = 8 - octave - note/12;
if (prescaler<0 || prescaler>8) error(NOTE, PSTR("octave out of range"), number(prescaler));
tone(pin, scale[note%12]>>prescaler);
#endif
}
void nonote (int pin) {
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
noTone(pin);
#endif
}
// Sleep
#if defined(CPU_ATSAMD21)
void WDT_Handler(void) {
// ISR for watchdog early warning
WDT->CTRL.bit.ENABLE = 0; // Disable watchdog
while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write
WDT->INTFLAG.bit.EW = 1; // Clear interrupt flag
}
#endif
void initsleep () {
#if defined(CPU_ATSAMD21)
// One-time initialization of watchdog timer.
// Generic clock generator 2, divisor = 32 (2^(DIV+1))
GCLK->GENDIV.reg = GCLK_GENDIV_ID(2) | GCLK_GENDIV_DIV(4);
// Enable clock generator 2 using low-power 32KHz oscillator.
// With /32 divisor above, this yields 1024Hz clock.
GCLK->GENCTRL.reg = GCLK_GENCTRL_ID(2) |
GCLK_GENCTRL_GENEN |
GCLK_GENCTRL_SRC_OSCULP32K |
GCLK_GENCTRL_DIVSEL;
while(GCLK->STATUS.bit.SYNCBUSY);
// WDT clock = clock gen 2
GCLK->CLKCTRL.reg = GCLK_CLKCTRL_ID_WDT |
GCLK_CLKCTRL_CLKEN |
GCLK_CLKCTRL_GEN_GCLK2;
// Enable WDT early-warning interrupt
NVIC_DisableIRQ(WDT_IRQn);
NVIC_ClearPendingIRQ(WDT_IRQn);
NVIC_SetPriority(WDT_IRQn, 0); // Top priority
NVIC_EnableIRQ(WDT_IRQn);
#endif
}
void sleep (int secs) {
#if defined(CPU_ATSAMD21)
WDT->CTRL.reg = 0; // Disable watchdog for config
while(WDT->STATUS.bit.SYNCBUSY);
WDT->INTENSET.bit.EW = 1; // Enable early warning interrupt
WDT->CONFIG.bit.PER = 0xB; // Period = max
WDT->CONFIG.bit.WINDOW = 0x7; // Set time of interrupt = 1024 cycles = 1 sec
WDT->CTRL.bit.WEN = 1; // Enable window mode
while(WDT->STATUS.bit.SYNCBUSY); // Sync CTRL write
SysTick->CTRL = 0; // Stop SysTick interrupts
while (secs > 0) {
WDT->CLEAR.reg = WDT_CLEAR_CLEAR_KEY;// Clear watchdog interval
while(WDT->STATUS.bit.SYNCBUSY);
WDT->CTRL.bit.ENABLE = 1; // Start watchdog now!
while(WDT->STATUS.bit.SYNCBUSY);
SCB->SCR |= SCB_SCR_SLEEPDEEP_Msk; // Deepest sleep
__DSB();
__WFI(); // Wait for interrupt
secs--;
}
SysTick->CTRL = 7; // Restart SysTick interrupts
#else
delay(1000*secs);
#endif
}
// Prettyprint
const int PPINDENT = 2;
const int PPWIDTH = 80;
const int GFXPPWIDTH = 52; // 320 pixel wide screen
int ppwidth = PPWIDTH;
void pcount (char c) {
if (c == '\n') PrintCount++;
PrintCount++;
}
uint8_t atomwidth (object *obj) {
PrintCount = 0;
printobject(obj, pcount);
return PrintCount;
}
uint8_t basewidth (object *obj, uint8_t base) {
PrintCount = 0;
pintbase(obj->integer, base, pcount);
return PrintCount;
}
bool quoted (object *obj) {
return (consp(obj) && car(obj) != NULL && car(obj)->name == sym(QUOTE) && consp(cdr(obj)) && cddr(obj) == NULL);
}
int subwidth (object *obj, int w) {
if (atom(obj)) return w - atomwidth(obj);
if (quoted(obj)) obj = car(cdr(obj));
return subwidthlist(obj, w - 1);
}
int subwidthlist (object *form, int w) {
while (form != NULL && w >= 0) {
if (atom(form)) return w - (2 + atomwidth(form));
w = subwidth(car(form), w - 1);
form = cdr(form);
}
return w;
}
void superprint (object *form, int lm, pfun_t pfun) {
if (atom(form)) {
if (symbolp(form) && form->name == sym(NOTHING)) printsymbol(form, pfun);
else printobject(form, pfun);
}
else if (quoted(form)) { pfun('\''); superprint(car(cdr(form)), lm + 1, pfun); }
else if (subwidth(form, ppwidth - lm) >= 0) supersub(form, lm + PPINDENT, 0, pfun);
else supersub(form, lm + PPINDENT, 1, pfun);
}
const int ppspecials = 19;
const char ppspecial[ppspecials] PROGMEM =
{ DOTIMES, DOLIST, IF, SETQ, TEE, LET, LETSTAR, LAMBDA, WHEN, UNLESS, WITHI2C, WITHSERIAL, WITHSPI, WITHSDCARD,
WITHGFX, WITHOUTPUTTOSTRING, FORMILLIS, DEFVAR, CASE };
void supersub (object *form, int lm, int super, pfun_t pfun) {
int special = 0, separate = 1;
object *arg = car(form);
if (symbolp(arg)) {
symbol_t sname = arg->name;
if (sname == sym(DEFUN) || sname == sym(DEFCODE)) special = 2;
else for (int i=0; i<ppspecials; i++) {
if (sname == sym((builtin_t)ppspecial[i])) { special = 1; break; }
}
}
while (form != NULL) {
if (atom(form)) { pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; }
else if (separate) { pfun('('); separate = 0; }
else if (special) { pfun(' '); special--; }
else if (!super) pfun(' ');
else { pln(pfun); indent(lm, ' ', pfun); }
superprint(car(form), lm, pfun);
form = cdr(form);
}
pfun(')'); return;
}
// Assembler
object *call (int entry, int nargs, object *args, object *env) {
#if defined(CODESIZE)
(void) env;
int param[4];
for (int i=0; i<nargs; i++) {
object *arg = first(args);
if (integerp(arg)) param[i] = arg->integer;
else param[i] = (uintptr_t)arg;
args = cdr(args);
}
int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]);
return number(w);
#else
return nil;
#endif
}
void putcode (object *arg, int origin, int pc) {
#if defined(CODESIZE)
int code = checkinteger(DEFCODE, arg);
MyCode[origin+pc] = code & 0xff;
MyCode[origin+pc+1] = (code>>8) & 0xff;
#if defined(assemblerlist)
printhex4(pc, pserial);
printhex4(code, pserial);
#endif
#endif
}
int assemble (int pass, int origin, object *entries, object *env, object *pcpair) {
int pc = 0; cdr(pcpair) = number(pc);
while (entries != NULL) {
object *arg = first(entries);
if (symbolp(arg)) {
if (pass == 2) {
#if defined(assemblerlist)
printhex4(pc, pserial);
indent(5, ' ', pserial);
printobject(arg, pserial); pln(pserial);
#endif
} else {
object *pair = findvalue(arg, env);
cdr(pair) = number(pc);
}
} else {
object *argval = eval(arg, env);
if (listp(argval)) {
object *arglist = argval;
while (arglist != NULL) {
if (pass == 2) {
putcode(first(arglist), origin, pc);
#if defined(assemblerlist)
if (arglist == argval) superprint(arg, 0, pserial);
pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
arglist = cdr(arglist);
}
} else if (integerp(argval)) {
if (pass == 2) {
putcode(argval, origin, pc);
#if defined(assemblerlist)
superprint(arg, 0, pserial); pln(pserial);
#endif
}
pc = pc + 2;
cdr(pcpair) = number(pc);
} else error(DEFCODE, PSTR("illegal entry"), arg);
}
entries = cdr(entries);
}
// Round up to multiple of 4 to give code size
if (pc%4 != 0) pc = pc + 4 - pc%4;
return pc;
}
// Special forms
object *sp_quote (object *args, object *env) {
(void) env;
checkargs(QUOTE, args);
return first(args);
}
object *sp_or (object *args, object *env) {
while (args != NULL) {
object *val = eval(car(args), env);
if (val != NULL) return val;
args = cdr(args);
}
return nil;
}
object *sp_defun (object *args, object *env) {
(void) env;
checkargs(DEFUN, args);
object *var = first(args);
if (!symbolp(var)) error(DEFUN, notasymbol, var);
object *val = cons(bsymbol(LAMBDA), cdr(args));
object *pair = value(var->name,GlobalEnv);
if (pair != NULL) cdr(pair) = val;
else push(cons(var, val), GlobalEnv);
return var;
}
object *sp_defvar (object *args, object *env) {
checkargs(DEFVAR, args);
object *var = first(args);
if (!symbolp(var)) error(DEFVAR, notasymbol, var);
object *val = NULL;
args = cdr(args);
if (args != NULL) { setflag(NOESC); val = eval(first(args), env); clrflag(NOESC); }
object *pair = value(var->name, GlobalEnv);
if (pair != NULL) cdr(pair) = val;
else push(cons(var, val), GlobalEnv);
return var;
}
object *sp_setq (object *args, object *env) {
object *arg = nil;
while (args != NULL) {
if (cdr(args) == NULL) error2(SETQ, oddargs);
object *pair = findvalue(first(args), env);
arg = eval(second(args), env);
cdr(pair) = arg;
args = cddr(args);
}
return arg;
}
object *sp_loop (object *args, object *env) {
object *start = args;
for (;;) {
args = start;
while (args != NULL) {
object *result = eval(car(args),env);
if (tstflag(RETURNFLAG)) {
clrflag(RETURNFLAG);
return result;
}
args = cdr(args);
}
}
}
object *sp_return (object *args, object *env) {
object *result = eval(tf_progn(args,env), env);
setflag(RETURNFLAG);
return result;
}
object *sp_push (object *args, object *env) {
int bit;
checkargs(PUSH, args);
object *item = eval(first(args), env);
object **loc = place(PUSH, second(args), env, &bit);
push(item, *loc);
return *loc;
}
object *sp_pop (object *args, object *env) {
int bit;
checkargs(POP, args);
object **loc = place(POP, first(args), env, &bit);
object *result = car(*loc);
pop(*loc);
return result;
}
// Accessors
object *sp_incf (object *args, object *env) {
int bit;
checkargs(INCF, args);
object **loc = place(INCF, first(args), env, &bit);
args = cdr(args);
object *x = *loc;
object *inc = (args != NULL) ? eval(first(args), env) : NULL;
if (bit != -1) {
int increment;
if (inc == NULL) increment = 1; else increment = checkbitvalue(INCF, inc);
int newvalue = (((*loc)->integer)>>bit & 1) + increment;
if (newvalue & ~1) error2(INCF, PSTR("result is not a bit value"));
*loc = number((((*loc)->integer) & ~(1<<bit)) | newvalue<<bit);
return number(newvalue);
}
if (floatp(x) || floatp(inc)) {
float increment;
float value = checkintfloat(INCF, x);
if (inc == NULL) increment = 1.0; else increment = checkintfloat(INCF, inc);
*loc = makefloat(value + increment);
} else if (integerp(x) && (integerp(inc) || inc == NULL)) {
int increment;
int value = x->integer;
if (inc == NULL) increment = 1; else increment = inc->integer;
if (increment < 1) {
if (INT_MIN - increment > value) *loc = makefloat((float)value + (float)increment);
else *loc = number(value + increment);
} else {
if (INT_MAX - increment < value) *loc = makefloat((float)value + (float)increment);
else *loc = number(value + increment);
}
} else error2(INCF, notanumber);
return *loc;
}
object *sp_decf (object *args, object *env) {
int bit;
checkargs(DECF, args);
object **loc = place(DECF, first(args), env, &bit);
args = cdr(args);
object *x = *loc;
object *dec = (args != NULL) ? eval(first(args), env) : NULL;
if (bit != -1) {
int decrement;
if (dec == NULL) decrement = 1; else decrement = checkbitvalue(DECF, dec);
int newvalue = (((*loc)->integer)>>bit & 1) - decrement;
if (newvalue & ~1) error2(INCF, PSTR("result is not a bit value"));
*loc = number((((*loc)->integer) & ~(1<<bit)) | newvalue<<bit);
return number(newvalue);
}
if (floatp(x) || floatp(dec)) {
float decrement;
float value = checkintfloat(DECF, x);
if (dec == NULL) decrement = 1.0; else decrement = checkintfloat(DECF, dec);
*loc = makefloat(value - decrement);
} if (integerp(x) && (integerp(dec) || dec == NULL)) {
int decrement;
int value = x->integer;
if (dec == NULL) decrement = 1; else decrement = dec->integer;
if (decrement < 1) {
if (INT_MAX + decrement < value) *loc = makefloat((float)value - (float)decrement);
else *loc = number(value - decrement);
} else {
if (INT_MIN + decrement > value) *loc = makefloat((float)value - (float)decrement);
else *loc = number(value - decrement);
}
} else error2(DECF, notanumber);
return *loc;
}
object *sp_setf (object *args, object *env) {
int bit;
object *arg = nil;
while (args != NULL) {
if (cdr(args) == NULL) error2(SETF, oddargs);
object **loc = place(SETF, first(args), env, &bit);
arg = eval(second(args), env);
if (bit == -1) *loc = arg;
else *loc = number((checkinteger(SETF,*loc) & ~(1<<bit)) | checkbitvalue(SETF,arg)<<bit);
args = cddr(args);
}
return arg;
}
// Other special forms
object *sp_dolist (object *args, object *env) {
if (args == NULL || listlength(DOLIST, first(args)) < 2) error2(DOLIST, noargument);
object *params = first(args);
object *var = first(params);
object *list = eval(second(params), env);
push(list, GCStack); // Don't GC the list
object *pair = cons(var,nil);
push(pair,env);
params = cdr(cdr(params));
args = cdr(args);
while (list != NULL) {
if (improperp(list)) error(DOLIST, notproper, list);
cdr(pair) = first(list);
object *forms = args;
while (forms != NULL) {
object *result = eval(car(forms), env);
if (tstflag(RETURNFLAG)) {
clrflag(RETURNFLAG);
pop(GCStack);
return result;
}
forms = cdr(forms);
}
list = cdr(list);
}
cdr(pair) = nil;
pop(GCStack);
if (params == NULL) return nil;
return eval(car(params), env);
}
object *sp_dotimes (object *args, object *env) {
if (args == NULL || listlength(DOTIMES, first(args)) < 2) error2(DOTIMES, noargument);
object *params = first(args);
object *var = first(params);
int count = checkinteger(DOTIMES, eval(second(params), env));
int index = 0;
params = cdr(cdr(params));
object *pair = cons(var,number(0));
push(pair,env);
args = cdr(args);
while (index < count) {
cdr(pair) = number(index);
object *forms = args;
while (forms != NULL) {
object *result = eval(car(forms), env);
if (tstflag(RETURNFLAG)) {
clrflag(RETURNFLAG);
return result;
}
forms = cdr(forms);
}
index++;
}
cdr(pair) = number(index);
if (params == NULL) return nil;
return eval(car(params), env);
}
object *sp_trace (object *args, object *env) {
(void) env;
while (args != NULL) {
object *var = first(args);
if (!symbolp(var)) error(TRACE, notasymbol, var);
trace(var->name);
args = cdr(args);
}
int i = 0;
while (i < TRACEMAX) {
if (TraceFn[i] != 0) args = cons(symbol(TraceFn[i]), args);
i++;
}
return args;
}
object *sp_untrace (object *args, object *env) {
(void) env;
if (args == NULL) {
int i = 0;
while (i < TRACEMAX) {
if (TraceFn[i] != 0) args = cons(symbol(TraceFn[i]), args);
TraceFn[i] = 0;
i++;
}
} else {
while (args != NULL) {
object *var = first(args);
if (!symbolp(var)) error(UNTRACE, notasymbol, var);
untrace(var->name);
args = cdr(args);
}
}
return args;
}
object *sp_formillis (object *args, object *env) {
if (args == NULL) error2(FORMILLIS, noargument);
object *param = first(args);
unsigned long start = millis();
unsigned long now, total = 0;
if (param != NULL) total = checkinteger(FORMILLIS, eval(first(param), env));
eval(tf_progn(cdr(args),env), env);
do {
now = millis() - start;
testescape();
} while (now < total);
if (now <= INT_MAX) return number(now);
return nil;
}
object *sp_time (object *args, object *env) {
unsigned long start = millis();
object *result = eval(first(args), env);
unsigned long elapsed = millis() - start;
printobject(result, pserial);
pfstring(PSTR("\nTime: "), pserial);
if (elapsed < 1000) {
pint(elapsed, pserial);
pfstring(PSTR(" ms\n"), pserial);
} else {
elapsed = elapsed+50;
pint(elapsed/1000, pserial);
pserial('.'); pint((elapsed/100)%10, pserial);
pfstring(PSTR(" s\n"), pserial);
}
return bsymbol(NOTHING);
}
object *sp_withoutputtostring (object *args, object *env) {
if (args == NULL) error2(WITHOUTPUTTOSTRING, noargument);
object *params = first(args);
if (params == NULL) error2(WITHOUTPUTTOSTRING, nostream);
object *var = first(params);
object *pair = cons(var, stream(STRINGSTREAM, 0));
push(pair,env);
object *string = startstring(WITHOUTPUTTOSTRING);
push(string, GCStack);
object *forms = cdr(args);
eval(tf_progn(forms,env), env);
pop(GCStack);
return string;
}
object *sp_withserial (object *args, object *env) {
object *params = first(args);
if (params == NULL) error2(WITHSERIAL, nostream);
object *var = first(params);
int address = checkinteger(WITHSERIAL, eval(second(params), env));
params = cddr(params);
int baud = 96;
if (params != NULL) baud = checkinteger(WITHSERIAL, eval(first(params), env));
object *pair = cons(var, stream(SERIALSTREAM, address));
push(pair,env);
serialbegin(address, baud);
object *forms = cdr(args);
object *result = eval(tf_progn(forms,env), env);
serialend(address);
return result;
}
object *sp_withi2c (object *args, object *env) {
object *params = first(args);
if (params == NULL) error2(WITHI2C, nostream);
object *var = first(params);
int address = checkinteger(WITHI2C, eval(second(params), env));
params = cddr(params);
if ((address == 0 || address == 1) && params != NULL) {
address = address * 128 + checkinteger(WITHI2C, eval(first(params), env));
params = cdr(params);
}
int read = 0; // Write
I2CCount = 0;
if (params != NULL) {
object *rw = eval(first(params), env);
if (integerp(rw)) I2CCount = rw->integer;
read = (rw != NULL);
}
// Top bit of address is I2C port
TwoWire *port = &Wire;
#if defined(ULISP_I2C1)
if (address > 127) port = &Wire1;
#endif
I2Cinit(port, 1); // Pullups
object *pair = cons(var, (I2Cstart(port, address & 0x7F, read)) ? stream(I2CSTREAM, address) : nil);
push(pair,env);
object *forms = cdr(args);
object *result = eval(tf_progn(forms,env), env);
I2Cstop(port, read);
return result;
}
object *sp_withspi (object *args, object *env) {
object *params = first(args);
if (params == NULL) error2(WITHSPI, nostream);
object *var = first(params);
params = cdr(params);
if (params == NULL) error2(WITHSPI, nostream);
int pin = checkinteger(WITHSPI, eval(car(params), env));
pinMode(pin, OUTPUT);
digitalWrite(pin, HIGH);
params = cdr(params);
int clock = 4000, mode = SPI_MODE0, address = 0; // Defaults
BitOrder bitorder = MSBFIRST;
if (params != NULL) {
clock = checkinteger(WITHSPI, eval(car(params), env));
params = cdr(params);
if (params != NULL) {
bitorder = (checkinteger(WITHSPI, eval(car(params), env)) == 0) ? LSBFIRST : MSBFIRST;
params = cdr(params);
if (params != NULL) {
int modeval = checkinteger(WITHSPI, eval(car(params), env));
mode = (modeval == 3) ? SPI_MODE3 : (modeval == 2) ? SPI_MODE2 : (modeval == 1) ? SPI_MODE1 : SPI_MODE0;
params = cdr(params);
if (params != NULL) {
address = checkinteger(WITHSPI, eval(car(params), env));
}
}
}
}
object *pair = cons(var, stream(SPISTREAM, pin + 128*address));
push(pair,env);
SPIClass *spiClass = &SPI;
#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) || defined(ARDUINO_PYBADGE_M4) || defined(ARDUINO_PYGAMER_M4) || defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
if (address == 1) spiClass = &SPI1;
#endif
spiClass->begin();
spiClass->beginTransaction(SPISettings(((unsigned long)clock * 1000), bitorder, mode));
digitalWrite(pin, LOW);
object *forms = cdr(args);
object *result = eval(tf_progn(forms,env), env);
digitalWrite(pin, HIGH);
spiClass->endTransaction();
return result;
}
object *sp_withsdcard (object *args, object *env) {
#if defined(sdcardsupport)
object *params = first(args);
if (params == NULL) error2(WITHSDCARD, nostream);
object *var = first(params);
object *filename = eval(second(params), env);
params = cddr(params);
SD.begin(SDCARD_SS_PIN);
int mode = 0;
if (params != NULL && first(params) != NULL) mode = checkinteger(WITHSDCARD, first(params));
int oflag = O_READ;
if (mode == 1) oflag = O_RDWR | O_CREAT | O_APPEND; else if (mode == 2) oflag = O_RDWR | O_CREAT | O_TRUNC;
if (mode >= 1) {
char buffer[BUFFERSIZE];
SDpfile = SD.open(MakeFilename(filename, buffer), oflag);
if (!SDpfile) error2(WITHSDCARD, PSTR("problem writing to SD card or invalid filename"));
} else {
char buffer[BUFFERSIZE];
SDgfile = SD.open(MakeFilename(filename, buffer), oflag);
if (!SDgfile) error2(WITHSDCARD, PSTR("problem reading from SD card or invalid filename"));
}
object *pair = cons(var, stream(SDSTREAM, 1));
push(pair,env);
object *forms = cdr(args);
object *result = eval(tf_progn(forms,env), env);
if (mode >= 1) SDpfile.close(); else SDgfile.close();
return result;
#else
(void) args, (void) env;
error2(WITHSDCARD, PSTR("not supported"));
return nil;
#endif
}
object *sp_withgfx (object *args, object *env) {
#if defined(gfxsupport)
object *params = first(args);
object *var = first(params);
object *pair = cons(var, stream(GFXSTREAM, 1));
push(pair,env);
object *forms = cdr(args);
object *result = eval(tf_progn(forms,env), env);
return result;
#else
(void) args, (void) env;
error2(WITHGFX, PSTR("not supported"));
return nil;
#endif
}
// Assembler
object *sp_defcode (object *args, object *env) {
#if defined(CODESIZE)
setflag(NOESC);
checkargs(DEFCODE, args);
object *var = first(args);
object *params = second(args);
if (!symbolp(var)) error(DEFCODE, PSTR("not a symbol"), var);
// Make parameters into synonyms for registers r0, r1, etc
int regn = 0;
while (params != NULL) {
if (regn > 3) error(DEFCODE, PSTR("more than 4 parameters"), var);
object *regpair = cons(car(params), bsymbol((builtin_t)((toradix40('r')*40+toradix40('0')+regn)*2560000))); // Symbol for r0 etc
push(regpair,env);
regn++;
params = cdr(params);
}
// Make *pc* a local variable for program counter
object *pcpair = cons(bsymbol(PSTAR), number(0));
push(pcpair,env);
args = cdr(args);
// Make labels into local variables
object *entries = cdr(args);
while (entries != NULL) {
object *arg = first(entries);
if (symbolp(arg)) {
object *pair = cons(arg,number(0));
push(pair,env);
}
entries = cdr(entries);
}
// First pass
int origin = 0;
int codesize = assemble(1, origin, cdr(args), env, pcpair);
// See if it will fit
object *globals = GlobalEnv;
while (globals != NULL) {
object *pair = car(globals);
if (pair != NULL && car(pair) != var && consp(cdr(pair))) { // Exclude me if I already exist
object *codeid = second(pair);
if (codeid->type == CODE) {
codesize = codesize + endblock(codeid) - startblock(codeid);
}
}
globals = cdr(globals);
}
if (codesize > CODESIZE) error(DEFCODE, PSTR("not enough room for code"), var);
// Compact the code block, removing gaps
origin = 0;
object *block;
int smallest;
do {
smallest = CODESIZE;
globals = GlobalEnv;
while (globals != NULL) {
object *pair = car(globals);
if (pair != NULL && car(pair) != var && consp(cdr(pair))) { // Exclude me if I already exist
object *codeid = second(pair);
if (codeid->type == CODE) {
if (startblock(codeid) < smallest && startblock(codeid) >= origin) {
smallest = startblock(codeid);
block = codeid;
}
}
}
globals = cdr(globals);
}
// Compact fragmentation if necessary
if (smallest == origin) origin = endblock(block); // No gap
else if (smallest < CODESIZE) { // Slide block down
int target = origin;
for (int i=startblock(block); i<endblock(block); i++) {
MyCode[target] = MyCode[i];
target++;
}
block->integer = target<<16 | origin;
origin = target;
}
} while (smallest < CODESIZE);
// Second pass - origin is first free location
codesize = assemble(2, origin, cdr(args), env, pcpair);
object *val = cons(codehead((origin+codesize)<<16 | origin), args);
object *pair = value(var->name, GlobalEnv);
if (pair != NULL) cdr(pair) = val;
else push(cons(var, val), GlobalEnv);
clrflag(NOESC);
return var;
#else
error2(DEFCODE, PSTR("not available"));
return nil;
#endif
}
// Tail-recursive forms
object *tf_progn (object *args, object *env) {
if (args == NULL) return nil;
object *more = cdr(args);
while (more != NULL) {
object *result = eval(car(args),env);
if (tstflag(RETURNFLAG)) return result;
args = more;
more = cdr(args);
}
return car(args);
}
object *tf_if (object *args, object *env) {
if (args == NULL || cdr(args) == NULL) error2(IF, toofewargs);
if (eval(first(args), env) != nil) return second(args);
args = cddr(args);
return (args != NULL) ? first(args) : nil;
}
object *tf_cond (object *args, object *env) {
while (args != NULL) {
object *clause = first(args);
if (!consp(clause)) error(COND, illegalclause, clause);
object *test = eval(first(clause), env);
object *forms = cdr(clause);
if (test != nil) {
if (forms == NULL) return quote(test); else return tf_progn(forms, env);
}
args = cdr(args);
}
return nil;
}
object *tf_when (object *args, object *env) {
if (args == NULL) error2(WHEN, noargument);
if (eval(first(args), env) != nil) return tf_progn(cdr(args),env);
else return nil;
}
object *tf_unless (object *args, object *env) {
if (args == NULL) error2(UNLESS, noargument);
if (eval(first(args), env) != nil) return nil;
else return tf_progn(cdr(args),env);
}
object *tf_case (object *args, object *env) {
object *test = eval(first(args), env);
args = cdr(args);
while (args != NULL) {
object *clause = first(args);
if (!consp(clause)) error(CASE, illegalclause, clause);
object *key = car(clause);
object *forms = cdr(clause);
if (consp(key)) {
while (key != NULL) {
if (eq(test,car(key))) return tf_progn(forms, env);
key = cdr(key);
}
} else if (eq(test,key) || eq(key,tee)) return tf_progn(forms, env);
args = cdr(args);
}
return nil;
}
object *tf_and (object *args, object *env) {
if (args == NULL) return tee;
object *more = cdr(args);
while (more != NULL) {
if (eval(car(args), env) == NULL) return nil;
args = more;
more = cdr(args);
}
return car(args);
}
// Core functions
object *fn_not (object *args, object *env) {
(void) env;
return (first(args) == nil) ? tee : nil;
}
object *fn_cons (object *args, object *env) {
(void) env;
return cons(first(args), second(args));
}
object *fn_atom (object *args, object *env) {
(void) env;
return atom(first(args)) ? tee : nil;
}
object *fn_listp (object *args, object *env) {
(void) env;
return listp(first(args)) ? tee : nil;
}
object *fn_consp (object *args, object *env) {
(void) env;
return consp(first(args)) ? tee : nil;
}
object *fn_symbolp (object *args, object *env) {
(void) env;
object *arg = first(args);
return (arg == NULL || symbolp(arg)) ? tee : nil;
}
object *fn_arrayp (object *args, object *env) {
(void) env;
return arrayp(first(args)) ? tee : nil;
}
object *fn_boundp (object *args, object *env) {
(void) env;
object *var = first(args);
if (!symbolp(var)) error(BOUNDP, notasymbol, var);
return boundp(var, env) ? tee : nil;
}
object *fn_setfn (object *args, object *env) {
object *arg = nil;
while (args != NULL) {
if (cdr(args) == NULL) error2(SETFN, oddargs);
object *pair = findvalue(first(args), env);
arg = second(args);
cdr(pair) = arg;
args = cddr(args);
}
return arg;
}
object *fn_streamp (object *args, object *env) {
(void) env;
object *arg = first(args);
return streamp(arg) ? tee : nil;
}
object *fn_eq (object *args, object *env) {
(void) env;
return eq(first(args), second(args)) ? tee : nil;
}
// List functions
object *fn_car (object *args, object *env) {
(void) env;
return carx(first(args));
}
object *fn_cdr (object *args, object *env) {
(void) env;
return cdrx(first(args));
}
object *cxxxr (object *args, uint8_t pattern) {
object *arg = first(args);
while (pattern != 1) {
if ((pattern & 1) == 0) arg = carx(arg); else arg = cdrx(arg);
pattern = pattern>>1;
}
return arg;
}
object *fn_caar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b100);
}
object *fn_cadr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b101);
}
object *fn_cdar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b110);
}
object *fn_cddr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b111);
}
object *fn_caaar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1000);
}
object *fn_caadr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1001);;
}
object *fn_cadar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1010);
}
object *fn_caddr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1011);
}
object *fn_cdaar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1100);
}
object *fn_cdadr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1101);
}
object *fn_cddar (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1110);
}
object *fn_cdddr (object *args, object *env) {
(void) env;
return cxxxr(args, 0b1111);
}
object *fn_length (object *args, object *env) {
(void) env;
object *arg = first(args);
if (listp(arg)) return number(listlength(LENGTH, arg));
if (stringp(arg)) return number(stringlength(arg));
if (!(arrayp(arg) && cdr(cddr(arg)) == NULL)) error(LENGTH, PSTR("argument is not a list, 1d array, or string"), arg);
return number(abs(first(cddr(arg))->integer));
}
object *fn_arraydimensions (object *args, object *env) {
(void) env;
object *array = first(args);
if (!arrayp(array)) error(ARRAYDIMENSIONS, PSTR("argument is not an array"), array);
object *dimensions = cddr(array);
return (first(dimensions)->integer < 0) ? cons(number(-(first(dimensions)->integer)), cdr(dimensions)) : dimensions;
}
object *fn_list (object *args, object *env) {
(void) env;
return args;
}
object *fn_makearray (object *args, object *env) {
(void) env;
object *def = nil;
bool bitp = false;
object *dims = first(args);
if (dims == NULL) error2(MAKEARRAY, PSTR("dimensions can't be nil"));
else if (atom(dims)) dims = cons(dims, NULL);
args = cdr(args);
while (args != NULL && cdr(args) != NULL) {
object *var = first(args);
if (isbuiltin(first(args), INITIALELEMENT)) def = second(args);
else if (isbuiltin(first(args), ELEMENTTYPE) && isbuiltin(second(args), BIT)) bitp = true;
else error(MAKEARRAY, PSTR("argument not recognised"), var);
args = cddr(args);
}
if (bitp) {
if (def == nil) def = number(0);
else def = number(-checkbitvalue(MAKEARRAY, def)); // 1 becomes all ones
}
return makearray(MAKEARRAY, dims, def, bitp);
}
object *fn_reverse (object *args, object *env) {
(void) env;
object *list = first(args);
object *result = NULL;
while (list != NULL) {
if (improperp(list)) error(REVERSE, notproper, list);
push(first(list),result);
list = cdr(list);
}
return result;
}
object *fn_nth (object *args, object *env) {
(void) env;
int n = checkinteger(NTH, first(args));
if (n < 0) error(NTH, indexnegative, first(args));
object *list = second(args);
while (list != NULL) {
if (improperp(list)) error(NTH, notproper, list);
if (n == 0) return car(list);
list = cdr(list);
n--;
}
return nil;
}
object *fn_areff (object *args, object *env) {
(void) env;
int bit;
object *array = first(args);
if (!arrayp(array)) error(AREFF, PSTR("first argument is not an array"), array);
object *loc = *getarray(AREFF, array, cdr(args), 0, &bit);
if (bit == -1) return loc;
else return number((loc->integer)>>bit & 1);
}
object *fn_assoc (object *args, object *env) {
(void) env;
object *key = first(args);
object *list = second(args);
return assoc(key,list);
}
object *fn_member (object *args, object *env) {
(void) env;
object *item = first(args);
object *list = second(args);
while (list != NULL) {
if (improperp(list)) error(MEMBER, notproper, list);
if (eq(item,car(list))) return list;
list = cdr(list);
}
return nil;
}
object *fn_apply (object *args, object *env) {
object *previous = NULL;
object *last = args;
while (cdr(last) != NULL) {
previous = last;
last = cdr(last);
}
object *arg = car(last);
if (!listp(arg)) error(APPLY, notalist, arg);
cdr(previous) = arg;
return apply(APPLY, first(args), cdr(args), env);
}
object *fn_funcall (object *args, object *env) {
return apply(FUNCALL, first(args), cdr(args), env);
}
object *fn_append (object *args, object *env) {
(void) env;
object *head = NULL;
object *tail;
while (args != NULL) {
object *list = first(args);
if (!listp(list)) error(APPEND, notalist, list);
while (consp(list)) {
object *obj = cons(car(list), cdr(list));
if (head == NULL) head = obj;
else cdr(tail) = obj;
tail = obj;
list = cdr(list);
if (cdr(args) != NULL && improperp(list)) error(APPEND, notproper, first(args));
}
args = cdr(args);
}
return head;
}
object *fn_mapc (object *args, object *env) {
object *function = first(args);
args = cdr(args);
object *result = first(args);
object *params = cons(NULL, NULL);
push(params,GCStack);
// Make parameters
while (true) {
object *tailp = params;
object *lists = args;
while (lists != NULL) {
object *list = car(lists);
if (list == NULL) {
pop(GCStack);
return result;
}
if (improperp(list)) error(MAPC, notproper, list);
object *obj = cons(first(list),NULL);
car(lists) = cdr(list);
cdr(tailp) = obj; tailp = obj;
lists = cdr(lists);
}
apply(MAPC, function, cdr(params), env);
}
}
void mapcarfun (object *result, object **tail) {
object *obj = cons(result,NULL);
cdr(*tail) = obj; *tail = obj;
}
void mapcanfun (object *result, object **tail) {
if (cdr(*tail) != NULL) error(MAPCAN, notproper, *tail);
while (consp(result)) {
cdr(*tail) = result; *tail = result;
result = cdr(result);
}
}
object *mapcarcan (builtin_t name, object *args, object *env, mapfun_t fun) {
object *function = first(args);
args = cdr(args);
object *params = cons(NULL, NULL);
push(params,GCStack);
object *head = cons(NULL, NULL);
push(head,GCStack);
object *tail = head;
// Make parameters
while (true) {
object *tailp = params;
object *lists = args;
while (lists != NULL) {
object *list = car(lists);
if (list == NULL) {
pop(GCStack);
pop(GCStack);
return cdr(head);
}
if (improperp(list)) error(name, notproper, list);
object *obj = cons(first(list),NULL);
car(lists) = cdr(list);
cdr(tailp) = obj; tailp = obj;
lists = cdr(lists);
}
object *result = apply(name, function, cdr(params), env);
fun(result, &tail);
}
}
object *fn_mapcar (object *args, object *env) {
return mapcarcan(MAPCAR, args, env, mapcarfun);
}
object *fn_mapcan (object *args, object *env) {
return mapcarcan(MAPCAN, args, env, mapcanfun);
}
// Arithmetic functions
object *add_floats (object *args, float fresult) {
while (args != NULL) {
object *arg = car(args);
fresult = fresult + checkintfloat(ADD, arg);
args = cdr(args);
}
return makefloat(fresult);
}
object *fn_add (object *args, object *env) {
(void) env;
int result = 0;
while (args != NULL) {
object *arg = car(args);
if (floatp(arg)) return add_floats(args, (float)result);
else if (integerp(arg)) {
int val = arg->integer;
if (val < 1) { if (INT_MIN - val > result) return add_floats(args, (float)result); }
else { if (INT_MAX - val < result) return add_floats(args, (float)result); }
result = result + val;
} else error(ADD, notanumber, arg);
args = cdr(args);
}
return number(result);
}
object *subtract_floats (object *args, float fresult) {
while (args != NULL) {
object *arg = car(args);
fresult = fresult - checkintfloat(SUBTRACT, arg);
args = cdr(args);
}
return makefloat(fresult);
}
object *negate (object *arg) {
if (integerp(arg)) {
int result = arg->integer;
if (result == INT_MIN) return makefloat(-result);
else return number(-result);
} else if (floatp(arg)) return makefloat(-(arg->single_float));
else error(SUBTRACT, notanumber, arg);
return nil;
}
object *fn_subtract (object *args, object *env) {
(void) env;
object *arg = car(args);
args = cdr(args);
if (args == NULL) return negate(arg);
else if (floatp(arg)) return subtract_floats(args, arg->single_float);
else if (integerp(arg)) {
int result = arg->integer;
while (args != NULL) {
arg = car(args);
if (floatp(arg)) return subtract_floats(args, result);
else if (integerp(arg)) {
int val = (car(args))->integer;
if (val < 1) { if (INT_MAX + val < result) return subtract_floats(args, result); }
else { if (INT_MIN + val > result) return subtract_floats(args, result); }
result = result - val;
} else error(SUBTRACT, notanumber, arg);
args = cdr(args);
}
return number(result);
} else error(SUBTRACT, notanumber, arg);
return nil;
}
object *multiply_floats (object *args, float fresult) {
while (args != NULL) {
object *arg = car(args);
fresult = fresult * checkintfloat(MULTIPLY, arg);
args = cdr(args);
}
return makefloat(fresult);
}
object *fn_multiply (object *args, object *env) {
(void) env;
int result = 1;
while (args != NULL){
object *arg = car(args);
if (floatp(arg)) return multiply_floats(args, result);
else if (integerp(arg)) {
int64_t val = result * (int64_t)(arg->integer);
if ((val > INT_MAX) || (val < INT_MIN)) return multiply_floats(args, result);
result = val;
} else error(MULTIPLY, notanumber, arg);
args = cdr(args);
}
return number(result);
}
object *divide_floats (object *args, float fresult) {
while (args != NULL) {
object *arg = car(args);
float f = checkintfloat(DIVIDE, arg);
if (f == 0.0) error2(DIVIDE, divisionbyzero);
fresult = fresult / f;
args = cdr(args);
}
return makefloat(fresult);
}
object *fn_divide (object *args, object *env) {
(void) env;
object* arg = first(args);
args = cdr(args);
// One argument
if (args == NULL) {
if (floatp(arg)) {
float f = arg->single_float;
if (f == 0.0) error2(DIVIDE, PSTR("division by zero"));
return makefloat(1.0 / f);
} else if (integerp(arg)) {
int i = arg->integer;
if (i == 0) error2(DIVIDE, PSTR("division by zero"));
else if (i == 1) return number(1);
else return makefloat(1.0 / i);
} else error(DIVIDE, notanumber, arg);
}
// Multiple arguments
if (floatp(arg)) return divide_floats(args, arg->single_float);
else if (integerp(arg)) {
int result = arg->integer;
while (args != NULL) {
arg = car(args);
if (floatp(arg)) {
return divide_floats(args, result);
} else if (integerp(arg)) {
int i = arg->integer;
if (i == 0) error2(DIVIDE, PSTR("division by zero"));
if ((result % i) != 0) return divide_floats(args, result);
if ((result == INT_MIN) && (i == -1)) return divide_floats(args, result);
result = result / i;
args = cdr(args);
} else error(DIVIDE, notanumber, arg);
}
return number(result);
} else error(DIVIDE, notanumber, arg);
return nil;
}
object *fn_mod (object *args, object *env) {
(void) env;
object *arg1 = first(args);
object *arg2 = second(args);
if (integerp(arg1) && integerp(arg2)) {
int divisor = arg2->integer;
if (divisor == 0) error2(MOD, PSTR("division by zero"));
int dividend = arg1->integer;
int remainder = dividend % divisor;
if ((dividend<0) != (divisor<0)) remainder = remainder + divisor;
return number(remainder);
} else {
float fdivisor = checkintfloat(MOD, arg2);
if (fdivisor == 0.0) error2(MOD, PSTR("division by zero"));
float fdividend = checkintfloat(MOD, arg1);
float fremainder = fmod(fdividend , fdivisor);
if ((fdividend<0) != (fdivisor<0)) fremainder = fremainder + fdivisor;
return makefloat(fremainder);
}
}
object *fn_oneplus (object *args, object *env) {
(void) env;
object* arg = first(args);
if (floatp(arg)) return makefloat((arg->single_float) + 1.0);
else if (integerp(arg)) {
int result = arg->integer;
if (result == INT_MAX) return makefloat((arg->integer) + 1.0);
else return number(result + 1);
} else error(ONEPLUS, notanumber, arg);
return nil;
}
object *fn_oneminus (object *args, object *env) {
(void) env;
object* arg = first(args);
if (floatp(arg)) return makefloat((arg->single_float) - 1.0);
else if (integerp(arg)) {
int result = arg->integer;
if (result == INT_MIN) return makefloat((arg->integer) - 1.0);
else return number(result - 1);
} else error(ONEMINUS, notanumber, arg);
return nil;
}
object *fn_abs (object *args, object *env) {
(void) env;
object *arg = first(args);
if (floatp(arg)) return makefloat(abs(arg->single_float));
else if (integerp(arg)) {
int result = arg->integer;
if (result == INT_MIN) return makefloat(abs((float)result));
else return number(abs(result));
} else error(ABS, notanumber, arg);
return nil;
}
object *fn_random (object *args, object *env) {
(void) env;
object *arg = first(args);
if (integerp(arg)) return number(random(arg->integer));
else if (floatp(arg)) return makefloat((float)rand()/(float)(RAND_MAX/(arg->single_float)));
else error(RANDOM, notanumber, arg);
return nil;
}
object *fn_maxfn (object *args, object *env) {
(void) env;
object* result = first(args);
args = cdr(args);
while (args != NULL) {
object *arg = car(args);
if (integerp(result) && integerp(arg)) {
if ((arg->integer) > (result->integer)) result = arg;
} else if ((checkintfloat(MAXFN, arg) > checkintfloat(MAXFN, result))) result = arg;
args = cdr(args);
}
return result;
}
object *fn_minfn (object *args, object *env) {
(void) env;
object* result = first(args);
args = cdr(args);
while (args != NULL) {
object *arg = car(args);
if (integerp(result) && integerp(arg)) {
if ((arg->integer) < (result->integer)) result = arg;
} else if ((checkintfloat(MINFN, arg) < checkintfloat(MINFN, result))) result = arg;
args = cdr(args);
}
return result;
}
// Arithmetic comparisons
object *fn_noteq (object *args, object *env) {
(void) env;
while (args != NULL) {
object *nargs = args;
object *arg1 = first(nargs);
nargs = cdr(nargs);
while (nargs != NULL) {
object *arg2 = first(nargs);
if (integerp(arg1) && integerp(arg2)) {
if ((arg1->integer) == (arg2->integer)) return nil;
} else if ((checkintfloat(NOTEQ, arg1) == checkintfloat(NOTEQ, arg2))) return nil;
nargs = cdr(nargs);
}
args = cdr(args);
}
return tee;
}
object *compare (builtin_t name, object *args, bool lt, bool gt, bool eq) {
object *arg1 = first(args);
args = cdr(args);
while (args != NULL) {
object *arg2 = first(args);
if (integerp(arg1) && integerp(arg2)) {
if (!lt && ((arg1->integer) < (arg2->integer))) return nil;
if (!eq && ((arg1->integer) == (arg2->integer))) return nil;
if (!gt && ((arg1->integer) > (arg2->integer))) return nil;
} else {
if (!lt && (checkintfloat(name, arg1) < checkintfloat(name, arg2))) return nil;
if (!eq && (checkintfloat(name, arg1) == checkintfloat(name, arg2))) return nil;
if (!gt && (checkintfloat(name, arg1) > checkintfloat(name, arg2))) return nil;
}
arg1 = arg2;
args = cdr(args);
}
return tee;
}
object *fn_numeq (object *args, object *env) {
(void) env;
return compare(NUMEQ, args, false, false, true);
}
object *fn_less (object *args, object *env) {
(void) env;
return compare(LESS, args, true, false, false);
}
object *fn_lesseq (object *args, object *env) {
(void) env;
return compare(LESSEQ, args, true, false, true);
}
object *fn_greater (object *args, object *env) {
(void) env;
return compare(GREATER, args, false, true, false);
}
object *fn_greatereq (object *args, object *env) {
(void) env;
return compare(GREATEREQ, args, false, true, true);
}
object *fn_plusp (object *args, object *env) {
(void) env;
object *arg = first(args);
if (floatp(arg)) return ((arg->single_float) > 0.0) ? tee : nil;
else if (integerp(arg)) return ((arg->integer) > 0) ? tee : nil;
else error(PLUSP, notanumber, arg);
return nil;
}
object *fn_minusp (object *args, object *env) {
(void) env;
object *arg = first(args);
if (floatp(arg)) return ((arg->single_float) < 0.0) ? tee : nil;
else if (integerp(arg)) return ((arg->integer) < 0) ? tee : nil;
else error(MINUSP, notanumber, arg);
return nil;
}
object *fn_zerop (object *args, object *env) {
(void) env;
object *arg = first(args);
if (floatp(arg)) return ((arg->single_float) == 0.0) ? tee : nil;
else if (integerp(arg)) return ((arg->integer) == 0) ? tee : nil;
else error(ZEROP, notanumber, arg);
return nil;
}
object *fn_oddp (object *args, object *env) {
(void) env;
int arg = checkinteger(ODDP, first(args));
return ((arg & 1) == 1) ? tee : nil;
}
object *fn_evenp (object *args, object *env) {
(void) env;
int arg = checkinteger(EVENP, first(args));
return ((arg & 1) == 0) ? tee : nil;
}
// Number functions
object *fn_integerp (object *args, object *env) {
(void) env;
return integerp(first(args)) ? tee : nil;
}
object *fn_numberp (object *args, object *env) {
(void) env;
object *arg = first(args);
return (integerp(arg) || floatp(arg)) ? tee : nil;
}
// Floating-point functions
object *fn_floatfn (object *args, object *env) {
(void) env;
object *arg = first(args);
return (floatp(arg)) ? arg : makefloat((float)(arg->integer));
}
object *fn_floatp (object *args, object *env) {
(void) env;
return floatp(first(args)) ? tee : nil;
}
object *fn_sin (object *args, object *env) {
(void) env;
return makefloat(sin(checkintfloat(SIN, first(args))));
}
object *fn_cos (object *args, object *env) {
(void) env;
return makefloat(cos(checkintfloat(COS, first(args))));
}
object *fn_tan (object *args, object *env) {
(void) env;
return makefloat(tan(checkintfloat(TAN, first(args))));
}
object *fn_asin (object *args, object *env) {
(void) env;
return makefloat(asin(checkintfloat(ASIN, first(args))));
}
object *fn_acos (object *args, object *env) {
(void) env;
return makefloat(acos(checkintfloat(ACOS, first(args))));
}
object *fn_atan (object *args, object *env) {
(void) env;
object *arg = first(args);
float div = 1.0;
args = cdr(args);
if (args != NULL) div = checkintfloat(ATAN, first(args));
return makefloat(atan2(checkintfloat(ATAN, arg), div));
}
object *fn_sinh (object *args, object *env) {
(void) env;
return makefloat(sinh(checkintfloat(SINH, first(args))));
}
object *fn_cosh (object *args, object *env) {
(void) env;
return makefloat(cosh(checkintfloat(COSH, first(args))));
}
object *fn_tanh (object *args, object *env) {
(void) env;
return makefloat(tanh(checkintfloat(TANH, first(args))));
}
object *fn_exp (object *args, object *env) {
(void) env;
return makefloat(exp(checkintfloat(EXP, first(args))));
}
object *fn_sqrt (object *args, object *env) {
(void) env;
return makefloat(sqrt(checkintfloat(SQRT, first(args))));
}
object *fn_log (object *args, object *env) {
(void) env;
object *arg = first(args);
float fresult = log(checkintfloat(LOG, arg));
args = cdr(args);
if (args == NULL) return makefloat(fresult);
else return makefloat(fresult / log(checkintfloat(LOG, first(args))));
}
int intpower (int base, int exp) {
int result = 1;
while (exp) {
if (exp & 1) result = result * base;
exp = exp / 2;
base = base * base;
}
return result;
}
object *fn_expt (object *args, object *env) {
(void) env;
object *arg1 = first(args); object *arg2 = second(args);
float float1 = checkintfloat(EXPT, arg1);
float value = log(abs(float1)) * checkintfloat(EXPT, arg2);
if (integerp(arg1) && integerp(arg2) && ((arg2->integer) >= 0) && (abs(value) < 21.4875))
return number(intpower(arg1->integer, arg2->integer));
if (float1 < 0) {
if (integerp(arg2)) return makefloat((arg2->integer & 1) ? -exp(value) : exp(value));
else error2(EXPT, PSTR("invalid result"));
}
return makefloat(exp(value));
}
object *fn_ceiling (object *args, object *env) {
(void) env;
object *arg = first(args);
args = cdr(args);
if (args != NULL) return number(ceil(checkintfloat(CEILING, arg) / checkintfloat(CEILING, first(args))));
else return number(ceil(checkintfloat(CEILING, arg)));
}
object *fn_floor (object *args, object *env) {
(void) env;
object *arg = first(args);
args = cdr(args);
if (args != NULL) return number(floor(checkintfloat(FLOOR, arg) / checkintfloat(FLOOR, first(args))));
else return number(floor(checkintfloat(FLOOR, arg)));
}
object *fn_truncate (object *args, object *env) {
(void) env;
object *arg = first(args);
args = cdr(args);
if (args != NULL) return number((int)(checkintfloat(TRUNCATE, arg) / checkintfloat(TRUNCATE, first(args))));
else return number((int)(checkintfloat(TRUNCATE, arg)));
}
int myround (float number) {
return (number >= 0) ? (int)(number + 0.5) : (int)(number - 0.5);
}
object *fn_round (object *args, object *env) {
(void) env;
object *arg = first(args);
args = cdr(args);
if (args != NULL) return number(myround(checkintfloat(ROUND, arg) / checkintfloat(ROUND, first(args))));
else return number(myround(checkintfloat(ROUND, arg)));
}
// Characters
object *fn_char (object *args, object *env) {
(void) env;
object *arg = first(args);
if (!stringp(arg)) error(CHAR, notastring, arg);
char c = nthchar(arg, checkinteger(CHAR, second(args)));
if (c == 0) error2(CHAR, indexrange);
return character(c);
}
object *fn_charcode (object *args, object *env) {
(void) env;
return number(checkchar(CHARCODE, first(args)));
}
object *fn_codechar (object *args, object *env) {
(void) env;
return character(checkinteger(CODECHAR, first(args)));
}
object *fn_characterp (object *args, object *env) {
(void) env;
return characterp(first(args)) ? tee : nil;
}
// Strings
object *fn_stringp (object *args, object *env) {
(void) env;
return stringp(first(args)) ? tee : nil;
}
bool stringcompare (builtin_t name, object *args, bool lt, bool gt, bool eq) {
object *arg1 = checkstring(name, first(args));
object *arg2 = checkstring(name, second(args));
arg1 = cdr(arg1);
arg2 = cdr(arg2);
while ((arg1 != NULL) || (arg2 != NULL)) {
if (arg1 == NULL) return lt;
if (arg2 == NULL) return gt;
if (arg1->chars < arg2->chars) return lt;
if (arg1->chars > arg2->chars) return gt;
arg1 = car(arg1);
arg2 = car(arg2);
}
return eq;
}
object *fn_stringeq (object *args, object *env) {
(void) env;
return stringcompare(STRINGEQ, args, false, false, true) ? tee : nil;
}
object *fn_stringless (object *args, object *env) {
(void) env;
return stringcompare(STRINGLESS, args, true, false, false) ? tee : nil;
}
object *fn_stringgreater (object *args, object *env) {
(void) env;
return stringcompare(STRINGGREATER, args, false, true, false) ? tee : nil;
}
object *fn_sort (object *args, object *env) {
if (first(args) == NULL) return nil;
object *list = cons(nil,first(args));
push(list,GCStack);
object *predicate = second(args);
object *compare = cons(NULL, cons(NULL, NULL));
push(compare,GCStack);
object *ptr = cdr(list);
while (cdr(ptr) != NULL) {
object *go = list;
while (go != ptr) {
car(compare) = car(cdr(ptr));
car(cdr(compare)) = car(cdr(go));
if (apply(SORT, predicate, compare, env)) break;
go = cdr(go);
}
if (go != ptr) {
object *obj = cdr(ptr);
cdr(ptr) = cdr(obj);
cdr(obj) = cdr(go);
cdr(go) = obj;
} else ptr = cdr(ptr);
}
pop(GCStack); pop(GCStack);
return cdr(list);
}
object *fn_stringfn (object *args, object *env) {
return fn_princtostring(args, env);
}
object *fn_concatenate (object *args, object *env) {
(void) env;
object *arg = first(args);
if (builtin(arg->name) != STRINGFN) error2(CONCATENATE, PSTR("only supports strings"));
args = cdr(args);
object *result = newstring();
object *tail = result;
while (args != NULL) {
object *obj = checkstring(CONCATENATE, first(args));
obj = cdr(obj);
while (obj != NULL) {
int quad = obj->chars;
while (quad != 0) {
char ch = quad>>((sizeof(int)-1)*8) & 0xFF;
buildstring(ch, &tail);
quad = quad<<8;
}
obj = car(obj);
}
args = cdr(args);
}
return result;
}
object *fn_subseq (object *args, object *env) {
(void) env;
object *arg = checkstring(SUBSEQ, first(args));
int start = checkinteger(SUBSEQ, second(args));
if (start < 0) error(SUBSEQ, indexnegative, second(args));
int end;
args = cddr(args);
if (args != NULL) end = checkinteger(SUBSEQ, car(args)); else end = stringlength(arg);
object *result = newstring();
object *tail = result;
for (int i=start; i<end; i++) {
char ch = nthchar(arg, i);
if (ch == 0) error2(SUBSEQ, indexrange);
buildstring(ch, &tail);
}
return result;
}
object *fn_readfromstring (object *args, object *env) {
(void) env;
object *arg = checkstring(READFROMSTRING, first(args));
GlobalString = arg;
GlobalStringIndex = 0;
return read(gstr);
}
object *fn_princtostring (object *args, object *env) {
(void) env;
object *arg = first(args);
object *obj = startstring(PRINCTOSTRING);
prin1object(arg, pstr);
return obj;
}
object *fn_prin1tostring (object *args, object *env) {
(void) env;
object *arg = first(args);
object *obj = startstring(PRIN1TOSTRING);
printobject(arg, pstr);
return obj;
}
// Bitwise operators
object *fn_logand (object *args, object *env) {
(void) env;
int result = -1;
while (args != NULL) {
result = result & checkinteger(LOGAND, first(args));
args = cdr(args);
}
return number(result);
}
object *fn_logior (object *args, object *env) {
(void) env;
int result = 0;
while (args != NULL) {
result = result | checkinteger(LOGIOR, first(args));
args = cdr(args);
}
return number(result);
}
object *fn_logxor (object *args, object *env) {
(void) env;
int result = 0;
while (args != NULL) {
result = result ^ checkinteger(LOGXOR, first(args));
args = cdr(args);
}
return number(result);
}
object *fn_lognot (object *args, object *env) {
(void) env;
int result = checkinteger(LOGNOT, car(args));
return number(~result);
}
object *fn_ash (object *args, object *env) {
(void) env;
int value = checkinteger(ASH, first(args));
int count = checkinteger(ASH, second(args));
if (count >= 0) return number(value << count);
else return number(value >> abs(count));
}
object *fn_logbitp (object *args, object *env) {
(void) env;
int index = checkinteger(LOGBITP, first(args));
int value = checkinteger(LOGBITP, second(args));
return (bitRead(value, index) == 1) ? tee : nil;
}
// System functions
object *fn_eval (object *args, object *env) {
return eval(first(args), env);
}
object *fn_globals (object *args, object *env) {
(void) args;
if (GlobalEnv == NULL) return nil;
return fn_mapcar(cons(bsymbol(CAR),cons(GlobalEnv,nil)), env);
}
object *fn_locals (object *args, object *env) {
(void) args;
return env;
}
object *fn_makunbound (object *args, object *env) {
(void) env;
object *var = first(args);
if (!symbolp(var)) error(MAKUNBOUND, notasymbol, var);
delassoc(var, &GlobalEnv);
return var;
}
object *fn_break (object *args, object *env) {
(void) args;
pfstring(PSTR("\nBreak!\n"), pserial);
BreakLevel++;
repl(env);
BreakLevel--;
return nil;
}
object *fn_read (object *args, object *env) {
(void) env;
gfun_t gfun = gstreamfun(args);
return read(gfun);
}
object *fn_prin1 (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
printobject(obj, pfun);
return obj;
}
object *fn_print (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
pln(pfun);
printobject(obj, pfun);
pfun(' ');
return obj;
}
object *fn_princ (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
prin1object(obj, pfun);
return obj;
}
object *fn_terpri (object *args, object *env) {
(void) env;
pfun_t pfun = pstreamfun(args);
pln(pfun);
return nil;
}
object *fn_readbyte (object *args, object *env) {
(void) env;
gfun_t gfun = gstreamfun(args);
int c = gfun();
return (c == -1) ? nil : number(c);
}
object *fn_readline (object *args, object *env) {
(void) env;
gfun_t gfun = gstreamfun(args);
return readstring('\n', gfun);
}
object *fn_writebyte (object *args, object *env) {
(void) env;
int value = checkinteger(WRITEBYTE, first(args));
pfun_t pfun = pstreamfun(cdr(args));
(pfun)(value);
return nil;
}
object *fn_writestring (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
char temp = Flags;
clrflag(PRINTREADABLY);
printstring(obj, pfun);
Flags = temp;
return nil;
}
object *fn_writeline (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
char temp = Flags;
clrflag(PRINTREADABLY);
printstring(obj, pfun);
pln(pfun);
Flags = temp;
return nil;
}
object *fn_restarti2c (object *args, object *env) {
(void) env;
int stream = first(args)->integer;
args = cdr(args);
int read = 0; // Write
I2CCount = 0;
if (args != NULL) {
object *rw = first(args);
if (integerp(rw)) I2CCount = rw->integer;
read = (rw != NULL);
}
int address = stream & 0xFF;
if (stream>>8 != I2CSTREAM) error2(RESTARTI2C, PSTR("not an i2c stream"));
TwoWire *port;
if (address < 128) port = &Wire;
#if defined(ULISP_I2C1)
else port = &Wire1;
#endif
return I2Crestart(port, address & 0x7F, read) ? tee : nil;
}
object *fn_gc (object *obj, object *env) {
int initial = Freespace;
unsigned long start = micros();
gc(obj, env);
unsigned long elapsed = micros() - start;
pfstring(PSTR("Space: "), pserial);
pint(Freespace - initial, pserial);
pfstring(PSTR(" bytes, Time: "), pserial);
pint(elapsed, pserial);
pfstring(PSTR(" us\n"), pserial);
return nil;
}
object *fn_room (object *args, object *env) {
(void) args, (void) env;
return number(Freespace);
}
object *fn_saveimage (object *args, object *env) {
if (args != NULL) args = eval(first(args), env);
return number(saveimage(args));
}
object *fn_loadimage (object *args, object *env) {
(void) env;
if (args != NULL) args = first(args);
return number(loadimage(args));
}
object *fn_cls (object *args, object *env) {
(void) args, (void) env;
pserial(12);
return nil;
}
// Arduino procedures
object *fn_pinmode (object *args, object *env) {
(void) env; int pin;
object *arg = first(args);
if (keywordp(arg)) pin = checkkeyword(NIL, arg);
else pin = checkinteger(PINMODE, first(args));
int pm = INPUT;
arg = second(args);
if (keywordp(arg)) pm = checkkeyword(PINMODE, arg);
else if (integerp(arg)) {
int mode = arg->integer;
if (mode == 1) pm = OUTPUT; else if (mode == 2) pm = INPUT_PULLUP;
#if defined(INPUT_PULLDOWN)
else if (mode == 4) pm = INPUT_PULLDOWN;
#endif
} else if (arg != nil) pm = OUTPUT;
pinMode(pin, pm);
return nil;
}
object *fn_digitalread (object *args, object *env) {
(void) env;
int pin = checkinteger(DIGITALREAD, first(args));
if (digitalRead(pin) != 0) return tee; else return nil;
}
object *fn_digitalwrite (object *args, object *env) {
(void) env;
int pin;
object *arg = first(args);
if (keywordp(arg)) pin = checkkeyword(NIL, arg);
else pin = checkinteger(DIGITALWRITE, arg);
arg = second(args);
int mode;
if (keywordp(arg)) mode = checkkeyword(DIGITALWRITE, arg);
else if (integerp(arg)) mode = arg->integer ? HIGH : LOW;
else mode = (arg != nil) ? HIGH : LOW;
digitalWrite(pin, mode);
return arg;
}
object *fn_analogread (object *args, object *env) {
(void) env;
int pin;
object *arg = first(args);
if (keywordp(arg)) pin = checkkeyword(ANALOGREAD, arg);
else {
pin = checkinteger(ANALOGREAD, arg);
checkanalogread(pin);
}
return number(analogRead(pin));
}
object *fn_analogreference (object *args, object *env) {
(void) env;
object *arg = first(args);
#if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
error2(ANALOGREFERENCE, PSTR("not supported"));
#else
analogReference((eAnalogReference)checkkeyword(ANALOGREFERENCE, arg));
#endif
return arg;
}
object *fn_analogreadresolution (object *args, object *env) {
(void) env;
object *arg = first(args);
#if defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
error2(ANALOGREADRESOLUTION, PSTR("not supported"));
#else
analogReadResolution(checkinteger(ANALOGREADRESOLUTION, arg));
#endif
return arg;
}
object *fn_analogwrite (object *args, object *env) {
(void) env;
int pin;
object *arg = first(args);
if (keywordp(arg)) pin = checkkeyword(NIL, arg);
else pin = checkinteger(ANALOGWRITE, arg);
checkanalogwrite(pin);
object *value = second(args);
analogWrite(pin, checkinteger(ANALOGWRITE, value));
return value;
}
object *fn_analogwriteresolution (object *args, object *env) {
(void) env;
object *arg = first(args);
analogWriteResolution(checkinteger(ANALOGWRITERESOLUTION, arg));
return arg;
}
object *fn_delay (object *args, object *env) {
(void) env;
object *arg1 = first(args);
delay(checkinteger(DELAY, arg1));
return arg1;
}
object *fn_millis (object *args, object *env) {
(void) args, (void) env;
return number(millis());
}
object *fn_sleep (object *args, object *env) {
(void) env;
object *arg1 = first(args);
sleep(checkinteger(SLEEP, arg1));
return arg1;
}
object *fn_note (object *args, object *env) {
(void) env;
static int pin = 255;
if (args != NULL) {
pin = checkinteger(NOTE, first(args));
int note = 0;
if (cddr(args) != NULL) note = checkinteger(NOTE, second(args));
int octave = 0;
if (cddr(args) != NULL) octave = checkinteger(NOTE, third(args));
playnote(pin, note, octave);
} else nonote(pin);
return nil;
}
object *fn_register (object *args, object *env) {
(void) env;
object *arg = first(args);
int addr;
if (keywordp(arg)) addr = checkkeyword(REGISTER, arg);
else addr = checkinteger(REGISTER, first(args));
if (cdr(args) == NULL) return number(*(uint32_t *)addr);
(*(uint32_t *)addr) = checkinteger(REGISTER, second(args));
return second(args);
}
// Tree Editor
object *fn_edit (object *args, object *env) {
object *fun = first(args);
object *pair = findvalue(fun, env);
clrflag(EXITEDITOR);
object *arg = edit(eval(fun, env));
cdr(pair) = arg;
return arg;
}
object *edit (object *fun) {
while (1) {
if (tstflag(EXITEDITOR)) return fun;
char c = gserial();
if (c == 'q') setflag(EXITEDITOR);
else if (c == 'b') return fun;
else if (c == 'r') fun = read(gserial);
else if (c == '\n') { pfl(pserial); superprint(fun, 0, pserial); pln(pserial); }
else if (c == 'c') fun = cons(read(gserial), fun);
else if (atom(fun)) pserial('!');
else if (c == 'd') fun = cons(car(fun), edit(cdr(fun)));
else if (c == 'a') fun = cons(edit(car(fun)), cdr(fun));
else if (c == 'x') fun = cdr(fun);
else pserial('?');
}
}
// Pretty printer
object *fn_pprint (object *args, object *env) {
(void) env;
object *obj = first(args);
pfun_t pfun = pstreamfun(cdr(args));
#if defined(gfxsupport)
if (pfun == gfxwrite) ppwidth = GFXPPWIDTH;
#endif
pln(pfun);
superprint(obj, 0, pfun);
ppwidth = PPWIDTH;
return bsymbol(NOTHING);
}
object *fn_pprintall (object *args, object *env) {
(void) env;
pfun_t pfun = pstreamfun(args);
#if defined(gfxsupport)
if (pfun == gfxwrite) ppwidth = GFXPPWIDTH;
#endif
object *globals = GlobalEnv;
while (globals != NULL) {
object *pair = first(globals);
object *var = car(pair);
object *val = cdr(pair);
pln(pfun);
if (consp(val) && symbolp(car(val)) && builtin(car(val)->name) == LAMBDA) {
superprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, pfun);
} else if (consp(val) && car(val)->type == CODE) {
superprint(cons(bsymbol(DEFCODE), cons(var, cdr(val))), 0, pfun);
} else {
superprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, pfun);
}
pln(pfun);
testescape();
globals = cdr(globals);
}
ppwidth = PPWIDTH;
return bsymbol(NOTHING);
}
// Format
void formaterr (object *formatstr, PGM_P string, uint8_t p) {
pln(pserial); indent(4, ' ', pserial); printstring(formatstr, pserial); pln(pserial);
indent(p+5, ' ', pserial); pserial('^');
error2(FORMAT, string);
pln(pserial);
GCStack = NULL;
longjmp(exception, 1);
}
object *fn_format (object *args, object *env) {
(void) env;
pfun_t pfun = pserial;
object *output = first(args);
object *obj;
if (output == nil) { obj = startstring(FORMAT); pfun = pstr; }
else if (output != tee) pfun = pstreamfun(args);
object *formatstr = checkstring(FORMAT, second(args));
object *save = NULL;
args = cddr(args);
int len = stringlength(formatstr);
uint8_t n = 0, width = 0, w, bra = 0;
char pad = ' ';
bool tilde = false, mute = false, comma, quote;
while (n < len) {
char ch = nthchar(formatstr, n);
char ch2 = ch & ~0x20; // force to upper case
if (tilde) {
if (ch == '}') {
if (save == NULL) formaterr(formatstr, PSTR("no matching ~{"), n);
if (args == NULL) { args = cdr(save); save = NULL; } else n = bra;
mute = false; tilde = false;
}
else if (!mute) {
if (comma && quote) { pad = ch; comma = false, quote = false; }
else if (ch == '\'') {
if (comma) quote = true;
else formaterr(formatstr, PSTR("quote not valid"), n);
}
else if (ch == '~') { pfun('~'); tilde = false; }
else if (ch >= '0' && ch <= '9') width = width*10 + ch - '0';
else if (ch == ',') comma = true;
else if (ch == '%') { pln(pfun); tilde = false; }
else if (ch == '&') { pfl(pfun); tilde = false; }
else if (ch == '^') {
if (save != NULL && args == NULL) mute = true;
tilde = false;
}
else if (ch == '{') {
if (save != NULL) formaterr(formatstr, PSTR("can't nest ~{"), n);
if (args == NULL) formaterr(formatstr, noargument, n);
if (!listp(first(args))) formaterr(formatstr, notalist, n);
save = args; args = first(args); bra = n; tilde = false;
if (args == NULL) mute = true;
}
else if (ch2 == 'A' || ch2 == 'S' || ch2 == 'D' || ch2 == 'G' || ch2 == 'X' || ch2 == 'B') {
if (args == NULL) formaterr(formatstr, noargument, n);
object *arg = first(args); args = cdr(args);
uint8_t aw = atomwidth(arg);
if (width < aw) w = 0; else w = width-aw;
tilde = false;
if (ch2 == 'A') { prin1object(arg, pfun); indent(w, pad, pfun); }
else if (ch2 == 'S') { printobject(arg, pfun); indent(w, pad, pfun); }
else if (ch2 == 'D' || ch2 == 'G') { indent(w, pad, pfun); prin1object(arg, pfun); }
else if (ch2 == 'X' || ch2 == 'B') {
if (integerp(arg)) {
uint8_t base = (ch2 == 'B') ? 2 : 16;
uint8_t hw = basewidth(arg, base); if (width < hw) w = 0; else w = width-hw;
indent(w, pad, pfun); pintbase(arg->integer, base, pfun);
} else {
indent(w, pad, pfun); prin1object(arg, pfun);
}
}
tilde = false;
} else formaterr(formatstr, PSTR("invalid directive"), n);
}
} else {
if (ch == '~') { tilde = true; pad = ' '; width = 0; comma = false; quote = false; }
else if (!mute) pfun(ch);
}
n++;
}
if (output == nil) return obj;
else return nil;
}
// LispLibrary
object *fn_require (object *args, object *env) {
object *arg = first(args);
object *globals = GlobalEnv;
if (!symbolp(arg)) error(REQUIRE, notasymbol, arg);
while (globals != NULL) {
object *pair = first(globals);
object *var = car(pair);
if (symbolp(var) && var == arg) return nil;
globals = cdr(globals);
}
GlobalStringIndex = 0;
object *line = read(glibrary);
while (line != NULL) {
// Is this the definition we want
symbol_t fname = first(line)->name;
if ((fname == sym(DEFUN) || fname == sym(DEFVAR)) && symbolp(second(line)) && second(line)->name == arg->name) {
eval(line, env);
return tee;
}
line = read(glibrary);
}
return nil;
}
object *fn_listlibrary (object *args, object *env) {
(void) args, (void) env;
GlobalStringIndex = 0;
object *line = read(glibrary);
while (line != NULL) {
builtin_t bname = builtin(first(line)->name);
if (bname == DEFUN || bname == DEFVAR) {
printsymbol(second(line), pserial); pserial(' ');
}
line = read(glibrary);
}
return bsymbol(NOTHING);
}
// Graphics functions
object *fn_drawpixel (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t colour = COLOR_WHITE;
if (cddr(args) != NULL) colour = checkinteger(DRAWPIXEL, third(args));
tft.drawPixel(checkinteger(DRAWPIXEL, first(args)), checkinteger(DRAWPIXEL, second(args)), colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawline (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[4], colour = COLOR_WHITE;
for (int i=0; i<4; i++) { params[i] = checkinteger(DRAWLINE, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(DRAWLINE, car(args));
tft.drawLine(params[0], params[1], params[2], params[3], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawrect (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[4], colour = COLOR_WHITE;
for (int i=0; i<4; i++) { params[i] = checkinteger(DRAWRECT, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(DRAWRECT, car(args));
tft.drawRect(params[0], params[1], params[2], params[3], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_fillrect (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[4], colour = COLOR_WHITE;
for (int i=0; i<4; i++) { params[i] = checkinteger(FILLRECT, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(FILLRECT, car(args));
tft.fillRect(params[0], params[1], params[2], params[3], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawcircle (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[3], colour = COLOR_WHITE;
for (int i=0; i<3; i++) { params[i] = checkinteger(DRAWCIRCLE, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(DRAWCIRCLE, car(args));
tft.drawCircle(params[0], params[1], params[2], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_fillcircle (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[3], colour = COLOR_WHITE;
for (int i=0; i<3; i++) { params[i] = checkinteger(FILLCIRCLE, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(FILLCIRCLE, car(args));
tft.fillCircle(params[0], params[1], params[2], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawroundrect (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[5], colour = COLOR_WHITE;
for (int i=0; i<5; i++) { params[i] = checkinteger(DRAWROUNDRECT, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(DRAWROUNDRECT, car(args));
tft.drawRoundRect(params[0], params[1], params[2], params[3], params[4], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_fillroundrect (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[5], colour = COLOR_WHITE;
for (int i=0; i<5; i++) { params[i] = checkinteger(FILLROUNDRECT, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(FILLROUNDRECT, car(args));
tft.fillRoundRect(params[0], params[1], params[2], params[3], params[4], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawtriangle (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[6], colour = COLOR_WHITE;
for (int i=0; i<6; i++) { params[i] = checkinteger(DRAWTRIANGLE, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(DRAWTRIANGLE, car(args));
tft.drawTriangle(params[0], params[1], params[2], params[3], params[4], params[5], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_filltriangle (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t params[6], colour = COLOR_WHITE;
for (int i=0; i<6; i++) { params[i] = checkinteger(FILLTRIANGLE, car(args)); args = cdr(args); }
if (args != NULL) colour = checkinteger(FILLTRIANGLE, car(args));
tft.fillTriangle(params[0], params[1], params[2], params[3], params[4], params[5], colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_drawchar (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t colour = COLOR_WHITE, bg = COLOR_BLACK, size = 1;
object *more = cdr(cddr(args));
if (more != NULL) {
colour = checkinteger(DRAWCHAR, car(more));
more = cdr(more);
if (more != NULL) {
bg = checkinteger(DRAWCHAR, car(more));
more = cdr(more);
if (more != NULL) size = checkinteger(DRAWCHAR, car(more));
}
}
tft.drawChar(checkinteger(DRAWCHAR, first(args)), checkinteger(DRAWCHAR, second(args)), checkchar(DRAWCHAR, third(args)),
colour, bg, size);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_setcursor (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
tft.setCursor(checkinteger(SETCURSOR, first(args)), checkinteger(SETCURSOR, second(args)));
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_settextcolor (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
if (cdr(args) != NULL) tft.setTextColor(checkinteger(SETTEXTCOLOR, first(args)), checkinteger(SETTEXTCOLOR, second(args)));
else tft.setTextColor(checkinteger(SETTEXTCOLOR, first(args)));
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_settextsize (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
tft.setTextSize(checkinteger(SETTEXTSIZE, first(args)));
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_settextwrap (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
tft.setTextWrap(first(args) != NULL);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_fillscreen (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
uint16_t colour = COLOR_BLACK;
if (args != NULL) colour = checkinteger(FILLSCREEN, first(args));
tft.fillScreen(colour);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_setrotation (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
tft.setRotation(checkinteger(SETROTATION, first(args)));
tft.refresh();
#else
(void) args;
#endif
return nil;
}
object *fn_invertdisplay (object *args, object *env) {
(void) env;
#if defined(gfxsupport)
tft.invertDisplay(first(args) != NULL);
tft.refresh();
#else
(void) args;
#endif
return nil;
}
// Insert your own function definitions here
// Built-in symbol names
const char string0[] PROGMEM = "nil";
const char string1[] PROGMEM = "t";
const char string2[] PROGMEM = "nothing";
const char string3[] PROGMEM = "&optional";
const char string4[] PROGMEM = ":initial-element";
const char string5[] PROGMEM = ":element-type";
const char string6[] PROGMEM = "bit";
const char string7[] PROGMEM = "&rest";
const char string8[] PROGMEM = "lambda";
const char string9[] PROGMEM = "let";
const char string10[] PROGMEM = "let*";
const char string11[] PROGMEM = "closure";
const char string12[] PROGMEM = "*pc*";
const char string13[] PROGMEM = "";
const char string14[] PROGMEM = "quote";
const char string15[] PROGMEM = "or";
const char string16[] PROGMEM = "defun";
const char string17[] PROGMEM = "defvar";
const char string18[] PROGMEM = "setq";
const char string19[] PROGMEM = "loop";
const char string20[] PROGMEM = "return";
const char string21[] PROGMEM = "push";
const char string22[] PROGMEM = "pop";
const char string23[] PROGMEM = "incf";
const char string24[] PROGMEM = "decf";
const char string25[] PROGMEM = "setf";
const char string26[] PROGMEM = "dolist";
const char string27[] PROGMEM = "dotimes";
const char string28[] PROGMEM = "trace";
const char string29[] PROGMEM = "untrace";
const char string30[] PROGMEM = "for-millis";
const char string31[] PROGMEM = "time";
const char string32[] PROGMEM = "with-output-to-string";
const char string33[] PROGMEM = "with-serial";
const char string34[] PROGMEM = "with-i2c";
const char string35[] PROGMEM = "with-spi";
const char string36[] PROGMEM = "with-sd-card";
const char string37[] PROGMEM = "with-gfx";
const char string38[] PROGMEM = "defcode";
const char string39[] PROGMEM = "";
const char string40[] PROGMEM = "progn";
const char string41[] PROGMEM = "if";
const char string42[] PROGMEM = "cond";
const char string43[] PROGMEM = "when";
const char string44[] PROGMEM = "unless";
const char string45[] PROGMEM = "case";
const char string46[] PROGMEM = "and";
const char string47[] PROGMEM = "";
const char string48[] PROGMEM = "not";
const char string49[] PROGMEM = "null";
const char string50[] PROGMEM = "cons";
const char string51[] PROGMEM = "atom";
const char string52[] PROGMEM = "listp";
const char string53[] PROGMEM = "consp";
const char string54[] PROGMEM = "symbolp";
const char string55[] PROGMEM = "arrayp";
const char string56[] PROGMEM = "boundp";
const char string57[] PROGMEM = "set";
const char string58[] PROGMEM = "streamp";
const char string59[] PROGMEM = "eq";
const char string60[] PROGMEM = "car";
const char string61[] PROGMEM = "first";
const char string62[] PROGMEM = "cdr";
const char string63[] PROGMEM = "rest";
const char string64[] PROGMEM = "caar";
const char string65[] PROGMEM = "cadr";
const char string66[] PROGMEM = "second";
const char string67[] PROGMEM = "cdar";
const char string68[] PROGMEM = "cddr";
const char string69[] PROGMEM = "caaar";
const char string70[] PROGMEM = "caadr";
const char string71[] PROGMEM = "cadar";
const char string72[] PROGMEM = "caddr";
const char string73[] PROGMEM = "third";
const char string74[] PROGMEM = "cdaar";
const char string75[] PROGMEM = "cdadr";
const char string76[] PROGMEM = "cddar";
const char string77[] PROGMEM = "cdddr";
const char string78[] PROGMEM = "length";
const char string79[] PROGMEM = "array-dimensions";
const char string80[] PROGMEM = "list";
const char string81[] PROGMEM = "make-array";
const char string82[] PROGMEM = "reverse";
const char string83[] PROGMEM = "nth";
const char string84[] PROGMEM = "aref";
const char string85[] PROGMEM = "assoc";
const char string86[] PROGMEM = "member";
const char string87[] PROGMEM = "apply";
const char string88[] PROGMEM = "funcall";
const char string89[] PROGMEM = "append";
const char string90[] PROGMEM = "mapc";
const char string91[] PROGMEM = "mapcar";
const char string92[] PROGMEM = "mapcan";
const char string93[] PROGMEM = "+";
const char string94[] PROGMEM = "-";
const char string95[] PROGMEM = "*";
const char string96[] PROGMEM = "/";
const char string97[] PROGMEM = "mod";
const char string98[] PROGMEM = "1+";
const char string99[] PROGMEM = "1-";
const char string100[] PROGMEM = "abs";
const char string101[] PROGMEM = "random";
const char string102[] PROGMEM = "max";
const char string103[] PROGMEM = "min";
const char string104[] PROGMEM = "/=";
const char string105[] PROGMEM = "=";
const char string106[] PROGMEM = "<";
const char string107[] PROGMEM = "<=";
const char string108[] PROGMEM = ">";
const char string109[] PROGMEM = ">=";
const char string110[] PROGMEM = "plusp";
const char string111[] PROGMEM = "minusp";
const char string112[] PROGMEM = "zerop";
const char string113[] PROGMEM = "oddp";
const char string114[] PROGMEM = "evenp";
const char string115[] PROGMEM = "integerp";
const char string116[] PROGMEM = "numberp";
const char string117[] PROGMEM = "float";
const char string118[] PROGMEM = "floatp";
const char string119[] PROGMEM = "sin";
const char string120[] PROGMEM = "cos";
const char string121[] PROGMEM = "tan";
const char string122[] PROGMEM = "asin";
const char string123[] PROGMEM = "acos";
const char string124[] PROGMEM = "atan";
const char string125[] PROGMEM = "sinh";
const char string126[] PROGMEM = "cosh";
const char string127[] PROGMEM = "tanh";
const char string128[] PROGMEM = "exp";
const char string129[] PROGMEM = "sqrt";
const char string130[] PROGMEM = "log";
const char string131[] PROGMEM = "expt";
const char string132[] PROGMEM = "ceiling";
const char string133[] PROGMEM = "floor";
const char string134[] PROGMEM = "truncate";
const char string135[] PROGMEM = "round";
const char string136[] PROGMEM = "char";
const char string137[] PROGMEM = "char-code";
const char string138[] PROGMEM = "code-char";
const char string139[] PROGMEM = "characterp";
const char string140[] PROGMEM = "stringp";
const char string141[] PROGMEM = "string=";
const char string142[] PROGMEM = "string<";
const char string143[] PROGMEM = "string>";
const char string144[] PROGMEM = "sort";
const char string145[] PROGMEM = "string";
const char string146[] PROGMEM = "concatenate";
const char string147[] PROGMEM = "subseq";
const char string148[] PROGMEM = "read-from-string";
const char string149[] PROGMEM = "princ-to-string";
const char string150[] PROGMEM = "prin1-to-string";
const char string151[] PROGMEM = "logand";
const char string152[] PROGMEM = "logior";
const char string153[] PROGMEM = "logxor";
const char string154[] PROGMEM = "lognot";
const char string155[] PROGMEM = "ash";
const char string156[] PROGMEM = "logbitp";
const char string157[] PROGMEM = "eval";
const char string158[] PROGMEM = "globals";
const char string159[] PROGMEM = "locals";
const char string160[] PROGMEM = "makunbound";
const char string161[] PROGMEM = "break";
const char string162[] PROGMEM = "read";
const char string163[] PROGMEM = "prin1";
const char string164[] PROGMEM = "print";
const char string165[] PROGMEM = "princ";
const char string166[] PROGMEM = "terpri";
const char string167[] PROGMEM = "read-byte";
const char string168[] PROGMEM = "read-line";
const char string169[] PROGMEM = "write-byte";
const char string170[] PROGMEM = "write-string";
const char string171[] PROGMEM = "write-line";
const char string172[] PROGMEM = "restart-i2c";
const char string173[] PROGMEM = "gc";
const char string174[] PROGMEM = "room";
const char string175[] PROGMEM = "save-image";
const char string176[] PROGMEM = "load-image";
const char string177[] PROGMEM = "cls";
const char string178[] PROGMEM = "pinmode";
const char string179[] PROGMEM = "digitalread";
const char string180[] PROGMEM = "digitalwrite";
const char string181[] PROGMEM = "analogread";
const char string182[] PROGMEM = "analogreference";
const char string183[] PROGMEM = "analogreadresolution";
const char string184[] PROGMEM = "analogwrite";
const char string185[] PROGMEM = "analogwriteresolution";
const char string186[] PROGMEM = "delay";
const char string187[] PROGMEM = "millis";
const char string188[] PROGMEM = "sleep";
const char string189[] PROGMEM = "note";
const char string190[] PROGMEM = "register";
const char string191[] PROGMEM = "edit";
const char string192[] PROGMEM = "pprint";
const char string193[] PROGMEM = "pprintall";
const char string194[] PROGMEM = "format";
const char string195[] PROGMEM = "require";
const char string196[] PROGMEM = "list-library";
const char string197[] PROGMEM = "draw-pixel";
const char string198[] PROGMEM = "draw-line";
const char string199[] PROGMEM = "draw-rect";
const char string200[] PROGMEM = "fill-rect";
const char string201[] PROGMEM = "draw-circle";
const char string202[] PROGMEM = "fill-circle";
const char string203[] PROGMEM = "draw-round-rect";
const char string204[] PROGMEM = "fill-round-rect";
const char string205[] PROGMEM = "draw-triangle";
const char string206[] PROGMEM = "fill-triangle";
const char string207[] PROGMEM = "draw-char";
const char string208[] PROGMEM = "set-cursor";
const char string209[] PROGMEM = "set-text-color";
const char string210[] PROGMEM = "set-text-size";
const char string211[] PROGMEM = "set-text-wrap";
const char string212[] PROGMEM = "fill-screen";
const char string213[] PROGMEM = "set-rotation";
const char string214[] PROGMEM = "invert-display";
const char string215[] PROGMEM = "";
const char string216[] PROGMEM = ":led-builtin";
const char string217[] PROGMEM = ":high";
const char string218[] PROGMEM = ":low";
#if defined(CPU_ATSAMD21)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":ar-default";
const char string224[] PROGMEM = ":ar-internal1v0";
const char string225[] PROGMEM = ":ar-internal1v65";
const char string226[] PROGMEM = ":ar-internal2v23";
const char string227[] PROGMEM = ":ar-external";
const char string228[] PROGMEM = ":pa-dir";
const char string229[] PROGMEM = ":pa-dirclr";
const char string230[] PROGMEM = ":pa-dirset";
const char string231[] PROGMEM = ":pa-dirtgl";
const char string232[] PROGMEM = ":pa-out";
const char string233[] PROGMEM = ":pa-outclr";
const char string234[] PROGMEM = ":pa-outset";
const char string235[] PROGMEM = ":pa-outtgl";
const char string236[] PROGMEM = ":pa-in";
const char string237[] PROGMEM = ":pb-dir";
const char string238[] PROGMEM = ":pb-dirclr";
const char string239[] PROGMEM = ":pb-dirset";
const char string240[] PROGMEM = ":pb-dirtgl";
const char string241[] PROGMEM = ":pb-out";
const char string242[] PROGMEM = ":pb-outclr";
const char string243[] PROGMEM = ":pb-outset";
const char string244[] PROGMEM = ":pb-outtgl";
const char string245[] PROGMEM = ":pb-in";
const char string246[] PROGMEM = "";
#elif defined(CPU_ATSAMD51)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":ar-default";
const char string224[] PROGMEM = ":ar-internal1v0";
const char string225[] PROGMEM = ":ar-internal1v1";
const char string226[] PROGMEM = ":ar-internal1v2";
const char string227[] PROGMEM = ":ar-internal1v25";
const char string228[] PROGMEM = ":ar-internal1v65";
const char string229[] PROGMEM = ":ar-internal2v0";
const char string230[] PROGMEM = ":ar-internal2v2";
const char string231[] PROGMEM = ":ar-internal2v23";
const char string232[] PROGMEM = ":ar-internal2v4";
const char string233[] PROGMEM = ":ar-internal2v5";
const char string234[] PROGMEM = ":ar-external";
const char string235[] PROGMEM = ":pa-dir";
const char string236[] PROGMEM = ":pa-dirclr";
const char string237[] PROGMEM = ":pa-dirset";
const char string238[] PROGMEM = ":pa-dirtgl";
const char string239[] PROGMEM = ":pa-out";
const char string240[] PROGMEM = ":pa-outclr";
const char string241[] PROGMEM = ":pa-outset";
const char string242[] PROGMEM = ":pa-outtgl";
const char string243[] PROGMEM = ":pa-in";
const char string244[] PROGMEM = ":pb-dir";
const char string245[] PROGMEM = ":pb-dirclr";
const char string246[] PROGMEM = ":pb-dirset";
const char string247[] PROGMEM = ":pb-dirtgl";
const char string248[] PROGMEM = ":pb-out";
const char string249[] PROGMEM = ":pb-outclr";
const char string250[] PROGMEM = ":pb-outset";
const char string251[] PROGMEM = ":pb-outtgl";
const char string252[] PROGMEM = ":pb-in";
const char string253[] PROGMEM = "";
#elif defined(CPU_NRF51822)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":ar-default";
const char string224[] PROGMEM = ":ar-vbg";
const char string225[] PROGMEM = ":ar-supply-one-half";
const char string226[] PROGMEM = ":ar-supply-one-third";
const char string227[] PROGMEM = ":ar-ext0";
const char string228[] PROGMEM = ":ar-ext1";
const char string229[] PROGMEM = ":p0-out";
const char string230[] PROGMEM = ":p0-outset";
const char string231[] PROGMEM = ":p0-outclr";
const char string232[] PROGMEM = ":p0-in";
const char string233[] PROGMEM = ":p0-dir";
const char string234[] PROGMEM = ":p0-dirset";
const char string235[] PROGMEM = ":p0-dirclr";
const char string236[] PROGMEM = "";
#elif defined(CPU_NRF52840)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":ar-default";
const char string224[] PROGMEM = ":ar-internal";
const char string225[] PROGMEM = ":ar-internal-3-0";
const char string226[] PROGMEM = ":ar-internal-2-4";
const char string227[] PROGMEM = ":ar-internal-1-8";
const char string228[] PROGMEM = ":ar-internal-1-2";
const char string229[] PROGMEM = ":ar-vdd4";
const char string230[] PROGMEM = ":p0-out";
const char string231[] PROGMEM = ":p0-outset";
const char string232[] PROGMEM = ":p0-outclr";
const char string233[] PROGMEM = ":p0-in";
const char string234[] PROGMEM = ":p0-dir";
const char string235[] PROGMEM = ":p0-dirset";
const char string236[] PROGMEM = ":p0-dirclr";
const char string237[] PROGMEM = ":p1-out";
const char string238[] PROGMEM = ":p1-outset";
const char string239[] PROGMEM = ":p1-outclr";
const char string240[] PROGMEM = ":p1-in";
const char string241[] PROGMEM = ":p1-dir";
const char string242[] PROGMEM = ":p1-dirset";
const char string243[] PROGMEM = ":p1-dirclr";
const char string244[] PROGMEM = "";
#elif defined(CPU_NRF52833)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":ar-default";
const char string224[] PROGMEM = ":ar-internal";
const char string225[] PROGMEM = ":ar-vdd4";
const char string226[] PROGMEM = ":p0-out";
const char string227[] PROGMEM = ":p0-outset";
const char string228[] PROGMEM = ":p0-outclr";
const char string229[] PROGMEM = ":p0-in";
const char string230[] PROGMEM = ":p0-dir";
const char string231[] PROGMEM = ":p0-dirset";
const char string232[] PROGMEM = ":p0-dirclr";
const char string233[] PROGMEM = ":p1-out";
const char string234[] PROGMEM = ":p1-outset";
const char string235[] PROGMEM = ":p1-outclr";
const char string236[] PROGMEM = ":p1-in";
const char string237[] PROGMEM = ":p1-dir";
const char string238[] PROGMEM = ":p1-dirset";
const char string239[] PROGMEM = ":p1-dirclr";
const char string240[] PROGMEM = "";
#elif defined(CPU_iMXRT1062)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":output-opendrain";
const char string224[] PROGMEM = "";
#elif defined(CPU_MAX32620)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":output";
const char string222[] PROGMEM = ":default";
const char string223[] PROGMEM = ":external";
const char string224[] PROGMEM = "";
#elif defined(CPU_RP2040)
const char string219[] PROGMEM = ":input";
const char string220[] PROGMEM = ":input-pullup";
const char string221[] PROGMEM = ":input-pulldown";
const char string222[] PROGMEM = ":output";
const char string223[] PROGMEM = ":gpio-in";
const char string224[] PROGMEM = ":gpio-out";
const char string225[] PROGMEM = ":gpio-out-set";
const char string226[] PROGMEM = ":gpio-out-clr";
const char string227[] PROGMEM = ":gpio-out-xor";
const char string228[] PROGMEM = ":gpio-oe";
const char string229[] PROGMEM = ":gpio-oe-set";
const char string230[] PROGMEM = ":gpio-oe-clr";
const char string231[] PROGMEM = ":gpio-oe-xor";
const char string232[] PROGMEM = "";
#endif
// Insert your own function names here
// Built-in symbol lookup table
const tbl_entry_t lookup_table[] PROGMEM = {
{ string0, NULL, 0x00 },
{ string1, NULL, 0x00 },
{ string2, NULL, 0x00 },
{ string3, NULL, 0x00 },
{ string4, NULL, 0x00 },
{ string5, NULL, 0x00 },
{ string6, NULL, 0x00 },
{ string7, NULL, 0x00 },
{ string8, NULL, 0x0F },
{ string9, NULL, 0x0F },
{ string10, NULL, 0x0F },
{ string11, NULL, 0x0F },
{ string12, NULL, 0x0F },
{ string13, NULL, 0x00 },
{ string14, sp_quote, 0x11 },
{ string15, sp_or, 0x0F },
{ string16, sp_defun, 0x2F },
{ string17, sp_defvar, 0x13 },
{ string18, sp_setq, 0x2F },
{ string19, sp_loop, 0x0F },
{ string20, sp_return, 0x0F },
{ string21, sp_push, 0x22 },
{ string22, sp_pop, 0x11 },
{ string23, sp_incf, 0x12 },
{ string24, sp_decf, 0x12 },
{ string25, sp_setf, 0x2F },
{ string26, sp_dolist, 0x1F },
{ string27, sp_dotimes, 0x1F },
{ string28, sp_trace, 0x01 },
{ string29, sp_untrace, 0x01 },
{ string30, sp_formillis, 0x1F },
{ string31, sp_time, 0x11 },
{ string32, sp_withoutputtostring, 0x1F },
{ string33, sp_withserial, 0x1F },
{ string34, sp_withi2c, 0x1F },
{ string35, sp_withspi, 0x1F },
{ string36, sp_withsdcard, 0x2F },
{ string37, sp_withgfx, 0x1F },
{ string38, sp_defcode, 0x0F },
{ string39, NULL, 0x00 },
{ string40, tf_progn, 0x0F },
{ string41, tf_if, 0x23 },
{ string42, tf_cond, 0x0F },
{ string43, tf_when, 0x1F },
{ string44, tf_unless, 0x1F },
{ string45, tf_case, 0x1F },
{ string46, tf_and, 0x0F },
{ string47, NULL, 0x00 },
{ string48, fn_not, 0x11 },
{ string49, fn_not, 0x11 },
{ string50, fn_cons, 0x22 },
{ string51, fn_atom, 0x11 },
{ string52, fn_listp, 0x11 },
{ string53, fn_consp, 0x11 },
{ string54, fn_symbolp, 0x11 },
{ string55, fn_arrayp, 0x11 },
{ string56, fn_boundp, 0x11 },
{ string57, fn_setfn, 0x2F },
{ string58, fn_streamp, 0x11 },
{ string59, fn_eq, 0x22 },
{ string60, fn_car, 0x11 },
{ string61, fn_car, 0x11 },
{ string62, fn_cdr, 0x11 },
{ string63, fn_cdr, 0x11 },
{ string64, fn_caar, 0x11 },
{ string65, fn_cadr, 0x11 },
{ string66, fn_cadr, 0x11 },
{ string67, fn_cdar, 0x11 },
{ string68, fn_cddr, 0x11 },
{ string69, fn_caaar, 0x11 },
{ string70, fn_caadr, 0x11 },
{ string71, fn_cadar, 0x11 },
{ string72, fn_caddr, 0x11 },
{ string73, fn_caddr, 0x11 },
{ string74, fn_cdaar, 0x11 },
{ string75, fn_cdadr, 0x11 },
{ string76, fn_cddar, 0x11 },
{ string77, fn_cdddr, 0x11 },
{ string78, fn_length, 0x11 },
{ string79, fn_arraydimensions, 0x11 },
{ string80, fn_list, 0x0F },
{ string81, fn_makearray, 0x15 },
{ string82, fn_reverse, 0x11 },
{ string83, fn_nth, 0x22 },
{ string84, fn_areff, 0x2F },
{ string85, fn_assoc, 0x22 },
{ string86, fn_member, 0x22 },
{ string87, fn_apply, 0x2F },
{ string88, fn_funcall, 0x1F },
{ string89, fn_append, 0x0F },
{ string90, fn_mapc, 0x2F },
{ string91, fn_mapcar, 0x2F },
{ string92, fn_mapcan, 0x2F },
{ string93, fn_add, 0x0F },
{ string94, fn_subtract, 0x1F },
{ string95, fn_multiply, 0x0F },
{ string96, fn_divide, 0x1F },
{ string97, fn_mod, 0x22 },
{ string98, fn_oneplus, 0x11 },
{ string99, fn_oneminus, 0x11 },
{ string100, fn_abs, 0x11 },
{ string101, fn_random, 0x11 },
{ string102, fn_maxfn, 0x1F },
{ string103, fn_minfn, 0x1F },
{ string104, fn_noteq, 0x1F },
{ string105, fn_numeq, 0x1F },
{ string106, fn_less, 0x1F },
{ string107, fn_lesseq, 0x1F },
{ string108, fn_greater, 0x1F },
{ string109, fn_greatereq, 0x1F },
{ string110, fn_plusp, 0x11 },
{ string111, fn_minusp, 0x11 },
{ string112, fn_zerop, 0x11 },
{ string113, fn_oddp, 0x11 },
{ string114, fn_evenp, 0x11 },
{ string115, fn_integerp, 0x11 },
{ string116, fn_numberp, 0x11 },
{ string117, fn_floatfn, 0x11 },
{ string118, fn_floatp, 0x11 },
{ string119, fn_sin, 0x11 },
{ string120, fn_cos, 0x11 },
{ string121, fn_tan, 0x11 },
{ string122, fn_asin, 0x11 },
{ string123, fn_acos, 0x11 },
{ string124, fn_atan, 0x12 },
{ string125, fn_sinh, 0x11 },
{ string126, fn_cosh, 0x11 },
{ string127, fn_tanh, 0x11 },
{ string128, fn_exp, 0x11 },
{ string129, fn_sqrt, 0x11 },
{ string130, fn_log, 0x12 },
{ string131, fn_expt, 0x22 },
{ string132, fn_ceiling, 0x12 },
{ string133, fn_floor, 0x12 },
{ string134, fn_truncate, 0x12 },
{ string135, fn_round, 0x12 },
{ string136, fn_char, 0x22 },
{ string137, fn_charcode, 0x11 },
{ string138, fn_codechar, 0x11 },
{ string139, fn_characterp, 0x11 },
{ string140, fn_stringp, 0x11 },
{ string141, fn_stringeq, 0x22 },
{ string142, fn_stringless, 0x22 },
{ string143, fn_stringgreater, 0x22 },
{ string144, fn_sort, 0x22 },
{ string145, fn_stringfn, 0x11 },
{ string146, fn_concatenate, 0x1F },
{ string147, fn_subseq, 0x23 },
{ string148, fn_readfromstring, 0x11 },
{ string149, fn_princtostring, 0x11 },
{ string150, fn_prin1tostring, 0x11 },
{ string151, fn_logand, 0x0F },
{ string152, fn_logior, 0x0F },
{ string153, fn_logxor, 0x0F },
{ string154, fn_lognot, 0x11 },
{ string155, fn_ash, 0x22 },
{ string156, fn_logbitp, 0x22 },
{ string157, fn_eval, 0x11 },
{ string158, fn_globals, 0x00 },
{ string159, fn_locals, 0x00 },
{ string160, fn_makunbound, 0x11 },
{ string161, fn_break, 0x00 },
{ string162, fn_read, 0x01 },
{ string163, fn_prin1, 0x12 },
{ string164, fn_print, 0x12 },
{ string165, fn_princ, 0x12 },
{ string166, fn_terpri, 0x01 },
{ string167, fn_readbyte, 0x02 },
{ string168, fn_readline, 0x01 },
{ string169, fn_writebyte, 0x12 },
{ string170, fn_writestring, 0x12 },
{ string171, fn_writeline, 0x12 },
{ string172, fn_restarti2c, 0x12 },
{ string173, fn_gc, 0x00 },
{ string174, fn_room, 0x00 },
{ string175, fn_saveimage, 0x01 },
{ string176, fn_loadimage, 0x01 },
{ string177, fn_cls, 0x00 },
{ string178, fn_pinmode, 0x22 },
{ string179, fn_digitalread, 0x11 },
{ string180, fn_digitalwrite, 0x22 },
{ string181, fn_analogread, 0x11 },
{ string182, fn_analogreference, 0x11 },
{ string183, fn_analogreadresolution, 0x11 },
{ string184, fn_analogwrite, 0x22 },
{ string185, fn_analogwriteresolution, 0x11 },
{ string186, fn_delay, 0x11 },
{ string187, fn_millis, 0x00 },
{ string188, fn_sleep, 0x11 },
{ string189, fn_note, 0x03 },
{ string190, fn_register, 0x12 },
{ string191, fn_edit, 0x11 },
{ string192, fn_pprint, 0x12 },
{ string193, fn_pprintall, 0x01 },
{ string194, fn_format, 0x2F },
{ string195, fn_require, 0x11 },
{ string196, fn_listlibrary, 0x00 },
{ string197, fn_drawpixel, 0x23 },
{ string198, fn_drawline, 0x45 },
{ string199, fn_drawrect, 0x45 },
{ string200, fn_fillrect, 0x45 },
{ string201, fn_drawcircle, 0x34 },
{ string202, fn_fillcircle, 0x34 },
{ string203, fn_drawroundrect, 0x56 },
{ string204, fn_fillroundrect, 0x56 },
{ string205, fn_drawtriangle, 0x67 },
{ string206, fn_filltriangle, 0x67 },
{ string207, fn_drawchar, 0x36 },
{ string208, fn_setcursor, 0x22 },
{ string209, fn_settextcolor, 0x12 },
{ string210, fn_settextsize, 0x11 },
{ string211, fn_settextwrap, 0x11 },
{ string212, fn_fillscreen, 0x01 },
{ string213, fn_setrotation, 0x11 },
{ string214, fn_invertdisplay, 0x11 },
{ string215, NULL, 0x00 },
{ string216, (fn_ptr_type)LED_BUILTIN, 0 },
{ string217, (fn_ptr_type)HIGH, DIGITALWRITE },
{ string218, (fn_ptr_type)LOW, DIGITALWRITE },
#if defined(CPU_ATSAMD21)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)AR_DEFAULT, ANALOGREFERENCE },
{ string224, (fn_ptr_type)AR_INTERNAL1V0, ANALOGREFERENCE },
{ string225, (fn_ptr_type)AR_INTERNAL1V65, ANALOGREFERENCE },
{ string226, (fn_ptr_type)AR_INTERNAL2V23, ANALOGREFERENCE },
{ string227, (fn_ptr_type)AR_EXTERNAL, ANALOGREFERENCE },
{ string228, (fn_ptr_type)&PORT->Group[0].DIR.reg, REGISTER },
{ string229, (fn_ptr_type)&PORT->Group[0].DIRCLR.reg, REGISTER },
{ string230, (fn_ptr_type)&PORT->Group[0].DIRSET.reg, REGISTER },
{ string231, (fn_ptr_type)&PORT->Group[0].DIRTGL.reg, REGISTER },
{ string232, (fn_ptr_type)&PORT->Group[0].OUT.reg, REGISTER },
{ string233, (fn_ptr_type)&PORT->Group[0].OUTCLR.reg, REGISTER },
{ string234, (fn_ptr_type)&PORT->Group[0].OUTSET.reg, REGISTER },
{ string235, (fn_ptr_type)&PORT->Group[0].OUTTGL.reg, REGISTER },
{ string236, (fn_ptr_type)&PORT->Group[0].IN.reg, REGISTER },
{ string237, (fn_ptr_type)&PORT->Group[1].DIR.reg, REGISTER },
{ string238, (fn_ptr_type)&PORT->Group[1].DIRCLR.reg, REGISTER },
{ string239, (fn_ptr_type)&PORT->Group[1].DIRSET.reg, REGISTER },
{ string240, (fn_ptr_type)&PORT->Group[1].DIRTGL.reg, REGISTER },
{ string241, (fn_ptr_type)&PORT->Group[1].OUT.reg, REGISTER },
{ string242, (fn_ptr_type)&PORT->Group[1].OUTCLR.reg, REGISTER },
{ string243, (fn_ptr_type)&PORT->Group[1].OUTSET.reg, REGISTER },
{ string244, (fn_ptr_type)&PORT->Group[1].OUTTGL.reg, REGISTER },
{ string245, (fn_ptr_type)&PORT->Group[1].IN.reg, REGISTER },
{ string246, NULL, 0x00 },
#elif defined(CPU_ATSAMD51)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)AR_DEFAULT, ANALOGREFERENCE },
{ string224, (fn_ptr_type)AR_INTERNAL1V0, ANALOGREFERENCE },
{ string225, (fn_ptr_type)AR_INTERNAL1V1, ANALOGREFERENCE },
{ string226, (fn_ptr_type)AR_INTERNAL1V2, ANALOGREFERENCE },
{ string227, (fn_ptr_type)AR_INTERNAL1V25, ANALOGREFERENCE },
{ string228, (fn_ptr_type)AR_INTERNAL1V65, ANALOGREFERENCE },
{ string229, (fn_ptr_type)AR_INTERNAL2V0, ANALOGREFERENCE },
{ string230, (fn_ptr_type)AR_INTERNAL2V2, ANALOGREFERENCE },
{ string231, (fn_ptr_type)AR_INTERNAL2V23, ANALOGREFERENCE },
{ string232, (fn_ptr_type)AR_INTERNAL2V4, ANALOGREFERENCE },
{ string233, (fn_ptr_type)AR_INTERNAL2V5, ANALOGREFERENCE },
{ string234, (fn_ptr_type)AR_EXTERNAL, ANALOGREFERENCE },
{ string235, (fn_ptr_type)&PORT->Group[0].DIR.reg, REGISTER },
{ string236, (fn_ptr_type)&PORT->Group[0].DIRCLR.reg, REGISTER },
{ string237, (fn_ptr_type)&PORT->Group[0].DIRSET.reg, REGISTER },
{ string238, (fn_ptr_type)&PORT->Group[0].DIRTGL.reg, REGISTER },
{ string239, (fn_ptr_type)&PORT->Group[0].OUT.reg, REGISTER },
{ string240, (fn_ptr_type)&PORT->Group[0].OUTCLR.reg, REGISTER },
{ string241, (fn_ptr_type)&PORT->Group[0].OUTSET.reg, REGISTER },
{ string242, (fn_ptr_type)&PORT->Group[0].OUTTGL.reg, REGISTER },
{ string243, (fn_ptr_type)&PORT->Group[0].IN.reg, REGISTER },
{ string244, (fn_ptr_type)&PORT->Group[1].DIR.reg, REGISTER },
{ string245, (fn_ptr_type)&PORT->Group[1].DIRCLR.reg, REGISTER },
{ string246, (fn_ptr_type)&PORT->Group[1].DIRSET.reg, REGISTER },
{ string247, (fn_ptr_type)&PORT->Group[1].DIRTGL.reg, REGISTER },
{ string248, (fn_ptr_type)&PORT->Group[1].OUT.reg, REGISTER },
{ string249, (fn_ptr_type)&PORT->Group[1].OUTCLR.reg, REGISTER },
{ string250, (fn_ptr_type)&PORT->Group[1].OUTSET.reg, REGISTER },
{ string251, (fn_ptr_type)&PORT->Group[1].OUTTGL.reg, REGISTER },
{ string252, (fn_ptr_type)&PORT->Group[1].IN.reg, REGISTER },
{ string253, NULL, 0x00 },
#elif defined(CPU_NRF51822)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)AR_DEFAULT, ANALOGREFERENCE },
{ string224, (fn_ptr_type)AR_VBG, ANALOGREFERENCE },
{ string225, (fn_ptr_type)AR_SUPPLY_ONE_HALF, ANALOGREFERENCE },
{ string226, (fn_ptr_type)AR_SUPPLY_ONE_THIRD, ANALOGREFERENCE },
{ string227, (fn_ptr_type)AR_EXT0, ANALOGREFERENCE },
{ string228, (fn_ptr_type)AR_EXT1, ANALOGREFERENCE },
{ string229, (fn_ptr_type)&NRF_GPIO->OUT, REGISTER },
{ string230, (fn_ptr_type)&NRF_GPIO->OUTSET, REGISTER },
{ string231, (fn_ptr_type)&NRF_GPIO->OUTCLR, REGISTER },
{ string232, (fn_ptr_type)&NRF_GPIO->IN, REGISTER },
{ string233, (fn_ptr_type)&NRF_GPIO->DIR, REGISTER },
{ string234, (fn_ptr_type)&NRF_GPIO->DIRSET, REGISTER },
{ string235, (fn_ptr_type)&NRF_GPIO->DIRCLR, REGISTER },
{ string236, NULL, 0x00 },
#elif defined(CPU_NRF52840)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)AR_DEFAULT, ANALOGREFERENCE },
{ string224, (fn_ptr_type)AR_INTERNAL, ANALOGREFERENCE },
{ string225, (fn_ptr_type)AR_INTERNAL_3_0, ANALOGREFERENCE },
{ string226, (fn_ptr_type)AR_INTERNAL_2_4, ANALOGREFERENCE },
{ string227, (fn_ptr_type)AR_INTERNAL_1_8, ANALOGREFERENCE },
{ string228, (fn_ptr_type)AR_INTERNAL_1_2, ANALOGREFERENCE },
{ string229, (fn_ptr_type)AR_VDD4, ANALOGREFERENCE },
{ string230, (fn_ptr_type)&NRF_P0->OUT, REGISTER },
{ string231, (fn_ptr_type)&NRF_P0->OUTSET, REGISTER },
{ string232, (fn_ptr_type)&NRF_P0->OUTCLR, REGISTER },
{ string233, (fn_ptr_type)&NRF_P0->IN, REGISTER },
{ string234, (fn_ptr_type)&NRF_P0->DIR, REGISTER },
{ string235, (fn_ptr_type)&NRF_P0->DIRSET, REGISTER },
{ string236, (fn_ptr_type)&NRF_P0->DIRCLR, REGISTER },
{ string237, (fn_ptr_type)&NRF_P1->OUT, REGISTER },
{ string238, (fn_ptr_type)&NRF_P1->OUTSET, REGISTER },
{ string239, (fn_ptr_type)&NRF_P1->OUTCLR, REGISTER },
{ string240, (fn_ptr_type)&NRF_P1->IN, REGISTER },
{ string241, (fn_ptr_type)&NRF_P1->DIR, REGISTER },
{ string242, (fn_ptr_type)&NRF_P1->DIRSET, REGISTER },
{ string243, (fn_ptr_type)&NRF_P1->DIRCLR, REGISTER },
{ string244, NULL, 0x00 },
#elif defined(CPU_NRF52833)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)AR_DEFAULT, ANALOGREFERENCE },
{ string224, (fn_ptr_type)AR_INTERNAL, ANALOGREFERENCE },
{ string225, (fn_ptr_type)AR_VDD4, ANALOGREFERENCE },
{ string226, (fn_ptr_type)&NRF_P0->OUT, REGISTER },
{ string227, (fn_ptr_type)&NRF_P0->OUTSET, REGISTER },
{ string228, (fn_ptr_type)&NRF_P0->OUTCLR, REGISTER },
{ string229, (fn_ptr_type)&NRF_P0->IN, REGISTER },
{ string230, (fn_ptr_type)&NRF_P0->DIR, REGISTER },
{ string231, (fn_ptr_type)&NRF_P0->DIRSET, REGISTER },
{ string232, (fn_ptr_type)&NRF_P0->DIRCLR, REGISTER },
{ string233, (fn_ptr_type)&NRF_P1->OUT, REGISTER },
{ string234, (fn_ptr_type)&NRF_P1->OUTSET, REGISTER },
{ string235, (fn_ptr_type)&NRF_P1->OUTCLR, REGISTER },
{ string236, (fn_ptr_type)&NRF_P1->IN, REGISTER },
{ string237, (fn_ptr_type)&NRF_P1->DIR, REGISTER },
{ string238, (fn_ptr_type)&NRF_P1->DIRSET, REGISTER },
{ string239, (fn_ptr_type)&NRF_P1->DIRCLR, REGISTER },
{ string240, NULL, 0x00 },
#elif defined(CPU_iMXRT1062)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)OUTPUT_OPENDRAIN, PINMODE },
{ string224, NULL, 0x00 },
#elif defined(CPU_MAX32620)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)OUTPUT, PINMODE },
{ string222, (fn_ptr_type)DEFAULT, ANALOGREFERENCE },
{ string223, (fn_ptr_type)EXTERNAL, ANALOGREFERENCE },
{ string224, NULL, 0x00 },
#elif defined(CPU_RP2040)
{ string219, (fn_ptr_type)INPUT, PINMODE },
{ string220, (fn_ptr_type)INPUT_PULLUP, PINMODE },
{ string221, (fn_ptr_type)INPUT_PULLDOWN, PINMODE },
{ string222, (fn_ptr_type)OUTPUT, PINMODE },
{ string223, (fn_ptr_type)(SIO_BASE+SIO_GPIO_IN_OFFSET), REGISTER },
{ string224, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OUT_OFFSET), REGISTER },
{ string225, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OUT_SET_OFFSET), REGISTER },
{ string226, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OUT_CLR_OFFSET), REGISTER },
{ string227, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OUT_XOR_OFFSET), REGISTER },
{ string228, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OE_OFFSET), REGISTER },
{ string229, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OE_SET_OFFSET), REGISTER },
{ string230, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OE_CLR_OFFSET), REGISTER },
{ string231, (fn_ptr_type)(SIO_BASE+SIO_GPIO_OE_XOR_OFFSET), REGISTER },
{ string232, NULL, 0x00 },
#endif
// Insert your own table entries here
};
// Table lookup functions
builtin_t lookupbuiltin (char* n) {
int entry = 0;
while (entry < ENDFUNCTIONS) {
if (strcasecmp(n, (char*)lookup_table[entry].string) == 0)
return (builtin_t)entry;
entry++;
}
return ENDFUNCTIONS;
}
intptr_t lookupfn (builtin_t name) {
return (intptr_t)lookup_table[name].fptr;
}
uint8_t getminmax (builtin_t name) {
uint8_t minmax = lookup_table[name].minmax;
return minmax;
}
void checkminmax (builtin_t name, int nargs) {
uint8_t minmax = getminmax(name);
if (nargs<(minmax >> 4)) error2(name, toofewargs);
if ((minmax & 0x0f) != 0x0f && nargs>(minmax & 0x0f)) error2(name, toomanyargs);
}
void testescape () {
if (Serial.read() == '~') error2(NIL, PSTR("escape!"));
}
// Main evaluator
#if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41)
#define ENDSTACK _ebss
#else
#define ENDSTACK end
#endif
extern uint32_t ENDSTACK; // Bottom of stack
object *eval (object *form, object *env) {
register int *sp asm ("r13");
int TC=0;
EVAL:
// Enough space?
// Serial.println((uint32_t)sp - (uint32_t)&ENDSTACK); // Find best STACKDIFF value
if (((uint32_t)sp - (uint32_t)&ENDSTACK) < STACKDIFF) error2(NIL, PSTR("stack overflow"));
if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // GC when 1/16 of workspace left
// Escape
if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(NIL, PSTR("escape!"));}
if (!tstflag(NOESC)) testescape();
if (form == NULL) return nil;
if (form->type >= NUMBER && form->type <= STRING) return form;
if (symbolp(form)) {
symbol_t name = form->name;
object *pair = value(name, env);
if (pair != NULL) return cdr(pair);
pair = value(name, GlobalEnv);
if (pair != NULL) return cdr(pair);
else if (builtinp(name)) return form;
error(NIL, PSTR("undefined"), form);
}
#if defined(CODESIZE)
if (form->type == CODE) error2(NIL, PSTR("can't evaluate CODE header"));
#endif
// It's a list
object *function = car(form);
object *args = cdr(form);
if (function == NULL) error(NIL, PSTR("illegal function"), nil);
if (!listp(args)) error(NIL, PSTR("can't evaluate a dotted pair"), args);
// List starts with a symbol?
if (symbolp(function)) {
builtin_t name = builtin(function->name);
if ((name == LET) || (name == LETSTAR)) {
int TCstart = TC;
if (args == NULL) error2(name, noargument);
object *assigns = first(args);
if (!listp(assigns)) error(name, notalist, assigns);
object *forms = cdr(args);
object *newenv = env;
push(newenv, GCStack);
while (assigns != NULL) {
object *assign = car(assigns);
if (!consp(assign)) push(cons(assign,nil), newenv);
else if (cdr(assign) == NULL) push(cons(first(assign),nil), newenv);
else push(cons(first(assign),eval(second(assign),env)), newenv);
car(GCStack) = newenv;
if (name == LETSTAR) env = newenv;
assigns = cdr(assigns);
}
env = newenv;
pop(GCStack);
form = tf_progn(forms,env);
TC = TCstart;
goto EVAL;
}
if (name == LAMBDA) {
if (env == NULL) return form;
object *envcopy = NULL;
while (env != NULL) {
object *pair = first(env);
if (pair != NULL) push(pair, envcopy);
env = cdr(env);
}
return cons(bsymbol(CLOSURE), cons(envcopy,args));
}
if ((name > SPECIAL_FORMS) && (name < TAIL_FORMS)) {
return ((fn_ptr_type)lookupfn(name))(args, env);
}
if ((name > TAIL_FORMS) && (name < FUNCTIONS)) {
form = ((fn_ptr_type)lookupfn(name))(args, env);
TC = 1;
goto EVAL;
}
if (((name > 0) && (name < SPECIAL_FORMS)) || ((name > KEYWORDS) && (name < USERFUNCTIONS))) error2(name, PSTR("can't be used as a function"));
}
// Evaluate the parameters - result in head
object *fname = car(form);
int TCstart = TC;
object *head = cons(eval(fname, env), NULL);
push(head, GCStack); // Don't GC the result list
object *tail = head;
form = cdr(form);
int nargs = 0;
while (form != NULL){
object *obj = cons(eval(car(form),env),NULL);
cdr(tail) = obj;
tail = obj;
form = cdr(form);
nargs++;
}
function = car(head);
args = cdr(head);
if (symbolp(function)) {
builtin_t bname = builtin(function->name);
if (!builtinp(function->name)) error(NIL, PSTR("not valid here"), fname);
checkminmax(bname, nargs);
object *result = ((fn_ptr_type)lookupfn(bname))(args, env);
pop(GCStack);
return result;
}
if (consp(function)) {
symbol_t name = sym(NIL);
if (!listp(fname)) name = fname->name;
if (isbuiltin(car(function), LAMBDA)) {
form = closure(TCstart, name, function, args, &env);
pop(GCStack);
int trace = tracing(fname->name);
if (trace) {
object *result = eval(form, env);
indent((--(TraceDepth[trace-1]))<<1, ' ', pserial);
pint(TraceDepth[trace-1], pserial);
pserial(':'); pserial(' ');
printobject(fname, pserial); pfstring(PSTR(" returned "), pserial);
printobject(result, pserial); pln(pserial);
return result;
} else {
TC = 1;
goto EVAL;
}
}
if (isbuiltin(car(function), CLOSURE)) {
function = cdr(function);
form = closure(TCstart, name, function, args, &env);
pop(GCStack);
TC = 1;
goto EVAL;
}
if (car(function)->type == CODE) {
int n = listlength(DEFCODE, second(function));
if (nargs<n) errorsym2(fname->name, toofewargs);
if (nargs>n) errorsym2(fname->name, toomanyargs);
uint32_t entry = startblock(car(function)) + 1;
pop(GCStack);
return call(entry, n, args, env);
}
}
error(NIL, PSTR("illegal function"), fname); return nil;
}
// Print functions
void pserial (char c) {
LastPrint = c;
if (c == '\n') Serial.write('\r');
Serial.write(c);
}
const char ControlCodes[] PROGMEM = "Null\0SOH\0STX\0ETX\0EOT\0ENQ\0ACK\0Bell\0Backspace\0Tab\0Newline\0VT\0"
"Page\0Return\0SO\0SI\0DLE\0DC1\0DC2\0DC3\0DC4\0NAK\0SYN\0ETB\0CAN\0EM\0SUB\0Escape\0FS\0GS\0RS\0US\0Space\0";
void pcharacter (uint8_t c, pfun_t pfun) {
if (!tstflag(PRINTREADABLY)) pfun(c);
else {
pfun('#'); pfun('\\');
if (c <= 32) {
const char *p = ControlCodes;
while (c > 0) {p = p + strlen(p) + 1; c--; }
pfstring(p, pfun);
} else if (c < 127) pfun(c);
else pint(c, pfun);
}
}
void pstring (char *s, pfun_t pfun) {
while (*s) pfun(*s++);
}
void plispstring (object *form, pfun_t pfun) {
plispstr(form->name, pfun);
}
void plispstr (symbol_t name, pfun_t pfun) {
object *form = (object *)name;
while (form != NULL) {
int chars = form->chars;
for (int i=(sizeof(int)-1)*8; i>=0; i=i-8) {
char ch = chars>>i & 0xFF;
if (tstflag(PRINTREADABLY) && (ch == '"' || ch == '\\')) pfun('\\');
if (ch) pfun(ch);
}
form = car(form);
}
}
void printstring (object *form, pfun_t pfun) {
if (tstflag(PRINTREADABLY)) pfun('"');
plispstr(form->name, pfun);
if (tstflag(PRINTREADABLY)) pfun('"');
}
void pbuiltin (builtin_t name, pfun_t pfun) {
int p = 0;
const char *s = lookup_table[name].string;
while (1) {
char c = s[p++];
if (c == 0) return;
pfun(c);
}
}
void pradix40 (symbol_t name, pfun_t pfun) {
uint32_t x = untwist(name);
for (int d=102400000; d>0; d = d/40) {
uint32_t j = x/d;
char c = fromradix40(j);
if (c == 0) return;
pfun(c); x = x - j*d;
}
}
void printsymbol (object *form, pfun_t pfun) {
psymbol(form->name, pfun);
}
void psymbol (symbol_t name, pfun_t pfun) {
if ((name & 0x03) == 0) plispstr(name, pfun);
else {
uint32_t value = untwist(name);
if (value < PACKEDS) error2(NIL, PSTR("invalid symbol"));
else if (value >= BUILTINS) pbuiltin((builtin_t)(value-BUILTINS), pfun);
else pradix40(name, pfun);
}
}
void pfstring (const char *s, pfun_t pfun) {
int p = 0;
while (1) {
char c = s[p++];
if (c == 0) return;
pfun(c);
}
}
void pint (int i, pfun_t pfun) {
uint32_t j = i;
if (i<0) { pfun('-'); j=-i; }
pintbase(j, 10, pfun);
}
void pintbase (uint32_t i, uint8_t base, pfun_t pfun) {
int lead = 0; uint32_t p = 1000000000;
if (base == 2) p = 0x80000000; else if (base == 16) p = 0x10000000;
for (uint32_t d=p; d>0; d=d/base) {
uint32_t j = i/d;
if (j!=0 || lead || d==1) { pfun((j<10) ? j+'0' : j+'W'); lead=1;}
i = i - j*d;
}
}
void printhex4 (int i, pfun_t pfun) {
int p = 0x1000;
for (int d=p; d>0; d=d/16) {
int j = i/d;
pfun((j<10) ? j+'0' : j + 'W');
i = i - j*d;
}
pfun(' ');
}
void pmantissa (float f, pfun_t pfun) {
int sig = floor(log10(f));
int mul = pow(10, 5 - sig);
int i = round(f * mul);
bool point = false;
if (i == 1000000) { i = 100000; sig++; }
if (sig < 0) {
pfun('0'); pfun('.'); point = true;
for (int j=0; j < - sig - 1; j++) pfun('0');
}
mul = 100000;
for (int j=0; j<7; j++) {
int d = (int)(i / mul);
pfun(d + '0');
i = i - d * mul;
if (i == 0) {
if (!point) {
for (int k=j; k<sig; k++) pfun('0');
pfun('.'); pfun('0');
}
return;
}
if (j == sig && sig >= 0) { pfun('.'); point = true; }
mul = mul / 10;
}
}
void pfloat (float f, pfun_t pfun) {
if (isnan(f)) { pfstring(PSTR("NaN"), pfun); return; }
if (f == 0.0) { pfun('0'); return; }
if (isinf(f)) { pfstring(PSTR("Inf"), pfun); return; }
if (f < 0) { pfun('-'); f = -f; }
// Calculate exponent
int e = 0;
if (f < 1e-3 || f >= 1e5) {
e = floor(log(f) / 2.302585); // log10 gives wrong result
f = f / pow(10, e);
}
pmantissa (f, pfun);
// Exponent
if (e != 0) {
pfun('e');
pint(e, pfun);
}
}
inline void pln (pfun_t pfun) {
pfun('\n');
}
void pfl (pfun_t pfun) {
if (LastPrint != '\n') pfun('\n');
}
void plist (object *form, pfun_t pfun) {
pfun('(');
printobject(car(form), pfun);
form = cdr(form);
while (form != NULL && listp(form)) {
pfun(' ');
printobject(car(form), pfun);
form = cdr(form);
}
if (form != NULL) {
pfstring(PSTR(" . "), pfun);
printobject(form, pfun);
}
pfun(')');
}
void pstream (object *form, pfun_t pfun) {
pfun('<');
pfstring(streamname[(form->integer)>>8], pfun);
pfstring(PSTR("-stream "), pfun);
pint(form->integer & 0xFF, pfun);
pfun('>');
}
void printobject (object *form, pfun_t pfun) {
if (form == NULL) pfstring(PSTR("nil"), pfun);
else if (listp(form) && isbuiltin(car(form), CLOSURE)) pfstring(PSTR("<closure>"), pfun);
else if (listp(form)) plist(form, pfun);
else if (integerp(form)) pint(form->integer, pfun);
else if (floatp(form)) pfloat(form->single_float, pfun);
else if (symbolp(form)) { if (form->name != sym(NOTHING)) printsymbol(form, pfun); }
else if (characterp(form)) pcharacter(form->chars, pfun);
else if (stringp(form)) printstring(form, pfun);
else if (arrayp(form)) printarray(form, pfun);
else if (form->type == CODE) pfstring(PSTR("code"), pfun);
else if (streamp(form)) pstream(form, pfun);
else error2(NIL, PSTR("error in print"));
}
void prin1object (object *form, pfun_t pfun) {
char temp = Flags;
clrflag(PRINTREADABLY);
printobject(form, pfun);
Flags = temp;
}
// Read functions
int glibrary () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
char c = LispLibrary[GlobalStringIndex++];
return (c != 0) ? c : -1; // -1?
}
void loadfromlibrary (object *env) {
GlobalStringIndex = 0;
object *line = read(glibrary);
while (line != NULL) {
push(line, GCStack);
eval(line, env);
pop(GCStack);
line = read(glibrary);
}
}
// For line editor
const int TerminalWidth = 80;
volatile int WritePtr = 0, ReadPtr = 0;
const int KybdBufSize = 333; // 42*8 - 3
char KybdBuf[KybdBufSize];
volatile uint8_t KybdAvailable = 0;
// Parenthesis highlighting
void esc (int p, char c) {
Serial.write('\e'); Serial.write('[');
Serial.write((char)('0'+ p/100));
Serial.write((char)('0'+ (p/10) % 10));
Serial.write((char)('0'+ p % 10));
Serial.write(c);
}
void hilight (char c) {
Serial.write('\e'); Serial.write('['); Serial.write(c); Serial.write('m');
}
void Highlight (int p, int wp, uint8_t invert) {
wp = wp + 2; // Prompt
#if defined (printfreespace)
int f = Freespace;
while (f) { wp++; f=f/10; }
#endif
int line = wp/TerminalWidth;
int col = wp%TerminalWidth;
int targetline = (wp - p)/TerminalWidth;
int targetcol = (wp - p)%TerminalWidth;
int up = line-targetline, left = col-targetcol;
if (p) {
if (up) esc(up, 'A');
if (col > targetcol) esc(left, 'D'); else esc(-left, 'C');
if (invert) hilight('7');
Serial.write('('); Serial.write('\b');
// Go back
if (up) esc(up, 'B'); // Down
if (col > targetcol) esc(left, 'C'); else esc(-left, 'D');
Serial.write('\b'); Serial.write(')');
if (invert) hilight('0');
}
}
void processkey (char c) {
if (c == 27) { setflag(ESCAPE); return; } // Escape key
#if defined(vt100)
static int parenthesis = 0, wp = 0;
// Undo previous parenthesis highlight
Highlight(parenthesis, wp, 0);
parenthesis = 0;
#endif
// Edit buffer
if (c == '\n' || c == '\r') {
pserial('\n');
KybdAvailable = 1;
ReadPtr = 0;
return;
}
if (c == 8 || c == 0x7f) { // Backspace key
if (WritePtr > 0) {
WritePtr--;
Serial.write(8); Serial.write(' '); Serial.write(8);
if (WritePtr) c = KybdBuf[WritePtr-1];
}
} else if (WritePtr < KybdBufSize) {
KybdBuf[WritePtr++] = c;
Serial.write(c);
}
#if defined(vt100)
// Do new parenthesis highlight
if (c == ')') {
int search = WritePtr-1, level = 0;
while (search >= 0 && parenthesis == 0) {
c = KybdBuf[search--];
if (c == ')') level++;
if (c == '(') {
level--;
if (level == 0) {parenthesis = WritePtr-search-1; wp = WritePtr; }
}
}
Highlight(parenthesis, wp, 1);
}
#endif
return;
}
int gserial () {
if (LastChar) {
char temp = LastChar;
LastChar = 0;
return temp;
}
#if defined(lineeditor)
while (!KybdAvailable) {
while (!Serial.available());
char temp = Serial.read();
processkey(temp);
}
if (ReadPtr != WritePtr) return KybdBuf[ReadPtr++];
KybdAvailable = 0;
WritePtr = 0;
return '\n';
#else
unsigned long start = millis();
while (!Serial.available()) if (millis() - start > 1000) clrflag(NOECHO);
char temp = Serial.read();
if (temp != '\n' && !tstflag(NOECHO)) pserial(temp);
return temp;
#endif
}
object *nextitem (gfun_t gfun) {
int ch = gfun();
while(issp(ch)) ch = gfun();
if (ch == ';') {
do { ch = gfun(); if (ch == ';' || ch == '(') setflag(NOECHO); }
while(ch != '(');
}
if (ch == '\n') ch = gfun();
if (ch == -1) return nil;
if (ch == ')') return (object *)KET;
if (ch == '(') return (object *)BRA;
if (ch == '\'') return (object *)QUO;
// Parse string
if (ch == '"') return readstring('"', gfun);
// Parse symbol, character, or number
int index = 0, base = 10, sign = 1;
char buffer[BUFFERSIZE];
int bufmax = BUFFERSIZE-3; // Max index
unsigned int result = 0;
bool isfloat = false;
float fresult = 0.0;
if (ch == '+') {
buffer[index++] = ch;
ch = gfun();
} else if (ch == '-') {
sign = -1;
buffer[index++] = ch;
ch = gfun();
} else if (ch == '.') {
buffer[index++] = ch;
ch = gfun();
if (ch == ' ') return (object *)DOT;
isfloat = true;
}
// Parse reader macros
else if (ch == '#') {
ch = gfun();
char ch2 = ch & ~0x20; // force to upper case
if (ch == '\\') { // Character
base = 0; ch = gfun();
if (issp(ch) || ch == ')' || ch == '(') return character(ch);
else LastChar = ch;
} else if (ch == '|') {
do { while (gfun() != '|'); }
while (gfun() != '#');
return nextitem(gfun);
} else if (ch2 == 'B') base = 2;
else if (ch2 == 'O') base = 8;
else if (ch2 == 'X') base = 16;
else if (ch == '\'') return nextitem(gfun);
else if (ch == '.') {
setflag(NOESC);
object *result = eval(read(gfun), NULL);
clrflag(NOESC);
return result;
}
else if (ch == '(') { LastChar = ch; return readarray(1, read(gfun)); }
else if (ch == '*') return readbitarray(gfun);
else if (ch >= '1' && ch <= '9' && (gfun() & ~0x20) == 'A') return readarray(ch - '0', read(gfun));
else error2(NIL, PSTR("illegal character after #"));
ch = gfun();
}
int valid; // 0=undecided, -1=invalid, +1=valid
if (ch == '.') valid = 0; else if (digitvalue(ch)<base) valid = 1; else valid = -1;
bool isexponent = false;
int exponent = 0, esign = 1;
buffer[2] = '\0'; buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; // In case symbol is < 5 letters
float divisor = 10.0;
while(!issp(ch) && ch != ')' && ch != '(' && index < bufmax) {
buffer[index++] = ch;
if (base == 10 && ch == '.' && !isexponent) {
isfloat = true;
fresult = result;
} else if (base == 10 && (ch == 'e' || ch == 'E')) {
if (!isfloat) { isfloat = true; fresult = result; }
isexponent = true;
if (valid == 1) valid = 0; else valid = -1;
} else if (isexponent && ch == '-') {
esign = -esign;
} else if (isexponent && ch == '+') {
} else {
int digit = digitvalue(ch);
if (digitvalue(ch)<base && valid != -1) valid = 1; else valid = -1;
if (isexponent) {
exponent = exponent * 10 + digit;
} else if (isfloat) {
fresult = fresult + digit / divisor;
divisor = divisor * 10.0;
} else {
result = result * base + digit;
}
}
ch = gfun();
}
buffer[index] = '\0';
if (ch == ')' || ch == '(') LastChar = ch;
if (isfloat && valid == 1) return makefloat(fresult * sign * pow(10, exponent * esign));
else if (valid == 1) {
if (base == 10 && result > ((unsigned int)INT_MAX+(1-sign)/2))
return makefloat((float)result*sign);
return number(result*sign);
} else if (base == 0) {
if (index == 1) return character(buffer[0]);
const char* p = ControlCodes; char c = 0;
while (c < 33) {
if (strcasecmp(buffer, p) == 0) return character(c);
p = p + strlen(p) + 1; c++;
}
if (index == 3) return character((buffer[0]*10+buffer[1])*10+buffer[2]-5328);
error2(NIL, PSTR("unknown character"));
}
builtin_t x = lookupbuiltin(buffer);
if (x == NIL) return nil;
if (x != ENDFUNCTIONS) return bsymbol(x);
else if ((index <= 6) && valid40(buffer)) return intern(twist(pack40(buffer)));
buffer[index+1] = '\0'; buffer[index+2] = '\0'; buffer[index+3] = '\0'; // For internlong
return internlong(buffer);
}
object *readrest (gfun_t gfun) {
object *item = nextitem(gfun);
object *head = NULL;
object *tail = NULL;
while (item != (object *)KET) {
if (item == (object *)BRA) {
item = readrest(gfun);
} else if (item == (object *)QUO) {
item = cons(bsymbol(QUOTE), cons(read(gfun), NULL));
} else if (item == (object *)DOT) {
tail->cdr = read(gfun);
if (readrest(gfun) != NULL) error2(NIL, PSTR("malformed list"));
return head;
} else {
object *cell = cons(item, NULL);
if (head == NULL) head = cell;
else tail->cdr = cell;
tail = cell;
item = nextitem(gfun);
}
}
return head;
}
object *read (gfun_t gfun) {
object *item = nextitem(gfun);
if (item == (object *)KET) error2(NIL, PSTR("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));
return item;
}
// Setup
void initgfx () {
#if defined(gfxsupport)
tft.begin();
tft.clearDisplay();
tft.drawPixel(10, 10, COLOR_BLACK);
tft.drawPixel(14, 10, COLOR_BLACK);
tft.drawPixel(10, 13, COLOR_BLACK);
tft.drawPixel(11, 14, COLOR_BLACK);
tft.drawPixel(12, 14, COLOR_BLACK);
tft.drawPixel(13, 14, COLOR_BLACK);
tft.drawPixel(14, 13, COLOR_BLACK);
tft.refresh();
#endif
}
void initenv () {
GlobalEnv = NULL;
tee = bsymbol(TEE);
}
void setup () {
Serial.begin(9600);
int start = millis();
while ((millis() - start) < 5000) { if (Serial) break; }
initworkspace();
initenv();
initsleep();
initgfx();
pfstring(PSTR("uLisp 4.1a "), pserial); pln(pserial);
}
// Read/Evaluate/Print loop
void repl (object *env) {
for (;;) {
randomSeed(micros());
gc(NULL, env);
#if defined (printfreespace)
pint(Freespace, pserial);
#endif
if (BreakLevel) {
pfstring(PSTR(" : "), pserial);
pint(BreakLevel, pserial);
}
pserial('>'); pserial(' ');
object *line = read(gserial);
if (BreakLevel && line == nil) { pln(pserial); return; }
if (line == (object *)KET) error2(NIL, PSTR("unmatched right bracket"));
push(line, GCStack);
pfl(pserial);
line = eval(line, env);
pfl(pserial);
printobject(line, pserial);
pop(GCStack);
pfl(pserial);
pln(pserial);
}
}
void loop () {
if (!setjmp(exception)) {
#if defined(resetautorun)
volatile int autorun = 12; // Fudge to keep code size the same
#else
volatile int autorun = 13;
#endif
if (autorun == 12) autorunimage();
}
// Come here after error
delay(100); while (Serial.available()) Serial.read();
clrflag(NOESC); BreakLevel = 0;
for (int i=0; i<TRACEMAX; i++) TraceDepth[i] = 0;
#if defined(sdcardsupport)
SDpfile.close(); SDgfile.close();
#endif
#if defined(lisplibrary)
if (!tstflag(LIBRARYLOADED)) { setflag(LIBRARYLOADED); loadfromlibrary(NULL); }
#endif
repl(NULL);
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment