From 417700ec6c14aaa4731c62122371d26595c4d19c Mon Sep 17 00:00:00 2001 From: David Johnson-Davies Date: Thu, 20 Feb 2020 15:52:05 +0000 Subject: [PATCH] Version 3.1 - 20th February 2020 --- ulisp-arm.ino | 1195 +++++++++++++++++++++++++++++++------------------ 1 file changed, 757 insertions(+), 438 deletions(-) diff --git a/ulisp-arm.ino b/ulisp-arm.ino index b7dbe3d..d882223 100644 --- a/ulisp-arm.ino +++ b/ulisp-arm.ino @@ -1,5 +1,5 @@ -/* uLisp ARM 3.0c - www.ulisp.com - David Johnson-Davies - www.technoblogy.com - 11th January 2020 +/* uLisp ARM 3.1 - www.ulisp.com + David Johnson-Davies - www.technoblogy.com - 20th February 2020 Licensed under the MIT license: https://opensource.org/licenses/MIT */ @@ -15,6 +15,7 @@ const char LispLibrary[] PROGMEM = ""; // #define printgcs // #define sdcardsupport // #define lisplibrary +#define assemblerlist // Includes @@ -45,7 +46,7 @@ const char LispLibrary[] PROGMEM = ""; #define push(x, y) ((y) = cons((x),(y))) #define pop(y) ((y) = cdr(y)) -#define integerp(x) ((x) != NULL && (x)->type == NUMBER) +#define integerp(x) ((x) != NULL && ((x)->type == NUMBER || (x)->type == NUMHEX)) #define floatp(x) ((x) != NULL && (x)->type == FLOAT) #define symbolp(x) ((x) != NULL && (x)->type == SYMBOL) #define stringp(x) ((x) != NULL && (x)->type == STRING) @@ -61,23 +62,27 @@ const char LispLibrary[] PROGMEM = ""; #define clrflag(x) (Flags = Flags & ~(1<<(x))) #define tstflag(x) (Flags & 1<<(x)) +// 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 { ZERO=0, SYMBOL=2, NUMBER=4, STREAM=6, CHARACTER=8, FLOAT=10, STRING=12, PAIR=14 }; // STRING and PAIR must be last +enum type { ZERO=0, SYMBOL=2, CODE=4, NUMBER=6, NUMHEX=8, STREAM=10, CHARACTER=12, FLOAT=14, STRING=16, PAIR=18 }; // STRING and PAIR must be last enum token { UNUSED, BRA, KET, QUO, DOT }; enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM, SDSTREAM }; enum function { NIL, TEE, NOTHING, OPTIONAL, AMPREST, LAMBDA, LET, LETSTAR, CLOSURE, SPECIAL_FORMS, QUOTE, DEFUN, DEFVAR, SETQ, LOOP, RETURN, PUSH, POP, INCF, DECF, SETF, DOLIST, DOTIMES, TRACE, UNTRACE, -FORMILLIS, WITHSERIAL, WITHI2C, WITHSPI, WITHSDCARD, TAIL_FORMS, PROGN, IF, COND, WHEN, UNLESS, CASE, AND, -OR, FUNCTIONS, NOT, NULLFN, CONS, ATOM, LISTP, CONSP, SYMBOLP, STREAMP, EQ, CAR, FIRST, CDR, REST, CAAR, -CADR, SECOND, CDAR, CDDR, CAAAR, CAADR, CADAR, CADDR, THIRD, CDAAR, CDADR, CDDAR, CDDDR, LENGTH, LIST, -REVERSE, NTH, 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, +FORMILLIS, WITHSERIAL, WITHI2C, WITHSPI, WITHSDCARD, DEFCODE, TAIL_FORMS, PROGN, IF, COND, WHEN, UNLESS, +CASE, AND, OR, FUNCTIONS, NOT, NULLFN, CONS, ATOM, LISTP, CONSP, SYMBOLP, BOUNDP, SET, STREAMP, EQ, CAR, +FIRST, CDR, REST, CAAR, CADR, SECOND, CDAR, CDDR, CAAAR, CAADR, CADAR, CADDR, THIRD, CDAAR, CDADR, CDDAR, +CDDDR, LENGTH, LIST, REVERSE, NTH, 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, @@ -105,6 +110,7 @@ typedef struct sobject { } object; typedef object *(*fn_ptr_type)(object *, object *); +typedef int (*intfn_ptr_type)(int w, int x, int y, int z); typedef struct { const char *string; @@ -121,79 +127,79 @@ typedef int PinMode; #define PERSIST __attribute__((section(".text"))) #define WORDALIGNED __attribute__((aligned (4))) #define BUFFERSIZE 34 // Number of bits+2 +#define RAMFUNC __attribute__ ((section (".ramfunctions"))) -#if defined(ARDUINO_ITSYBITSY_M0) +#if defined(ARDUINO_ITSYBITSY_M0) || defined(ARDUINO_FEATHER_M0_EXPRESS) #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define DATAFLASHSIZE 2048000 /* 2 MBytes */ #define SYMBOLTABLESIZE 512 /* Bytes */ - uint8_t _end; + #define CODESIZE 128 /* Bytes */ + #define SDCARD_SS_PIN 4 + #define STACKDIFF 320 #elif defined(ARDUINO_GEMMA_M0) #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ - uint8_t _end; + #define CODESIZE 128 /* Bytes */ + #define STACKDIFF 320 -#elif defined(ARDUINO_FEATHER_M0_EXPRESS) - #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ - #define SYMBOLTABLESIZE 512 /* Bytes */ - #define SDCARD_SS_PIN 4 - uint8_t _end; - -#elif defined(ARDUINO_METRO_M4) +#elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) #define WORKSPACESIZE 20480-SDSIZE /* Objects (8*bytes) */ #define DATAFLASHSIZE 2048000 /* 2 MBytes */ #define SYMBOLTABLESIZE 1024 /* Bytes */ - uint8_t _end; - -#elif defined(ARDUINO_ITSYBITSY_M4) - #define WORKSPACESIZE 20480-SDSIZE /* Objects (8*bytes) */ - #define DATAFLASHSIZE 2048000 /* 2 MBytes */ - #define SYMBOLTABLESIZE 1024 /* Bytes */ - uint8_t _end; - -#elif defined(ARDUINO_FEATHER_M4) - #define WORKSPACESIZE 20480-SDSIZE /* Objects (8*bytes) */ - #define DATAFLASHSIZE 2048000 /* 2 MBytes */ - #define SYMBOLTABLESIZE 1024 /* Bytes */ - uint8_t _end; + #define CODESIZE 256 /* Bytes */ + #define STACKDIFF 320 #elif defined(ARDUINO_GRAND_CENTRAL_M4) #define WORKSPACESIZE 30720-SDSIZE /* Objects (8*bytes) */ #define DATAFLASHSIZE 8192000 /* 8 MBytes */ #define SYMBOLTABLESIZE 1024 /* Bytes */ - uint8_t _end; - -#elif defined(ARDUINO_SAM_DUE) - #define WORKSPACESIZE 10240-SDSIZE /* Objects (8*bytes) */ - #define SYMBOLTABLESIZE 1024 /* Bytes */ - #define SDCARD_SS_PIN 10 - extern uint8_t _end; + #define CODESIZE 256 /* Bytes */ + #define STACKDIFF 320 #elif defined(ARDUINO_SAMD_MKRZERO) #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ - uint8_t _end; + #define CODESIZE 128 /* Bytes */ + #define STACKDIFF 840 #elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */ #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ + #define CODESIZE 128 /* Bytes */ #define SDCARD_SS_PIN 10 - uint8_t _end; + #define STACKDIFF 320 #elif defined(_VARIANT_BBC_MICROBIT_) #define WORKSPACESIZE 1280 /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ - uint8_t _end; + #define CODESIZE 64 /* Bytes */ + +#elif defined(ARDUINO_NRF52840_ITSYBITSY) + #define WORKSPACESIZE 20992-SDSIZE /* Objects (8*bytes) */ + #define DATAFLASHSIZE 2048000 /* 2 MBytes */ + #define SYMBOLTABLESIZE 1024 /* Bytes */ + #define CODESIZE 256 /* Bytes */ + #define STACKDIFF 1200 + +#elif defined(ARDUINO_NRF52840_CLUE) + #define WORKSPACESIZE 20480-SDSIZE /* Objects (8*bytes) */ + #define DATAFLASHSIZE 2048000 /* 2 MBytes */ + #define SYMBOLTABLESIZE 1024 /* Bytes */ + #define CODESIZE 256 /* Bytes */ + #define STACKDIFF 2048 #elif defined(MAX32620) #define WORKSPACESIZE 24576-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 1024 /* Bytes */ - uint8_t _end; + #define CODESIZE 256 /* Bytes */ + #define STACKDIFF 320 #endif object Workspace[WORKSPACESIZE] WORDALIGNED; char SymbolTable[SYMBOLTABLESIZE]; +RAMFUNC uint8_t MyCode[CODESIZE] WORDALIGNED; // Global variables @@ -267,6 +273,13 @@ object *number (int n) { return ptr; } +object *numhex (int n) { + object *ptr = myalloc(); + ptr->type = NUMHEX; + ptr->integer = n; + return ptr; +} + object *makefloat (float f) { object *ptr = myalloc(); ptr->type = FLOAT; @@ -295,6 +308,13 @@ object *symbol (symbol_t name) { return ptr; } +object *codehead (int entry) { + object *ptr = myalloc(); + ptr->type = CODE; + ptr->integer = entry; + return ptr; +} + object *newsymbol (symbol_t name) { for (int i=WORKSPACESIZE-1; i>=0; i--) { object *obj = &Workspace[i]; @@ -385,7 +405,7 @@ void movepointer (object *from, object *to) { } } } - + int compactimage (object **arg) { markobject(tee); markobject(GlobalEnv); @@ -444,7 +464,7 @@ void SDWriteInt (File file, int data) { // Arduino pins used for dataflash #if defined(ARDUINO_ITSYBITSY_M0) const int sck = 38, ssel = 39, mosi = 37, miso = 36; -#elif defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_METRO_M4) || defined(ARDUINO_FEATHER_M4) || defined(ARDUINO_GRAND_CENTRAL_M4) +#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 @@ -558,6 +578,7 @@ int saveimage (object *arg) { SDWriteInt(file, (uintptr_t)SymbolTop); for (int i=0; i= '0' && ch <= '9') return ch-'0'+30; + if (ch == '$') return 27; if (ch == '*') return 28; if (ch == '-') return 29; ch = ch | 0x20; if (ch >= 'a' && ch <= 'z') return ch-'a'+1; return -1; // Invalid @@ -789,16 +819,32 @@ int toradix40 (char ch) { int fromradix40 (int n) { if (n >= 1 && n <= 26) return 'a'+n-1; + if (n == 27) return '$'; if (n == 28) return '*'; if (n == 29) return '-'; if (n >= 30 && n <= 39) return '0'+n-30; return 0; } int pack40 (char *buffer) { - return (((toradix40(buffer[0]) * 40) + toradix40(buffer[1])) * 40 + toradix40(buffer[2])); + int x = 0; + for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]); + return x; } boolean valid40 (char *buffer) { - return (toradix40(buffer[0]) >= 0 && toradix40(buffer[1]) >= 0 && toradix40(buffer[2]) >= 0); + for (int i=0; i<6; i++) if (toradix40(buffer[i]) == -1) return false; + return true; +} + +char *symbolname (symbol_t x) { + if (x < ENDFUNCTIONS) return lookupbuiltin(x); + else if (x >= MAXSYMBOL) return lookupsymbol(x); + char *buffer = SymbolTop; + buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; buffer[6] = '\0'; + for (int n=5; n>=0; n--) { + buffer[n] = fromradix40(x % 40); + x = x / 40; + } + return buffer; } int digitvalue (char d) { @@ -808,18 +854,6 @@ int digitvalue (char d) { return 16; } -char *symbolname (symbol_t x) { - if (x < ENDFUNCTIONS) return lookupbuiltin(x); - else if (x >= 64000) return lookupsymbol(x); - char *buffer = SymbolTop; - buffer[3] = '\0'; - for (int n=2; n>=0; n--) { - buffer[n] = fromradix40(x % 40); - x = x / 40; - } - return buffer; -} - int checkinteger (symbol_t name, object *obj) { if (!integerp(obj)) error(name, PSTR("argument is not an integer"), obj); return obj->integer; @@ -980,6 +1014,13 @@ object *value (symbol_t n, object *env) { return nil; } +boolean 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); @@ -1161,6 +1202,9 @@ void I2Cstop (uint8_t read) { // Streams inline int spiread () { return SPI.transfer(0); } +#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) +inline int spi1read () { return SPI1.transfer(0); } +#endif #if defined(ARDUINO_SAM_DUE) inline int serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); } inline int serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); } @@ -1181,14 +1225,17 @@ inline int SDread () { #endif void serialbegin (int address, int baud) { - #if defined(ARDUINO_SAM_DUE) + #if defined(_VARIANT_BBC_MICROBIT_) + error(WITHSERIAL, PSTR("port not supported"), number(address)); + #elif defined(ARDUINO_SAM_DUE) 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(_VARIANT_BBC_MICROBIT_) - if (address == 1) Serial1.begin((long)baud*100); - #endif else error(WITHSERIAL, PSTR("port not supported"), number(address)); + #else + if (address == 1) Serial1.begin((long)baud*100); + else error(WITHSERIAL, PSTR("port not supported"), number(address)); + #endif } void serialend (int address) { @@ -1210,7 +1257,12 @@ gfun_t gstreamfun (object *args) { streamtype = stream>>8; address = stream & 0xFF; } if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread; - else if (streamtype == SPISTREAM) gfun = spiread; + else if (streamtype == SPISTREAM) { + if (address < 128) gfun = spiread; + #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) + else gfun = spi1read; + #endif + } else if (streamtype == SERIALSTREAM) { if (address == 0) gfun = gserial; #if defined(ARDUINO_SAM_DUE) @@ -1229,6 +1281,9 @@ gfun_t gstreamfun (object *args) { } inline void spiwrite (char c) { SPI.transfer(c); } +#if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) +inline void spi1write (char c) { SPI1.transfer(c); } +#endif #if defined(ARDUINO_SAM_DUE) inline void serial1write (char c) { Serial1.write(c); } inline void serial2write (char c) { Serial2.write(c); } @@ -1249,7 +1304,12 @@ pfun_t pstreamfun (object *args) { streamtype = stream>>8; address = stream & 0xFF; } if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite; - else if (streamtype == SPISTREAM) pfun = spiwrite; + else if (streamtype == SPISTREAM) { + if (address < 128) pfun = spiwrite; + #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) + else pfun = spi1write; + #endif + } else if (streamtype == SERIALSTREAM) { if (address == 0) pfun = pserial; #if defined(ARDUINO_SAM_DUE) @@ -1290,6 +1350,10 @@ void checkanalogread (int pin) { if (!((pin>=67 && pin<=74) || (pin>=54 && pin<=61))) error(ANALOGREAD, invalidpin, number(pin)); #elif defined(_VARIANT_BBC_MICROBIT_) 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)); #endif @@ -1316,6 +1380,10 @@ void checkanalogwrite (int pin) { 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(_VARIANT_BBC_MICROBIT_) if (!(pin>=0 && pin<=2)) error(ANALOGWRITE, 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)); #endif @@ -1323,24 +1391,20 @@ void checkanalogwrite (int pin) { // Note -void tone (int pin, int note) { - (void) pin, (void) note; -} - -void noTone (int pin) { - (void) pin; -} - const int scale[] PROGMEM = {4186,4435,4699,4978,5274,5588,5920,6272,6645,7040,7459,7902}; void playnote (int pin, int note, int octave) { +#if defined(ARDUINO_NRF52840_CLUE) 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) noTone(pin); +#endif } // Sleep @@ -1420,23 +1484,24 @@ object *sp_defun (object *args, object *env) { (void) env; checkargs(DEFUN, args); object *var = first(args); - if (var->type != SYMBOL) error(DEFUN, PSTR("not a symbol"), var); + if (!symbolp(var)) error(DEFUN, notasymbol, var); object *val = cons(symbol(LAMBDA), cdr(args)); object *pair = value(var->name,GlobalEnv); - if (pair != NULL) { cdr(pair) = val; return var; } - push(cons(var, val), 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 (var->type != SYMBOL) error(DEFVAR, PSTR("not a symbol"), var); + if (!symbolp(var)) error(DEFVAR, notasymbol, var); object *val = NULL; - val = eval(second(args), env); + 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; return var; } - push(cons(var, val), GlobalEnv); + if (pair != NULL) cdr(pair) = val; + else push(cons(var, val), GlobalEnv); return var; } @@ -1725,7 +1790,7 @@ object *sp_withspi (object *args, object *env) { pinMode(pin, OUTPUT); digitalWrite(pin, HIGH); params = cdr(params); - int clock = 4000, mode = SPI_MODE0; // Defaults + int clock = 4000, mode = SPI_MODE0, address = 0; // Defaults BitOrder bitorder = MSBFIRST; if (params != NULL) { clock = checkinteger(WITHSPI, eval(car(params), env)); @@ -1736,18 +1801,26 @@ object *sp_withspi (object *args, object *env) { 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)); + object *pair = cons(var, stream(SPISTREAM, pin + 128*address)); push(pair,env); - SPI.begin(); - SPI.beginTransaction(SPISettings(((unsigned long)clock * 1000), bitorder, mode)); + SPIClass *spiClass = &SPI; + #if defined(ARDUINO_NRF52840_CLUE) || defined(ARDUINO_GRAND_CENTRAL_M4) + 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); - SPI.endTransaction(); + (*spiClass).endTransaction(); return result; } @@ -1783,6 +1856,179 @@ object *sp_withsdcard (object *args, object *env) { #endif } +// ARM Assembler + +object *sp_defcode (object *args, object *env) { + 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), newsymbol((18*40+30+regn)*2560000)); // Symbol for r0 etc + push(regpair,env); + regn++; + params = cdr(params); + } + + // Make *pc* a local variable + object *pcpair = cons(newsymbol(pack40((char*)"*pc*\0\0")), 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 + int bounds; + object *globals = GlobalEnv; + while (globals != NULL) { + object *pair = car(globals); + if (pair != NULL && car(pair) != var) { // 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) { // 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); iinteger = 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; +} + +object *call (int entry, int nargs, object *args, object *env) { + (void) env; + int param[4]; + for (int i=0; iinteger; + else param[i] = (uint32_t)arg; + args = cdr(args); + } + int w = ((intfn_ptr_type)&MyCode[entry])(param[0], param[1], param[2], param[3]); + return number(w); +} + +void putcode (object *arg, int origin, int pc) { + 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 +} + +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); + pfstring(PSTR(" "), 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; +} + // Tail-recursive forms object *tf_progn (object *args, object *env) { @@ -1901,6 +2147,25 @@ object *fn_symbolp (object *args, object *env) { return symbolp(arg) ? 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_set (object *args, object *env) { + object *arg = nil; + while (args != NULL) { + if (cdr(args) == NULL) error2(SET, PSTR("odd number of parameters")); + 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); @@ -2815,7 +3080,7 @@ object *fn_concatenate (object *args, object *env) { int chars = 0; while (args != NULL) { object *obj = first(args); - if (obj->type != STRING) error(CONCATENATE, notastring, obj); + if (!stringp(obj)) error(CONCATENATE, notastring, obj); obj = cdr(obj); while (obj != NULL) { int quad = obj->integer; @@ -2975,9 +3240,10 @@ object *fn_locals (object *args, object *env) { object *fn_makunbound (object *args, object *env) { (void) env; - object *key = first(args); - delassoc(key, &GlobalEnv); - return key; + object *var = first(args); + if (!symbolp(var)) error(MAKUNBOUND, notasymbol, var); + delassoc(var, &GlobalEnv); + return var; } object *fn_break (object *args, object *env) { @@ -3282,7 +3548,7 @@ void superprint (object *form, int lm, pfun_t pfun) { else supersub(form, lm + PPINDENT, 1, pfun); } -const int ppspecials = 15; +const int ppspecials = 16; const char ppspecial[ppspecials] PROGMEM = { DOTIMES, DOLIST, IF, SETQ, TEE, LET, LETSTAR, LAMBDA, WHEN, UNLESS, WITHI2C, WITHSERIAL, WITHSPI, WITHSDCARD, FORMILLIS }; @@ -3291,7 +3557,7 @@ void supersub (object *form, int lm, int super, pfun_t pfun) { object *arg = car(form); if (symbolp(arg)) { int name = arg->name; - if (name == DEFUN) special = 2; + if (name == DEFUN || name == DEFCODE) special = 2; else for (int i=0; iname == LAMBDA) { superprint(cons(symbol(DEFUN), cons(var, cdr(val))), 0, pserial); + } else if (consp(val) && car(val)->type == CODE) { + superprint(cons(symbol(DEFCODE), cons(var, cdr(val))), 0, pserial); } else { superprint(cons(symbol(DEFVAR),cons(var,cons(cons(symbol(QUOTE),cons(val,NULL)) ,NULL))), 0, pserial); @@ -3342,7 +3610,7 @@ object *fn_pprintall (object *args, object *env) { object *fn_require (object *args, object *env) { object *arg = first(args); object *globals = GlobalEnv; - if (!symbolp(arg)) error(REQUIRE, PSTR("argument is not a symbol"), arg); + if (!symbolp(arg)) error(REQUIRE, notasymbol, arg); while (globals != NULL) { object *pair = first(globals); object *var = car(pair); @@ -3411,154 +3679,157 @@ const char string26[] PROGMEM = "with-serial"; const char string27[] PROGMEM = "with-i2c"; const char string28[] PROGMEM = "with-spi"; const char string29[] PROGMEM = "with-sd-card"; -const char string30[] PROGMEM = "tail_forms"; -const char string31[] PROGMEM = "progn"; -const char string32[] PROGMEM = "if"; -const char string33[] PROGMEM = "cond"; -const char string34[] PROGMEM = "when"; -const char string35[] PROGMEM = "unless"; -const char string36[] PROGMEM = "case"; -const char string37[] PROGMEM = "and"; -const char string38[] PROGMEM = "or"; -const char string39[] PROGMEM = "functions"; -const char string40[] PROGMEM = "not"; -const char string41[] PROGMEM = "null"; -const char string42[] PROGMEM = "cons"; -const char string43[] PROGMEM = "atom"; -const char string44[] PROGMEM = "listp"; -const char string45[] PROGMEM = "consp"; -const char string46[] PROGMEM = "symbolp"; -const char string47[] PROGMEM = "streamp"; -const char string48[] PROGMEM = "eq"; -const char string49[] PROGMEM = "car"; -const char string50[] PROGMEM = "first"; -const char string51[] PROGMEM = "cdr"; -const char string52[] PROGMEM = "rest"; -const char string53[] PROGMEM = "caar"; -const char string54[] PROGMEM = "cadr"; -const char string55[] PROGMEM = "second"; -const char string56[] PROGMEM = "cdar"; -const char string57[] PROGMEM = "cddr"; -const char string58[] PROGMEM = "caaar"; -const char string59[] PROGMEM = "caadr"; -const char string60[] PROGMEM = "cadar"; -const char string61[] PROGMEM = "caddr"; -const char string62[] PROGMEM = "third"; -const char string63[] PROGMEM = "cdaar"; -const char string64[] PROGMEM = "cdadr"; -const char string65[] PROGMEM = "cddar"; -const char string66[] PROGMEM = "cdddr"; -const char string67[] PROGMEM = "length"; -const char string68[] PROGMEM = "list"; -const char string69[] PROGMEM = "reverse"; -const char string70[] PROGMEM = "nth"; -const char string71[] PROGMEM = "assoc"; -const char string72[] PROGMEM = "member"; -const char string73[] PROGMEM = "apply"; -const char string74[] PROGMEM = "funcall"; -const char string75[] PROGMEM = "append"; -const char string76[] PROGMEM = "mapc"; -const char string77[] PROGMEM = "mapcar"; -const char string78[] PROGMEM = "mapcan"; -const char string79[] PROGMEM = "+"; -const char string80[] PROGMEM = "-"; -const char string81[] PROGMEM = "*"; -const char string82[] PROGMEM = "/"; -const char string83[] PROGMEM = "mod"; -const char string84[] PROGMEM = "1+"; -const char string85[] PROGMEM = "1-"; -const char string86[] PROGMEM = "abs"; -const char string87[] PROGMEM = "random"; -const char string88[] PROGMEM = "max"; -const char string89[] PROGMEM = "min"; -const char string90[] PROGMEM = "/="; -const char string91[] PROGMEM = "="; -const char string92[] PROGMEM = "<"; -const char string93[] PROGMEM = "<="; -const char string94[] PROGMEM = ">"; -const char string95[] PROGMEM = ">="; -const char string96[] PROGMEM = "plusp"; -const char string97[] PROGMEM = "minusp"; -const char string98[] PROGMEM = "zerop"; -const char string99[] PROGMEM = "oddp"; -const char string100[] PROGMEM = "evenp"; -const char string101[] PROGMEM = "integerp"; -const char string102[] PROGMEM = "numberp"; -const char string103[] PROGMEM = "float"; -const char string104[] PROGMEM = "floatp"; -const char string105[] PROGMEM = "sin"; -const char string106[] PROGMEM = "cos"; -const char string107[] PROGMEM = "tan"; -const char string108[] PROGMEM = "asin"; -const char string109[] PROGMEM = "acos"; -const char string110[] PROGMEM = "atan"; -const char string111[] PROGMEM = "sinh"; -const char string112[] PROGMEM = "cosh"; -const char string113[] PROGMEM = "tanh"; -const char string114[] PROGMEM = "exp"; -const char string115[] PROGMEM = "sqrt"; -const char string116[] PROGMEM = "log"; -const char string117[] PROGMEM = "expt"; -const char string118[] PROGMEM = "ceiling"; -const char string119[] PROGMEM = "floor"; -const char string120[] PROGMEM = "truncate"; -const char string121[] PROGMEM = "round"; -const char string122[] PROGMEM = "char"; -const char string123[] PROGMEM = "char-code"; -const char string124[] PROGMEM = "code-char"; -const char string125[] PROGMEM = "characterp"; -const char string126[] PROGMEM = "stringp"; -const char string127[] PROGMEM = "string="; -const char string128[] PROGMEM = "string<"; -const char string129[] PROGMEM = "string>"; -const char string130[] PROGMEM = "sort"; -const char string131[] PROGMEM = "string"; -const char string132[] PROGMEM = "concatenate"; -const char string133[] PROGMEM = "subseq"; -const char string134[] PROGMEM = "read-from-string"; -const char string135[] PROGMEM = "princ-to-string"; -const char string136[] PROGMEM = "prin1-to-string"; -const char string137[] PROGMEM = "logand"; -const char string138[] PROGMEM = "logior"; -const char string139[] PROGMEM = "logxor"; -const char string140[] PROGMEM = "lognot"; -const char string141[] PROGMEM = "ash"; -const char string142[] PROGMEM = "logbitp"; -const char string143[] PROGMEM = "eval"; -const char string144[] PROGMEM = "globals"; -const char string145[] PROGMEM = "locals"; -const char string146[] PROGMEM = "makunbound"; -const char string147[] PROGMEM = "break"; -const char string148[] PROGMEM = "read"; -const char string149[] PROGMEM = "prin1"; -const char string150[] PROGMEM = "print"; -const char string151[] PROGMEM = "princ"; -const char string152[] PROGMEM = "terpri"; -const char string153[] PROGMEM = "read-byte"; -const char string154[] PROGMEM = "read-line"; -const char string155[] PROGMEM = "write-byte"; -const char string156[] PROGMEM = "write-string"; -const char string157[] PROGMEM = "write-line"; -const char string158[] PROGMEM = "restart-i2c"; -const char string159[] PROGMEM = "gc"; -const char string160[] PROGMEM = "room"; -const char string161[] PROGMEM = "save-image"; -const char string162[] PROGMEM = "load-image"; -const char string163[] PROGMEM = "cls"; -const char string164[] PROGMEM = "pinmode"; -const char string165[] PROGMEM = "digitalread"; -const char string166[] PROGMEM = "digitalwrite"; -const char string167[] PROGMEM = "analogread"; -const char string168[] PROGMEM = "analogwrite"; -const char string169[] PROGMEM = "delay"; -const char string170[] PROGMEM = "millis"; -const char string171[] PROGMEM = "sleep"; -const char string172[] PROGMEM = "note"; -const char string173[] PROGMEM = "edit"; -const char string174[] PROGMEM = "pprint"; -const char string175[] PROGMEM = "pprintall"; -const char string176[] PROGMEM = "require"; -const char string177[] PROGMEM = "list-library"; +const char string30[] PROGMEM = "defcode"; +const char string31[] PROGMEM = "tail_forms"; +const char string32[] PROGMEM = "progn"; +const char string33[] PROGMEM = "if"; +const char string34[] PROGMEM = "cond"; +const char string35[] PROGMEM = "when"; +const char string36[] PROGMEM = "unless"; +const char string37[] PROGMEM = "case"; +const char string38[] PROGMEM = "and"; +const char string39[] PROGMEM = "or"; +const char string40[] PROGMEM = "functions"; +const char string41[] PROGMEM = "not"; +const char string42[] PROGMEM = "null"; +const char string43[] PROGMEM = "cons"; +const char string44[] PROGMEM = "atom"; +const char string45[] PROGMEM = "listp"; +const char string46[] PROGMEM = "consp"; +const char string47[] PROGMEM = "symbolp"; +const char string48[] PROGMEM = "boundp"; +const char string49[] PROGMEM = "set"; +const char string50[] PROGMEM = "streamp"; +const char string51[] PROGMEM = "eq"; +const char string52[] PROGMEM = "car"; +const char string53[] PROGMEM = "first"; +const char string54[] PROGMEM = "cdr"; +const char string55[] PROGMEM = "rest"; +const char string56[] PROGMEM = "caar"; +const char string57[] PROGMEM = "cadr"; +const char string58[] PROGMEM = "second"; +const char string59[] PROGMEM = "cdar"; +const char string60[] PROGMEM = "cddr"; +const char string61[] PROGMEM = "caaar"; +const char string62[] PROGMEM = "caadr"; +const char string63[] PROGMEM = "cadar"; +const char string64[] PROGMEM = "caddr"; +const char string65[] PROGMEM = "third"; +const char string66[] PROGMEM = "cdaar"; +const char string67[] PROGMEM = "cdadr"; +const char string68[] PROGMEM = "cddar"; +const char string69[] PROGMEM = "cdddr"; +const char string70[] PROGMEM = "length"; +const char string71[] PROGMEM = "list"; +const char string72[] PROGMEM = "reverse"; +const char string73[] PROGMEM = "nth"; +const char string74[] PROGMEM = "assoc"; +const char string75[] PROGMEM = "member"; +const char string76[] PROGMEM = "apply"; +const char string77[] PROGMEM = "funcall"; +const char string78[] PROGMEM = "append"; +const char string79[] PROGMEM = "mapc"; +const char string80[] PROGMEM = "mapcar"; +const char string81[] PROGMEM = "mapcan"; +const char string82[] PROGMEM = "+"; +const char string83[] PROGMEM = "-"; +const char string84[] PROGMEM = "*"; +const char string85[] PROGMEM = "/"; +const char string86[] PROGMEM = "mod"; +const char string87[] PROGMEM = "1+"; +const char string88[] PROGMEM = "1-"; +const char string89[] PROGMEM = "abs"; +const char string90[] PROGMEM = "random"; +const char string91[] PROGMEM = "max"; +const char string92[] PROGMEM = "min"; +const char string93[] PROGMEM = "/="; +const char string94[] PROGMEM = "="; +const char string95[] PROGMEM = "<"; +const char string96[] PROGMEM = "<="; +const char string97[] PROGMEM = ">"; +const char string98[] PROGMEM = ">="; +const char string99[] PROGMEM = "plusp"; +const char string100[] PROGMEM = "minusp"; +const char string101[] PROGMEM = "zerop"; +const char string102[] PROGMEM = "oddp"; +const char string103[] PROGMEM = "evenp"; +const char string104[] PROGMEM = "integerp"; +const char string105[] PROGMEM = "numberp"; +const char string106[] PROGMEM = "float"; +const char string107[] PROGMEM = "floatp"; +const char string108[] PROGMEM = "sin"; +const char string109[] PROGMEM = "cos"; +const char string110[] PROGMEM = "tan"; +const char string111[] PROGMEM = "asin"; +const char string112[] PROGMEM = "acos"; +const char string113[] PROGMEM = "atan"; +const char string114[] PROGMEM = "sinh"; +const char string115[] PROGMEM = "cosh"; +const char string116[] PROGMEM = "tanh"; +const char string117[] PROGMEM = "exp"; +const char string118[] PROGMEM = "sqrt"; +const char string119[] PROGMEM = "log"; +const char string120[] PROGMEM = "expt"; +const char string121[] PROGMEM = "ceiling"; +const char string122[] PROGMEM = "floor"; +const char string123[] PROGMEM = "truncate"; +const char string124[] PROGMEM = "round"; +const char string125[] PROGMEM = "char"; +const char string126[] PROGMEM = "char-code"; +const char string127[] PROGMEM = "code-char"; +const char string128[] PROGMEM = "characterp"; +const char string129[] PROGMEM = "stringp"; +const char string130[] PROGMEM = "string="; +const char string131[] PROGMEM = "string<"; +const char string132[] PROGMEM = "string>"; +const char string133[] PROGMEM = "sort"; +const char string134[] PROGMEM = "string"; +const char string135[] PROGMEM = "concatenate"; +const char string136[] PROGMEM = "subseq"; +const char string137[] PROGMEM = "read-from-string"; +const char string138[] PROGMEM = "princ-to-string"; +const char string139[] PROGMEM = "prin1-to-string"; +const char string140[] PROGMEM = "logand"; +const char string141[] PROGMEM = "logior"; +const char string142[] PROGMEM = "logxor"; +const char string143[] PROGMEM = "lognot"; +const char string144[] PROGMEM = "ash"; +const char string145[] PROGMEM = "logbitp"; +const char string146[] PROGMEM = "eval"; +const char string147[] PROGMEM = "globals"; +const char string148[] PROGMEM = "locals"; +const char string149[] PROGMEM = "makunbound"; +const char string150[] PROGMEM = "break"; +const char string151[] PROGMEM = "read"; +const char string152[] PROGMEM = "prin1"; +const char string153[] PROGMEM = "print"; +const char string154[] PROGMEM = "princ"; +const char string155[] PROGMEM = "terpri"; +const char string156[] PROGMEM = "read-byte"; +const char string157[] PROGMEM = "read-line"; +const char string158[] PROGMEM = "write-byte"; +const char string159[] PROGMEM = "write-string"; +const char string160[] PROGMEM = "write-line"; +const char string161[] PROGMEM = "restart-i2c"; +const char string162[] PROGMEM = "gc"; +const char string163[] PROGMEM = "room"; +const char string164[] PROGMEM = "save-image"; +const char string165[] PROGMEM = "load-image"; +const char string166[] PROGMEM = "cls"; +const char string167[] PROGMEM = "pinmode"; +const char string168[] PROGMEM = "digitalread"; +const char string169[] PROGMEM = "digitalwrite"; +const char string170[] PROGMEM = "analogread"; +const char string171[] PROGMEM = "analogwrite"; +const char string172[] PROGMEM = "delay"; +const char string173[] PROGMEM = "millis"; +const char string174[] PROGMEM = "sleep"; +const char string175[] PROGMEM = "note"; +const char string176[] PROGMEM = "edit"; +const char string177[] PROGMEM = "pprint"; +const char string178[] PROGMEM = "pprintall"; +const char string179[] PROGMEM = "require"; +const char string180[] PROGMEM = "list-library"; const tbl_entry_t lookup_table[] PROGMEM = { { string0, NULL, 0, 0 }, @@ -3572,8 +3843,8 @@ const tbl_entry_t lookup_table[] PROGMEM = { { string8, NULL, 0, 127 }, { string9, NULL, NIL, NIL }, { string10, sp_quote, 1, 1 }, - { string11, sp_defun, 0, 127 }, - { string12, sp_defvar, 2, 2 }, + { string11, sp_defun, 2, 127 }, + { string12, sp_defvar, 1, 2 }, { string13, sp_setq, 2, 126 }, { string14, sp_loop, 0, 127 }, { string15, sp_return, 0, 127 }, @@ -3591,154 +3862,157 @@ const tbl_entry_t lookup_table[] PROGMEM = { { string27, sp_withi2c, 1, 127 }, { string28, sp_withspi, 1, 127 }, { string29, sp_withsdcard, 2, 127 }, - { string30, NULL, NIL, NIL }, - { string31, tf_progn, 0, 127 }, - { string32, tf_if, 2, 3 }, - { string33, tf_cond, 0, 127 }, - { string34, tf_when, 1, 127 }, - { string35, tf_unless, 1, 127 }, - { string36, tf_case, 1, 127 }, - { string37, tf_and, 0, 127 }, - { string38, tf_or, 0, 127 }, - { string39, NULL, NIL, NIL }, - { string40, fn_not, 1, 1 }, + { string30, sp_defcode, 0, 127 }, + { string31, NULL, NIL, NIL }, + { string32, tf_progn, 0, 127 }, + { string33, tf_if, 2, 3 }, + { string34, tf_cond, 0, 127 }, + { string35, tf_when, 1, 127 }, + { string36, tf_unless, 1, 127 }, + { string37, tf_case, 1, 127 }, + { string38, tf_and, 0, 127 }, + { string39, tf_or, 0, 127 }, + { string40, NULL, NIL, NIL }, { string41, fn_not, 1, 1 }, - { string42, fn_cons, 2, 2 }, - { string43, fn_atom, 1, 1 }, - { string44, fn_listp, 1, 1 }, - { string45, fn_consp, 1, 1 }, - { string46, fn_symbolp, 1, 1 }, - { string47, fn_streamp, 1, 1 }, - { string48, fn_eq, 2, 2 }, - { string49, fn_car, 1, 1 }, - { string50, fn_car, 1, 1 }, - { string51, fn_cdr, 1, 1 }, - { string52, fn_cdr, 1, 1 }, - { string53, fn_caar, 1, 1 }, - { string54, fn_cadr, 1, 1 }, - { string55, fn_cadr, 1, 1 }, - { string56, fn_cdar, 1, 1 }, - { string57, fn_cddr, 1, 1 }, - { string58, fn_caaar, 1, 1 }, - { string59, fn_caadr, 1, 1 }, - { string60, fn_cadar, 1, 1 }, - { string61, fn_caddr, 1, 1 }, - { string62, fn_caddr, 1, 1 }, - { string63, fn_cdaar, 1, 1 }, - { string64, fn_cdadr, 1, 1 }, - { string65, fn_cddar, 1, 1 }, - { string66, fn_cdddr, 1, 1 }, - { string67, fn_length, 1, 1 }, - { string68, fn_list, 0, 127 }, - { string69, fn_reverse, 1, 1 }, - { string70, fn_nth, 2, 2 }, - { string71, fn_assoc, 2, 2 }, - { string72, fn_member, 2, 2 }, - { string73, fn_apply, 2, 127 }, - { string74, fn_funcall, 1, 127 }, - { string75, fn_append, 0, 127 }, - { string76, fn_mapc, 2, 127 }, - { string77, fn_mapcar, 2, 127 }, - { string78, fn_mapcan, 2, 127 }, - { string79, fn_add, 0, 127 }, - { string80, fn_subtract, 1, 127 }, - { string81, fn_multiply, 0, 127 }, - { string82, fn_divide, 1, 127 }, - { string83, fn_mod, 2, 2 }, - { string84, fn_oneplus, 1, 1 }, - { string85, fn_oneminus, 1, 1 }, - { string86, fn_abs, 1, 1 }, - { string87, fn_random, 1, 1 }, - { string88, fn_maxfn, 1, 127 }, - { string89, fn_minfn, 1, 127 }, - { string90, fn_noteq, 1, 127 }, - { string91, fn_numeq, 1, 127 }, - { string92, fn_less, 1, 127 }, - { string93, fn_lesseq, 1, 127 }, - { string94, fn_greater, 1, 127 }, - { string95, fn_greatereq, 1, 127 }, - { string96, fn_plusp, 1, 1 }, - { string97, fn_minusp, 1, 1 }, - { string98, fn_zerop, 1, 1 }, - { string99, fn_oddp, 1, 1 }, - { string100, fn_evenp, 1, 1 }, - { string101, fn_integerp, 1, 1 }, - { string102, fn_numberp, 1, 1 }, - { string103, fn_floatfn, 1, 1 }, - { string104, fn_floatp, 1, 1 }, - { string105, fn_sin, 1, 1 }, - { string106, fn_cos, 1, 1 }, - { string107, fn_tan, 1, 1 }, - { string108, fn_asin, 1, 1 }, - { string109, fn_acos, 1, 1 }, - { string110, fn_atan, 1, 2 }, - { string111, fn_sinh, 1, 1 }, - { string112, fn_cosh, 1, 1 }, - { string113, fn_tanh, 1, 1 }, - { string114, fn_exp, 1, 1 }, - { string115, fn_sqrt, 1, 1 }, - { string116, fn_log, 1, 2 }, - { string117, fn_expt, 2, 2 }, - { string118, fn_ceiling, 1, 2 }, - { string119, fn_floor, 1, 2 }, - { string120, fn_truncate, 1, 2 }, - { string121, fn_round, 1, 2 }, - { string122, fn_char, 2, 2 }, - { string123, fn_charcode, 1, 1 }, - { string124, fn_codechar, 1, 1 }, - { string125, fn_characterp, 1, 1 }, - { string126, fn_stringp, 1, 1 }, - { string127, fn_stringeq, 2, 2 }, - { string128, fn_stringless, 2, 2 }, - { string129, fn_stringgreater, 2, 2 }, - { string130, fn_sort, 2, 2 }, - { string131, fn_stringfn, 1, 1 }, - { string132, fn_concatenate, 1, 127 }, - { string133, fn_subseq, 2, 3 }, - { string134, fn_readfromstring, 1, 1 }, - { string135, fn_princtostring, 1, 1 }, - { string136, fn_prin1tostring, 1, 1 }, - { string137, fn_logand, 0, 127 }, - { string138, fn_logior, 0, 127 }, - { string139, fn_logxor, 0, 127 }, - { string140, fn_lognot, 1, 1 }, - { string141, fn_ash, 2, 2 }, - { string142, fn_logbitp, 2, 2 }, - { string143, fn_eval, 1, 1 }, - { string144, fn_globals, 0, 0 }, - { string145, fn_locals, 0, 0 }, - { string146, fn_makunbound, 1, 1 }, - { string147, fn_break, 0, 0 }, - { string148, fn_read, 0, 1 }, - { string149, fn_prin1, 1, 2 }, - { string150, fn_print, 1, 2 }, - { string151, fn_princ, 1, 2 }, - { string152, fn_terpri, 0, 1 }, - { string153, fn_readbyte, 0, 2 }, - { string154, fn_readline, 0, 1 }, - { string155, fn_writebyte, 1, 2 }, - { string156, fn_writestring, 1, 2 }, - { string157, fn_writeline, 1, 2 }, - { string158, fn_restarti2c, 1, 2 }, - { string159, fn_gc, 0, 0 }, - { string160, fn_room, 0, 0 }, - { string161, fn_saveimage, 0, 1 }, - { string162, fn_loadimage, 0, 1 }, - { string163, fn_cls, 0, 0 }, - { string164, fn_pinmode, 2, 2 }, - { string165, fn_digitalread, 1, 1 }, - { string166, fn_digitalwrite, 2, 2 }, - { string167, fn_analogread, 1, 1 }, - { string168, fn_analogwrite, 2, 2 }, - { string169, fn_delay, 1, 1 }, - { string170, fn_millis, 0, 0 }, - { string171, fn_sleep, 1, 1 }, - { string172, fn_note, 0, 3 }, - { string173, fn_edit, 1, 1 }, - { string174, fn_pprint, 1, 2 }, - { string175, fn_pprintall, 0, 0 }, - { string176, fn_require, 1, 1 }, - { string177, fn_listlibrary, 0, 0 }, + { string42, fn_not, 1, 1 }, + { string43, fn_cons, 2, 2 }, + { string44, fn_atom, 1, 1 }, + { string45, fn_listp, 1, 1 }, + { string46, fn_consp, 1, 1 }, + { string47, fn_symbolp, 1, 1 }, + { string48, fn_boundp, 1, 1 }, + { string49, fn_set, 2, 126 }, + { string50, fn_streamp, 1, 1 }, + { string51, fn_eq, 2, 2 }, + { string52, fn_car, 1, 1 }, + { string53, fn_car, 1, 1 }, + { string54, fn_cdr, 1, 1 }, + { string55, fn_cdr, 1, 1 }, + { string56, fn_caar, 1, 1 }, + { string57, fn_cadr, 1, 1 }, + { string58, fn_cadr, 1, 1 }, + { string59, fn_cdar, 1, 1 }, + { string60, fn_cddr, 1, 1 }, + { string61, fn_caaar, 1, 1 }, + { string62, fn_caadr, 1, 1 }, + { string63, fn_cadar, 1, 1 }, + { string64, fn_caddr, 1, 1 }, + { string65, fn_caddr, 1, 1 }, + { string66, fn_cdaar, 1, 1 }, + { string67, fn_cdadr, 1, 1 }, + { string68, fn_cddar, 1, 1 }, + { string69, fn_cdddr, 1, 1 }, + { string70, fn_length, 1, 1 }, + { string71, fn_list, 0, 127 }, + { string72, fn_reverse, 1, 1 }, + { string73, fn_nth, 2, 2 }, + { string74, fn_assoc, 2, 2 }, + { string75, fn_member, 2, 2 }, + { string76, fn_apply, 2, 127 }, + { string77, fn_funcall, 1, 127 }, + { string78, fn_append, 0, 127 }, + { string79, fn_mapc, 2, 127 }, + { string80, fn_mapcar, 2, 127 }, + { string81, fn_mapcan, 2, 127 }, + { string82, fn_add, 0, 127 }, + { string83, fn_subtract, 1, 127 }, + { string84, fn_multiply, 0, 127 }, + { string85, fn_divide, 1, 127 }, + { string86, fn_mod, 2, 2 }, + { string87, fn_oneplus, 1, 1 }, + { string88, fn_oneminus, 1, 1 }, + { string89, fn_abs, 1, 1 }, + { string90, fn_random, 1, 1 }, + { string91, fn_maxfn, 1, 127 }, + { string92, fn_minfn, 1, 127 }, + { string93, fn_noteq, 1, 127 }, + { string94, fn_numeq, 1, 127 }, + { string95, fn_less, 1, 127 }, + { string96, fn_lesseq, 1, 127 }, + { string97, fn_greater, 1, 127 }, + { string98, fn_greatereq, 1, 127 }, + { string99, fn_plusp, 1, 1 }, + { string100, fn_minusp, 1, 1 }, + { string101, fn_zerop, 1, 1 }, + { string102, fn_oddp, 1, 1 }, + { string103, fn_evenp, 1, 1 }, + { string104, fn_integerp, 1, 1 }, + { string105, fn_numberp, 1, 1 }, + { string106, fn_floatfn, 1, 1 }, + { string107, fn_floatp, 1, 1 }, + { string108, fn_sin, 1, 1 }, + { string109, fn_cos, 1, 1 }, + { string110, fn_tan, 1, 1 }, + { string111, fn_asin, 1, 1 }, + { string112, fn_acos, 1, 1 }, + { string113, fn_atan, 1, 2 }, + { string114, fn_sinh, 1, 1 }, + { string115, fn_cosh, 1, 1 }, + { string116, fn_tanh, 1, 1 }, + { string117, fn_exp, 1, 1 }, + { string118, fn_sqrt, 1, 1 }, + { string119, fn_log, 1, 2 }, + { string120, fn_expt, 2, 2 }, + { string121, fn_ceiling, 1, 2 }, + { string122, fn_floor, 1, 2 }, + { string123, fn_truncate, 1, 2 }, + { string124, fn_round, 1, 2 }, + { string125, fn_char, 2, 2 }, + { string126, fn_charcode, 1, 1 }, + { string127, fn_codechar, 1, 1 }, + { string128, fn_characterp, 1, 1 }, + { string129, fn_stringp, 1, 1 }, + { string130, fn_stringeq, 2, 2 }, + { string131, fn_stringless, 2, 2 }, + { string132, fn_stringgreater, 2, 2 }, + { string133, fn_sort, 2, 2 }, + { string134, fn_stringfn, 1, 1 }, + { string135, fn_concatenate, 1, 127 }, + { string136, fn_subseq, 2, 3 }, + { string137, fn_readfromstring, 1, 1 }, + { string138, fn_princtostring, 1, 1 }, + { string139, fn_prin1tostring, 1, 1 }, + { string140, fn_logand, 0, 127 }, + { string141, fn_logior, 0, 127 }, + { string142, fn_logxor, 0, 127 }, + { string143, fn_lognot, 1, 1 }, + { string144, fn_ash, 2, 2 }, + { string145, fn_logbitp, 2, 2 }, + { string146, fn_eval, 1, 1 }, + { string147, fn_globals, 0, 0 }, + { string148, fn_locals, 0, 0 }, + { string149, fn_makunbound, 1, 1 }, + { string150, fn_break, 0, 0 }, + { string151, fn_read, 0, 1 }, + { string152, fn_prin1, 1, 2 }, + { string153, fn_print, 1, 2 }, + { string154, fn_princ, 1, 2 }, + { string155, fn_terpri, 0, 1 }, + { string156, fn_readbyte, 0, 2 }, + { string157, fn_readline, 0, 1 }, + { string158, fn_writebyte, 1, 2 }, + { string159, fn_writestring, 1, 2 }, + { string160, fn_writeline, 1, 2 }, + { string161, fn_restarti2c, 1, 2 }, + { string162, fn_gc, 0, 0 }, + { string163, fn_room, 0, 0 }, + { string164, fn_saveimage, 0, 1 }, + { string165, fn_loadimage, 0, 1 }, + { string166, fn_cls, 0, 0 }, + { string167, fn_pinmode, 2, 2 }, + { string168, fn_digitalread, 1, 1 }, + { string169, fn_digitalwrite, 2, 2 }, + { string170, fn_analogread, 1, 1 }, + { string171, fn_analogwrite, 2, 2 }, + { string172, fn_delay, 1, 1 }, + { string173, fn_millis, 0, 0 }, + { string174, fn_sleep, 1, 1 }, + { string175, fn_note, 0, 3 }, + { string176, fn_edit, 1, 1 }, + { string177, fn_pprint, 1, 2 }, + { string178, fn_pprintall, 0, 0 }, + { string179, fn_require, 1, 1 }, + { string180, fn_listlibrary, 0, 0 }, }; // Table lookup functions @@ -3760,11 +4034,10 @@ int longsymbol (char *buffer) { if (p == buffer) { // Add to symbol table? char *newtop = SymbolTop + strlen(p) + 1; - if (SYMBOLTABLESIZE - (newtop - SymbolTable) < BUFFERSIZE) error2(0, PSTR("no room for long symbols")); + if (SYMBOLTABLESIZE - (newtop - SymbolTable) < BUFFERSIZE) error2(0, PSTR("symbol table full")); SymbolTop = newtop; } - if (i > 1535) error2(0, PSTR("Too many long symbols")); - return i + 64000; // First number unused by radix40 + return i + MAXSYMBOL; // First number unused by radix40 } intptr_t lookupfn (symbol_t name) { @@ -3787,7 +4060,7 @@ char *lookupbuiltin (symbol_t name) { char *lookupsymbol (symbol_t name) { char *p = SymbolTable; - int i = name - 64000; + int i = name - MAXSYMBOL; while (i > 0 && p < SymbolTop) {p = p + strlen(p) + 1; i--; } if (p == SymbolTop) return NULL; else return p; } @@ -3807,28 +4080,29 @@ void testescape () { // Main evaluator -uint8_t End; +extern uint32_t end; // Bottom of stack object *eval (object *form, object *env) { + register int *sp asm ("r13"); int TC=0; EVAL: - yield(); // Needed on ESP8266 to avoid Soft WDT Reset // Enough space? - if (End != 0xA5) error2(0, PSTR("Stack overflow")); + // Serial.println((uint32_t)sp); + if (((uint32_t)sp - (uint32_t)&end) < STACKDIFF) error2(0, PSTR("Stack overflow")); if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // Escape if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(0, PSTR("Escape!"));} #if defined (serialmonitor) if (!tstflag(NOESC)) testescape(); #endif - - if (form == NULL) return nil; - if (integerp(form) || floatp(form) || characterp(form) || stringp(form)) return form; + if (form == NULL) return nil; + + if (form->type >= NUMBER && form->type <= STRING) return form; if (symbolp(form)) { symbol_t name = form->name; - if (name == NIL) return nil; + if (name == NIL) error2(0, PSTR("Error 1")); // return nil; object *pair = value(name, env); if (pair != NULL) return cdr(pair); pair = value(name, GlobalEnv); @@ -3836,6 +4110,8 @@ object *eval (object *form, object *env) { else if (name <= ENDFUNCTIONS) return form; error(0, PSTR("undefined"), form); } + + if (form->type == CODE) error2(0, PSTR("can't evaluate CODE header")); // It's a list object *function = car(form); @@ -3843,7 +4119,7 @@ object *eval (object *form, object *env) { if (function == NULL) error(0, PSTR("illegal function"), nil); if (!listp(args)) error(0, PSTR("can't evaluate a dotted pair"), args); - + // List starts with a symbol? if (symbolp(function)) { symbol_t name = function->name; @@ -3880,8 +4156,6 @@ object *eval (object *form, object *env) { } return cons(symbol(CLOSURE), cons(envcopy,args)); } - - if (name < SPECIAL_FORMS) error2((int)function, PSTR("can't be used as a function")); if ((name > SPECIAL_FORMS) && (name < TAIL_FORMS)) { return ((fn_ptr_type)lookupfn(name))(args, env); @@ -3892,12 +4166,14 @@ object *eval (object *form, object *env) { TC = 1; goto EVAL; } + + if (name < SPECIAL_FORMS) error2((int)function, 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(car(form), env), NULL); + object *head = cons(eval(fname, env), NULL); push(head, GCStack); // Don't GC the result list object *tail = head; form = cdr(form); @@ -3923,33 +4199,45 @@ object *eval (object *form, object *env) { pop(GCStack); return result; } - - if (consp(function) && issymbol(car(function), LAMBDA)) { - form = closure(TCstart, fname->name, NULL, cdr(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 { + + if (consp(function)) { + + if (issymbol(car(function), LAMBDA)) { + form = closure(TCstart, fname->name, NULL, cdr(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 (issymbol(car(function), CLOSURE)) { + function = cdr(function); + form = closure(TCstart, fname->name, car(function), cdr(function), args, &env); + pop(GCStack); TC = 1; goto EVAL; } - } - if (consp(function) && issymbol(car(function), CLOSURE)) { - function = cdr(function); - form = closure(TCstart, fname->name, car(function), cdr(function), args, &env); - pop(GCStack); - TC = 1; - goto EVAL; - } - + if (car(function)->type == CODE) { + int n = listlength(DEFCODE, second(function)); + if (nargsname, PSTR("has too few arguments")); + if (nargs>n) error2(fname->name, PSTR("has too many arguments")); + uint32_t entry = startblock(car(function)) + 1; + pop(GCStack); + return call(entry, n, args, env); + } + + } error(0, PSTR("illegal function"), fname); return nil; } @@ -4024,6 +4312,31 @@ void pint (int i, pfun_t pfun) { } } +void pinthex (uint32_t i, pfun_t pfun) { + int lead = 0; + #if INT_MAX == 32767 + uint32_t p = 0x1000; + #else + uint32_t p = 0x10000000; + #endif + pfun('#'); pfun('x'); + for (uint32_t d=p; d>0; d=d/16) { + 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); @@ -4097,13 +4410,15 @@ void printobject (object *form, pfun_t pfun){ printobject(form, pfun); } pfun(')'); - } else if (integerp(form)) pint(form->integer, pfun); + } else if (form->type == NUMHEX) pinthex(form->integer, 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 != NOTHING) pstring(symbolname(form->name), pfun); } else if (characterp(form)) pcharacter(form->integer, pfun); else if (stringp(form)) printstring(form, pfun); + else if (form->type == CODE) pfstring(PSTR("code"), pfun); else if (streamp(form)) { - pfstring(PSTR("<"), pfun); + pfun('<'); if ((form->integer)>>8 == SPISTREAM) pfstring(PSTR("spi"), pfun); else if ((form->integer)>>8 == I2CSTREAM) pfstring(PSTR("i2c"), pfun); else if ((form->integer)>>8 == SDSTREAM) pfstring(PSTR("sd"), pfun); @@ -4189,7 +4504,11 @@ object *nextitem (gfun_t gfun) { ch = gfun(); char ch2 = ch & ~0x20; // force to upper case if (ch == '\\') base = 0; // character - else if (ch2 == 'B') base = 2; + 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); @@ -4205,7 +4524,7 @@ object *nextitem (gfun_t gfun) { if (ch == '.') valid = 0; else if (digitvalue(ch) ((unsigned int)INT_MAX+(1-sign)/2)) return makefloat((float)result*sign); - return number(result*sign); + if (base == 16) return numhex(result*sign); else return number(result*sign); } else if (base == 0) { if (index == 1) return character(buffer[0]); const char* p = ControlCodes; char c = 0; @@ -4255,7 +4574,7 @@ object *nextitem (gfun_t gfun) { int x = builtin(buffer); if (x == NIL) return nil; if (x < ENDFUNCTIONS) return newsymbol(x); - else if (index < 4 && valid40(buffer)) return newsymbol(pack40(buffer)); + else if (index <= 6 && valid40(buffer)) return newsymbol(pack40(buffer)); else return newsymbol(longsymbol(buffer)); } @@ -4307,7 +4626,7 @@ void setup () { initworkspace(); initenv(); initsleep(); - pfstring(PSTR("uLisp 3.0 "), pserial); pln(pserial); + pfstring(PSTR("uLisp 3.1 "), pserial); pln(pserial); } // Read/Evaluate/Print loop @@ -4339,7 +4658,6 @@ void repl (object *env) { } void loop () { - End = 0xA5; // Canary to check stack if (!setjmp(exception)) { #if defined(resetautorun) volatile int autorun = 12; // Fudge to keep code size the same @@ -4350,6 +4668,7 @@ void loop () { } // Come here after error delay(100); while (Serial.available()) Serial.read(); + clrflag(NOESC); for (int i=0; i