From 8feea7b85d3fcb277c84a6d22acce4a5947a5cdc Mon Sep 17 00:00:00 2001 From: David Johnson-Davies Date: Fri, 20 Sep 2019 11:43:52 +0100 Subject: [PATCH] Version 2.9 - 20th September 2019 Fixes #15 --- ulisp-arm.ino | 446 +++++++++++++++++++++++++------------------------- 1 file changed, 222 insertions(+), 224 deletions(-) diff --git a/ulisp-arm.ino b/ulisp-arm.ino index baaa2db..ff8291d 100644 --- a/ulisp-arm.ino +++ b/ulisp-arm.ino @@ -1,5 +1,5 @@ -/* uLisp ARM 2.8d - www.ulisp.com - David Johnson-Davies - www.technoblogy.com - 8th September 2019 +/* uLisp ARM 2.9 - www.ulisp.com + David Johnson-Davies - www.technoblogy.com - 20th September 2019 Licensed under the MIT license: https://opensource.org/licenses/MIT */ @@ -69,8 +69,8 @@ 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, PUSH, POP, INCF, DECF, SETF, DOLIST, DOTIMES, TRACE, UNTRACE, FORMILLIS, -WITHSERIAL, WITHI2C, WITHSPI, WITHSDCARD, TAIL_FORMS, PROGN, RETURN, IF, COND, WHEN, UNLESS, CASE, AND, +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, @@ -115,76 +115,78 @@ typedef struct { typedef int (*gfun_t)(); typedef void (*pfun_t)(char); +typedef int PinMode; // Workspace #define PERSIST __attribute__((section(".text"))) #define WORDALIGNED __attribute__((aligned (4))) #define BUFFERSIZE 34 // Number of bits+2 -#if defined(ADAFRUIT_ITSYBITSY_M0) - #define WORKSPACESIZE 3072-SDSIZE /* Cells (8*bytes) */ +#if defined(ARDUINO_ITSYBITSY_M0) + #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define DATAFLASHSIZE 2048000 /* 2 MBytes */ #define SYMBOLTABLESIZE 512 /* Bytes */ uint8_t _end; -#elif defined(ADAFRUIT_GEMMA_M0) - #define WORKSPACESIZE 3072-SDSIZE /* Cells (8*bytes) */ - #define SYMBOLTABLESIZE 512 /* Bytes */ +#elif defined(ARDUINO_GEMMA_M0) + #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ + #define SYMBOLTABLESIZE 512 /* Bytes */ uint8_t _end; -#elif defined(ADAFRUIT_FEATHER_M0_EXPRESS) - #define WORKSPACESIZE 3072-SDSIZE /* Cells (8*bytes) */ - #define SYMBOLTABLESIZE 512 /* Bytes */ +#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(ADAFRUIT_METRO_M4_EXPRESS) - #define WORKSPACESIZE 20480-SDSIZE /* Cells (8*bytes) */ +#elif defined(ARDUINO_METRO_M4) + #define WORKSPACESIZE 20480-SDSIZE /* Objects (8*bytes) */ #define DATAFLASHSIZE 2048000 /* 2 MBytes */ + #define SYMBOLTABLESIZE 1024 /* Bytes */ uint8_t _end; -#elif defined(ADAFRUIT_ITSYBITSY_M4) - #define WORKSPACESIZE 20480-SDSIZE /* Cells (8*bytes) */ +#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(ADAFRUIT_FEATHER_M4) - #define WORKSPACESIZE 20480-SDSIZE /* Cells (8*bytes) */ +#elif 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(ADAFRUIT_GRAND_CENTRAL_M4) - #define WORKSPACESIZE 30720-SDSIZE /* Cells (8*bytes) */ +#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 /* Cells (8*bytes) */ + #define WORKSPACESIZE 10240-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 1024 /* Bytes */ #define SDCARD_SS_PIN 10 extern uint8_t _end; #elif defined(ARDUINO_SAMD_MKRZERO) - #define WORKSPACESIZE 3072-SDSIZE /* Cells (8*bytes) */ + #define WORKSPACESIZE 3072-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ uint8_t _end; -#elif defined(ARDUINO_SAMD_ZERO) /* Put this last, otherwise overrides the Adafruit boards */ - #define WORKSPACESIZE 3072-SDSIZE /* Cells (8*bytes) */ +#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 SDCARD_SS_PIN 10 uint8_t _end; #elif defined(_VARIANT_BBC_MICROBIT_) - #define WORKSPACESIZE 1280 /* Cells (8*bytes) */ + #define WORKSPACESIZE 1280 /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 512 /* Bytes */ uint8_t _end; #elif defined(MAX32620) - #define WORKSPACESIZE 24576-SDSIZE /* Cells (8*bytes) */ + #define WORKSPACESIZE 24576-SDSIZE /* Objects (8*bytes) */ #define SYMBOLTABLESIZE 1024 /* Bytes */ uint8_t _end; @@ -210,10 +212,9 @@ int GlobalStringIndex = 0; char BreakLevel = 0; char LastChar = 0; char LastPrint = 0; -char PrintReadably = 1; // Flags -enum flag { RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED }; +enum flag { PRINTREADABLY, RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED }; volatile char Flags; // Forward references @@ -441,15 +442,15 @@ void SDWriteInt (File file, int data) { #define READID 0x90 // Arduino pins used for dataflash -#if defined(ADAFRUIT_ITSYBITSY_M0) +#if defined(ARDUINO_ITSYBITSY_M0) const int sck = 38, ssel = 39, mosi = 37, miso = 36; -#elif defined(ADAFRUIT_ITSYBITSY_M4) +#elif defined(ARDUINO_ITSYBITSY_M4) const int sck = 32, ssel = 33, mosi = 34, miso = 35; #elif defined(ARDUINO_METRO_M4) const int sck = 41, ssel = 42, mosi = 43, miso = 44; -#elif defined(ADAFRUIT_FEATHER_M4) +#elif defined(ARDUINO_FEATHER_M4) const int sck = 34, ssel = 35, mosi = 36, miso = 37; -#elif defined(ADAFRUIT_GRAND_CENTRAL_M4) +#elif defined(ARDUINO_GRAND_CENTRAL_M4) const int sck = 89, ssel = 90, mosi = 91, miso = 92; #endif @@ -722,11 +723,11 @@ const char notanumber[] PROGMEM = "argument is not a number"; const char notastring[] PROGMEM = "argument is not a string"; const char notalist[] PROGMEM = "argument is not a list"; const char notproper[] PROGMEM = "argument is not a proper list"; -const char notproper2[] PROGMEM = "second argument is not a proper list"; -const char notproper3[] PROGMEM = "third argument is not a proper list"; const char noargument[] PROGMEM = "missing argument"; const char nostream[] PROGMEM = "missing stream argument"; const char overflow[] PROGMEM = "arithmetic overflow"; +const char invalidpin[] PROGMEM = "invalid pin"; +const char resultproper[] PROGMEM = "result is not a proper list"; // Tracing @@ -1276,53 +1277,53 @@ pfun_t pstreamfun (object *args) { void checkanalogread (int pin) { #if defined(ARDUINO_SAM_DUE) - if (!(pin>=54 && pin<=65)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + if (!(pin>=54 && pin<=65)) error(ANALOGREAD, invalidpin, number(pin)); #elif defined(ARDUINO_SAMD_ZERO) - if (!(pin>=14 && pin<=19)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + if (!(pin>=14 && pin<=19)) error(ANALOGREAD, invalidpin, number(pin)); #elif defined(ARDUINO_SAMD_MKRZERO) - if (!(pin>=15 && pin<=21)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_ITSYBITSY_M0) - if (!(pin>=14 && pin<=25)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_GEMMA_M0) - if (!(pin>=8 && pin<=10)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + 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_METRO_M4) - if (!(pin>=14 && pin<=21)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_ITSYBITSY_M4) - if (!(pin>=14 && pin<=19)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_FEATHER_M4) - if (!(pin>=14 && pin<=19)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_GRAND_CENTRAL_M4) - if (!((pin>=67 && pin<=74) || (pin>=54 && pin<=61))) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + if (!(pin>=14 && pin<=21)) error(ANALOGREAD, invalidpin, number(pin)); +#elif defined(ARDUINO_ITSYBITSY_M4) + if (!(pin>=14 && pin<=19)) error(ANALOGREAD, invalidpin, number(pin)); +#elif defined(ARDUINO_FEATHER_M4) + if (!(pin>=14 && pin<=19)) 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(_VARIANT_BBC_MICROBIT_) - if (!((pin>=0 && pin<=4) || pin==10)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + if (!((pin>=0 && pin<=4) || pin==10)) error(ANALOGREAD, invalidpin, number(pin)); #elif defined(MAX32620) - if (!(pin>=49 && pin<=52)) error(ANALOGREAD, PSTR("invalid pin"), number(pin)); + if (!(pin>=49 && pin<=52)) 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, PSTR("invalid pin"), number(pin)); + 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, PSTR("invalid pin"), number(pin)); + 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, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_ITSYBITSY_M0) - if (!((pin>=3 && pin<=6) || (pin>=8 && pin<=13) || (pin>=15 && pin<=16) || (pin>=22 && pin<=25))) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_GEMMA_M0) - if (!(pin==0 || pin==2 || pin==9 || pin==10)) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); + 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_METRO_M4) - if (!(pin>=0 && pin<=15)) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_ITSYBITSY_M4) - if (!(pin==0 || pin==1 || pin==4 || pin==5 || pin==7 || (pin>=9 && pin<=15) || pin==21 || pin==22)) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_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, PSTR("invalid pin"), number(pin)); -#elif defined(ADAFRUIT_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, PSTR("invalid pin"), number(pin)); + 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(_VARIANT_BBC_MICROBIT_) - if (!(pin>=0 && pin<=2)) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); + if (!(pin>=0 && pin<=2)) error(ANALOGWRITE, invalidpin, number(pin)); #elif defined(MAX32620) - if (!((pin>=20 && pin<=29) || pin==32 || (pin>=40 && pin<=48))) error(ANALOGWRITE, PSTR("invalid pin"), number(pin)); + if (!((pin>=20 && pin<=29) || pin==32 || (pin>=40 && pin<=48))) error(ANALOGWRITE, invalidpin, number(pin)); #endif } @@ -1454,7 +1455,6 @@ object *sp_setq (object *args, object *env) { } object *sp_loop (object *args, object *env) { - clrflag(RETURNFLAG); object *start = args; for (;;) { args = start; @@ -1469,6 +1469,12 @@ object *sp_loop (object *args, object *env) { } } +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) { checkargs(PUSH, args); object *item = eval(first(args), env); @@ -1567,22 +1573,26 @@ object *sp_dolist (object *args, object *env) { if (args == NULL) error2(DOLIST, noargument); object *params = first(args); object *var = first(params); - object *result; 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)); - object *forms = cdr(args); + args = cdr(args); while (list != NULL) { if (improperp(list)) error(DOLIST, notproper, list); cdr(pair) = first(list); - list = cdr(list); - result = eval(tf_progn(forms,env), env); - if (tstflag(RETURNFLAG)) { - clrflag(RETURNFLAG); - return result; + 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); @@ -1594,21 +1604,24 @@ object *sp_dotimes (object *args, object *env) { if (args == NULL) error2(DOTIMES, noargument); object *params = first(args); object *var = first(params); - object *result; int count = checkinteger(DOTIMES, eval(second(params), env)); int index = 0; params = cdr(cdr(params)); object *pair = cons(var,number(0)); push(pair,env); - object *forms = cdr(args); + args = cdr(args); while (index < count) { cdr(pair) = number(index); - index++; - result = eval(tf_progn(forms,env), env); - if (tstflag(RETURNFLAG)) { - clrflag(RETURNFLAG); - return result; + 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; @@ -1774,19 +1787,13 @@ 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; + eval(car(args), env); args = more; more = cdr(args); } return car(args); } -object *tf_return (object *args, object *env) { - setflag(RETURNFLAG); - return tf_progn(args, env); -} - object *tf_if (object *args, object *env) { if (args == NULL || cdr(args) == NULL) error2(IF, PSTR("missing argument(s)")); if (eval(first(args), env) != nil) return second(args); @@ -2004,7 +2011,7 @@ object *fn_nth (object *args, object *env) { int n = checkinteger(NTH, first(args)); object *list = second(args); while (list != NULL) { - if (improperp(list)) error(NTH, notproper2, list); + if (improperp(list)) error(NTH, notproper, list); if (n == 0) return car(list); list = cdr(list); n--; @@ -2070,100 +2077,93 @@ object *fn_append (object *args, object *env) { object *fn_mapc (object *args, object *env) { object *function = first(args); - object *list1 = second(args); - object *result = list1; - object *list2 = cddr(args); - if (list2 != NULL) { - list2 = car(list2); - object *result2 = list2; - while (list1 != NULL && list2 != NULL) { - if (improperp(list1)) error(MAPC, notproper2, result); - if (improperp(list2)) error(MAPC, notproper3, result2); - apply(MAPC, function, cons(car(list1),cons(car(list2),NULL)), env); - list1 = cdr(list1); list2 = cdr(list2); - } - } else { - while (list1 != NULL) { - if (improperp(list1)) error(MAPC, notproper2, result); - apply(MAPC, function, cons(car(list1),NULL), env); - list1 = cdr(list1); + 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); } - return result; } object *fn_mapcar (object *args, object *env) { object *function = first(args); - object *list1 = second(args); - object *result = list1; - object *list2 = cddr(args); - object *head = cons(NULL, NULL); + args = cdr(args); + object *params = cons(NULL, NULL); + push(params,GCStack); + object *head = cons(NULL, NULL); push(head,GCStack); object *tail = head; - if (list2 != NULL) { - list2 = car(list2); - object *result2 = list2; - while (list1 != NULL && list2 != NULL) { - if (improperp(list1)) error(MAPCAR, notproper2, result); - if (improperp(list2)) error(MAPCAR, notproper3, result2); - object *result = apply(MAPCAR, function, cons(car(list1), cons(car(list2),NULL)), env); - object *obj = cons(result,NULL); - cdr(tail) = obj; - tail = obj; - list1 = cdr(list1); list2 = cdr(list2); - } - } else if (list1 != NULL) { - while (list1 != NULL) { - if (improperp(list1)) error(MAPCAR, notproper2, result); - object *result = apply(MAPCAR, function, cons(car(list1),NULL), env); - object *obj = cons(result,NULL); - cdr(tail) = obj; - tail = obj; - list1 = cdr(list1); + // 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(MAPCAR, notproper, list); + object *obj = cons(first(list),NULL); + car(lists) = cdr(list); + cdr(tailp) = obj; tailp = obj; + lists = cdr(lists); } + object *result = apply(MAPCAR, function, cdr(params), env); + object *obj = cons(result,NULL); + cdr(tail) = obj; tail = obj; } - pop(GCStack); - return cdr(head); } object *fn_mapcan (object *args, object *env) { object *function = first(args); - object *list1 = second(args); - object *result = list1; - object *list2 = cddr(args); - object *head = cons(NULL, NULL); + args = cdr(args); + object *params = cons(NULL, NULL); + push(params,GCStack); + object *head = cons(NULL, NULL); push(head,GCStack); object *tail = head; - if (list2 != NULL) { - list2 = car(list2); - object *result2 = list2; - while (list1 != NULL && list2 != NULL) { - if (improperp(list1)) error(MAPCAN, notproper2, result); - if (improperp(list2)) error(MAPCAN, notproper3, result2); - object *result = apply(MAPCAN, function, cons(car(list1), cons(car(list2),NULL)), env); - while ((unsigned int)result >= PAIR) { - cdr(tail) = result; - tail = result; - result = cdr(result); + // 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 (cdr(list1) != NULL && cdr(list2) != NULL && result != NULL) error2(MAPCAN, PSTR("result is not a proper list")); - list1 = cdr(list1); list2 = cdr(list2); + if (improperp(list)) error(MAPCAN, notproper, list); + object *obj = cons(first(list),NULL); + car(lists) = cdr(list); + cdr(tailp) = obj; tailp = obj; + lists = cdr(lists); } - } else if (list1 != NULL) { - while (list1 != NULL) { - if (improperp(list1)) error(MAPCAN, notproper2, result); - object *result = apply(MAPCAN, function, cons(car(list1),NULL), env); - while ((unsigned int)result >= PAIR) { - cdr(tail) = result; - tail = result; - result = cdr(result); - } - if (cdr(list1) != NULL && result != NULL) error2(MAPCAN, PSTR("result is not a proper list")); - list1 = cdr(list1); + object *result = apply(MAPCAN, function, cdr(params), env); + while (consp(result)) { + cdr(tail) = result; tail = result; + result = cdr(result); } + if (result != NULL) error(MAPCAN, resultproper, result); } - pop(GCStack); - return cdr(head); } // Arithmetic functions @@ -2879,10 +2879,10 @@ object *fn_princtostring (object *args, object *env) { obj->type = STRING; GlobalString = NULL; GlobalStringIndex = 0; - char temp = PrintReadably; - PrintReadably = 0; + char temp = Flags; + clrflag(PRINTREADABLY); printobject(arg, pstr); - PrintReadably = temp; + Flags = temp; obj->cdr = GlobalString; return obj; } @@ -2941,10 +2941,8 @@ 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)); + if (count >= 0) return number(value << count); + else return number(value >> abs(count)); } object *fn_logbitp (object *args, object *env) { @@ -3015,10 +3013,10 @@ object *fn_princ (object *args, object *env) { (void) env; object *obj = first(args); pfun_t pfun = pstreamfun(cdr(args)); - char temp = PrintReadably; - PrintReadably = 0; + char temp = Flags; + clrflag(PRINTREADABLY); printobject(obj, pfun); - PrintReadably = temp; + Flags = temp; return obj; } @@ -3054,10 +3052,10 @@ object *fn_writestring (object *args, object *env) { (void) env; object *obj = first(args); pfun_t pfun = pstreamfun(cdr(args)); - char temp = PrintReadably; - PrintReadably = 0; + char temp = Flags; + clrflag(PRINTREADABLY); printstring(obj, pfun); - PrintReadably = temp; + Flags = temp; return nil; } @@ -3065,11 +3063,11 @@ object *fn_writeline (object *args, object *env) { (void) env; object *obj = first(args); pfun_t pfun = pstreamfun(cdr(args)); - char temp = PrintReadably; - PrintReadably = 0; + char temp = Flags; + clrflag(PRINTREADABLY); printstring(obj, pfun); pln(pfun); - PrintReadably = temp; + Flags = temp; return nil; } @@ -3129,7 +3127,7 @@ object *fn_cls (object *args, object *env) { object *fn_pinmode (object *args, object *env) { (void) env; int pin = checkinteger(PINMODE, first(args)); - int pm = INPUT; + PinMode pm = INPUT; object *mode = second(args); if (integerp(mode)) { int nmode = checkinteger(PINMODE, mode); @@ -3152,8 +3150,8 @@ object *fn_digitalwrite (object *args, object *env) { (void) env; int pin = checkinteger(DIGITALWRITE, first(args)); object *mode = second(args); - if (integerp(mode)) digitalWrite(pin, mode->integer); - else digitalWrite(pin, (mode != nil)); + if (integerp(mode)) digitalWrite(pin, mode->integer ? HIGH : LOW); + else digitalWrite(pin, (mode != nil) ? HIGH : LOW); return mode; } @@ -3394,23 +3392,23 @@ const char string11[] PROGMEM = "defun"; const char string12[] PROGMEM = "defvar"; const char string13[] PROGMEM = "setq"; const char string14[] PROGMEM = "loop"; -const char string15[] PROGMEM = "push"; -const char string16[] PROGMEM = "pop"; -const char string17[] PROGMEM = "incf"; -const char string18[] PROGMEM = "decf"; -const char string19[] PROGMEM = "setf"; -const char string20[] PROGMEM = "dolist"; -const char string21[] PROGMEM = "dotimes"; -const char string22[] PROGMEM = "trace"; -const char string23[] PROGMEM = "untrace"; -const char string24[] PROGMEM = "for-millis"; -const char string25[] PROGMEM = "with-serial"; -const char string26[] PROGMEM = "with-i2c"; -const char string27[] PROGMEM = "with-spi"; -const char string28[] PROGMEM = "with-sd-card"; -const char string29[] PROGMEM = "tail_forms"; -const char string30[] PROGMEM = "progn"; -const char string31[] PROGMEM = "return"; +const char string15[] PROGMEM = "return"; +const char string16[] PROGMEM = "push"; +const char string17[] PROGMEM = "pop"; +const char string18[] PROGMEM = "incf"; +const char string19[] PROGMEM = "decf"; +const char string20[] PROGMEM = "setf"; +const char string21[] PROGMEM = "dolist"; +const char string22[] PROGMEM = "dotimes"; +const char string23[] PROGMEM = "trace"; +const char string24[] PROGMEM = "untrace"; +const char string25[] PROGMEM = "for-millis"; +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"; @@ -3574,23 +3572,23 @@ const tbl_entry_t lookup_table[] PROGMEM = { { string12, sp_defvar, 2, 2 }, { string13, sp_setq, 2, 2 }, { string14, sp_loop, 0, 127 }, - { string15, sp_push, 2, 2 }, - { string16, sp_pop, 1, 1 }, - { string17, sp_incf, 1, 2 }, - { string18, sp_decf, 1, 2 }, - { string19, sp_setf, 2, 2 }, - { string20, sp_dolist, 1, 127 }, - { string21, sp_dotimes, 1, 127 }, - { string22, sp_trace, 0, 1 }, - { string23, sp_untrace, 0, 1 }, - { string24, sp_formillis, 1, 127 }, - { string25, sp_withserial, 1, 127 }, - { string26, sp_withi2c, 1, 127 }, - { string27, sp_withspi, 1, 127 }, - { string28, sp_withsdcard, 2, 127 }, - { string29, NULL, NIL, NIL }, - { string30, tf_progn, 0, 127 }, - { string31, tf_return, 0, 127 }, + { string15, sp_return, 0, 127 }, + { string16, sp_push, 2, 2 }, + { string17, sp_pop, 1, 1 }, + { string18, sp_incf, 1, 2 }, + { string19, sp_decf, 1, 2 }, + { string20, sp_setf, 2, 2 }, + { string21, sp_dolist, 1, 127 }, + { string22, sp_dotimes, 1, 127 }, + { string23, sp_trace, 0, 1 }, + { string24, sp_untrace, 0, 1 }, + { string25, sp_formillis, 1, 127 }, + { string26, sp_withserial, 1, 127 }, + { 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 }, @@ -3635,9 +3633,9 @@ const tbl_entry_t lookup_table[] PROGMEM = { { string73, fn_apply, 2, 127 }, { string74, fn_funcall, 1, 127 }, { string75, fn_append, 0, 127 }, - { string76, fn_mapc, 2, 3 }, - { string77, fn_mapcar, 2, 3 }, - { string78, fn_mapcan, 2, 3 }, + { 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 }, @@ -3967,7 +3965,7 @@ const char ControlCodes[] PROGMEM = "Null\0SOH\0STX\0ETX\0EOT\0ENQ\0ACK\0Bell\0B "Page\0Return\0SO\0SI\0DLE\0DC1\0DC2\0DC3\0DC4\0NAK\0SYN\0ETB\0CAN\0EM\0SUB\0Escape\0FS\0GS\0RS\0US\0Space\0"; void pcharacter (char c, pfun_t pfun) { - if (!PrintReadably) pfun(c); + if (!tstflag(PRINTREADABLY)) pfun(c); else { pfun('#'); pfun('\\'); if (c > 32) pfun(c); @@ -3984,18 +3982,18 @@ void pstring (char *s, pfun_t pfun) { } void printstring (object *form, pfun_t pfun) { - if (PrintReadably) pfun('"'); + if (tstflag(PRINTREADABLY)) pfun('"'); form = cdr(form); while (form != NULL) { int chars = form->integer; for (int i=(sizeof(int)-1)*8; i>=0; i=i-8) { char ch = chars>>i & 0xFF; - if (PrintReadably && (ch == '"' || ch == '\\')) pfun('\\'); + if (tstflag(PRINTREADABLY) && (ch == '"' || ch == '\\')) pfun('\\'); if (ch) pfun(ch); } form = car(form); } - if (PrintReadably) pfun('"'); + if (tstflag(PRINTREADABLY)) pfun('"'); } void pfstring (const char *s, pfun_t pfun) { @@ -4298,7 +4296,7 @@ void setup () { initworkspace(); initenv(); initsleep(); - pfstring(PSTR("uLisp 2.8 "), pserial); pln(pserial); + pfstring(PSTR("uLisp 2.9 "), pserial); pln(pserial); } // Read/Evaluate/Print loop