Version 2.5 - 1st December 2018

Multiple minor bug fixes: fixes #5
This commit is contained in:
David Johnson-Davies 2018-12-01 11:36:26 +00:00
parent 401b713ad6
commit c64a50bc27
1 changed files with 29 additions and 20 deletions

View File

@ -1,5 +1,5 @@
/* uLisp ARM Version 2.4b - www.ulisp.com /* uLisp ARM Version 2.5 - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 23rd September 2018 David Johnson-Davies - www.technoblogy.com - 30th November 2018
Licensed under the MIT license: https://opensource.org/licenses/MIT Licensed under the MIT license: https://opensource.org/licenses/MIT
*/ */
@ -154,7 +154,7 @@ typedef void (*pfun_t)(char);
uint8_t _end; uint8_t _end;
#elif defined(_VARIANT_BBC_MICROBIT_) #elif defined(_VARIANT_BBC_MICROBIT_)
#define WORKSPACESIZE 1024 /* Cells (8*bytes) */ #define WORKSPACESIZE 1280 /* Cells (8*bytes) */
#define SYMBOLTABLESIZE 512 /* Bytes */ #define SYMBOLTABLESIZE 512 /* Bytes */
uint8_t _end; uint8_t _end;
@ -183,7 +183,7 @@ char LastPrint = 0;
char PrintReadably = 1; char PrintReadably = 1;
// Flags // Flags
enum flag { RETURNFLAG, ESCAPE, EXITEDITOR }; enum flag { RETURNFLAG, ESCAPE, EXITEDITOR, LIBRARYLOADED };
volatile char Flags; volatile char Flags;
// Forward references // Forward references
@ -642,6 +642,7 @@ void autorunimage () {
apply(autorun, NULL, &nullenv); apply(autorun, NULL, &nullenv);
} }
#elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) #elif defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4)
if (!FlashSetup()) error(PSTR("No DataFlash found."));
object *nullenv = NULL; object *nullenv = NULL;
FlashBeginRead(); FlashBeginRead();
object *autorun = (object *)FlashReadInt(); object *autorun = (object *)FlashReadInt();
@ -1117,11 +1118,11 @@ void serialbegin (int address, int baud) {
void serialend (int address) { void serialend (int address) {
#if defined(ARDUINO_SAMD_ZERO) || defined(ARDUINO_SAMD_MKRZERO) || defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4) #if defined(ARDUINO_SAMD_ZERO) || defined(ARDUINO_SAMD_MKRZERO) || defined(ARDUINO_METRO_M4) || defined(ARDUINO_ITSYBITSY_M4) || defined(ARDUINO_FEATHER_M4)
if (address == 1) Serial1.end(); if (address == 1) {Serial1.flush(); Serial1.end(); }
#elif defined(ARDUINO_SAM_DUE) #elif defined(ARDUINO_SAM_DUE)
if (address == 1) Serial1.end(); if (address == 1) {Serial1.flush(); Serial1.end(); }
else if (address == 2) Serial2.end(); else if (address == 2) {Serial2.flush(); Serial2.end(); }
else if (address == 3) Serial3.end(); else if (address == 3) {Serial3.flush(); Serial3.end(); }
#endif #endif
} }
@ -1664,6 +1665,7 @@ object *tf_return (object *args, object *env) {
} }
object *tf_if (object *args, object *env) { object *tf_if (object *args, object *env) {
if (args == NULL || cdr(args) == NULL) error(PSTR("'if' missing argument(s)"));
if (eval(first(args), env) != nil) return second(args); if (eval(first(args), env) != nil) return second(args);
args = cddr(args); args = cddr(args);
return (args != NULL) ? first(args) : nil; return (args != NULL) ? first(args) : nil;
@ -1672,6 +1674,7 @@ object *tf_if (object *args, object *env) {
object *tf_cond (object *args, object *env) { object *tf_cond (object *args, object *env) {
while (args != NULL) { while (args != NULL) {
object *clause = first(args); object *clause = first(args);
if (!consp(clause)) error2(clause, PSTR("is an illegal clause"));
object *test = eval(first(clause), env); object *test = eval(first(clause), env);
object *forms = cdr(clause); object *forms = cdr(clause);
if (test != nil) { if (test != nil) {
@ -1683,11 +1686,13 @@ object *tf_cond (object *args, object *env) {
} }
object *tf_when (object *args, object *env) { object *tf_when (object *args, object *env) {
if (args == NULL) error(PSTR("'when' missing argument"));
if (eval(first(args), env) != nil) return tf_progn(cdr(args),env); if (eval(first(args), env) != nil) return tf_progn(cdr(args),env);
else return nil; else return nil;
} }
object *tf_unless (object *args, object *env) { object *tf_unless (object *args, object *env) {
if (args == NULL) error(PSTR("'unless' missing argument"));
if (eval(first(args), env) != nil) return nil; if (eval(first(args), env) != nil) return nil;
else return tf_progn(cdr(args),env); else return tf_progn(cdr(args),env);
} }
@ -2609,7 +2614,8 @@ object *fn_stringfn (object *args, object *env) {
if (type == CHARACTER) { if (type == CHARACTER) {
object *cell = myalloc(); object *cell = myalloc();
cell->car = NULL; cell->car = NULL;
cell->integer = fromchar(arg)<<8; uint8_t shift = (sizeof(int)-1)*8;
cell->integer = fromchar(arg)<<shift;
obj->cdr = cell; obj->cdr = cell;
} else if (type == SYMBOL) { } else if (type == SYMBOL) {
char *s = name(arg); char *s = name(arg);
@ -2802,7 +2808,7 @@ object *fn_makunbound (object *args, object *env) {
(void) env; (void) env;
object *key = first(args); object *key = first(args);
deletesymbol(key->name); deletesymbol(key->name);
return delassoc(key, &GlobalEnv); return (delassoc(key, &GlobalEnv) != NULL) ? tee : nil;
} }
object *fn_break (object *args, object *env) { object *fn_break (object *args, object *env) {
@ -2957,8 +2963,12 @@ object *fn_pinmode (object *args, object *env) {
(void) env; (void) env;
int pin = integer(first(args)); int pin = integer(first(args));
object *mode = second(args); object *mode = second(args);
if (integerp(mode)) pinMode(pin, mode->integer); if ((integerp(mode) && mode->integer == 1) || mode != nil) pinMode(pin, OUTPUT);
else pinMode(pin, (mode != nil)); else if (integerp(mode) && mode->integer == 2) pinMode(pin, INPUT_PULLUP);
#if defined(INPUT_PULLDOWN)
else if (integerp(mode) && mode->integer == 4) pinMode(pin, INPUT_PULLDOWN);
#endif
else pinMode(pin, INPUT);
return nil; return nil;
} }
@ -3072,7 +3082,7 @@ int atomwidth (object *obj) {
} }
boolean quoted (object *obj) { boolean quoted (object *obj) {
return (consp(obj) && (car(obj)->name == QUOTE) && consp(cdr(obj)) && (cddr(obj) == NULL)); return (consp(obj) && car(obj) != NULL && car(obj)->name == QUOTE && consp(cdr(obj)) && cddr(obj) == NULL);
} }
int subwidth (object *obj, int w) { int subwidth (object *obj, int w) {
@ -3092,7 +3102,7 @@ int subwidthlist (object *form, int w) {
void superprint (object *form, int lm, pfun_t pfun) { void superprint (object *form, int lm, pfun_t pfun) {
if (atom(form)) { if (atom(form)) {
if (form->name == NOTHING) pstring(name(form), pfun); if (symbolp(form) && form->name == NOTHING) pstring(name(form), pfun);
else printobject(form, pfun); else printobject(form, pfun);
} }
else if (quoted(form)) { pfun('\''); superprint(car(cdr(form)), lm + 1, pfun); } else if (quoted(form)) { pfun('\''); superprint(car(cdr(form)), lm + 1, pfun); }
@ -3142,11 +3152,9 @@ object *fn_pprintall (object *args, object *env) {
object *pair = first(globals); object *pair = first(globals);
object *var = car(pair); object *var = car(pair);
object *val = cdr(pair); object *val = cdr(pair);
object *head = car(val); if (listp(val) && symbolp(car(val)) && car(val)->name == LAMBDA) {
object *function = cdr(val);
if (head->name == LAMBDA) {
pln(pserial); pln(pserial);
superprint(cons(symbol(DEFUN), cons(var, function)), 0, pserial); superprint(cons(symbol(DEFUN), cons(var, cdr(val))), 0, pserial);
pln(pserial); pln(pserial);
} }
globals = cdr(globals); globals = cdr(globals);
@ -4069,7 +4077,7 @@ void setup () {
initworkspace(); initworkspace();
initenv(); initenv();
initsleep(); initsleep();
pfstring(PSTR("uLisp 2.4 "), pserial); pln(pserial); pfstring(PSTR("uLisp 2.5 "), pserial); pln(pserial);
} }
// Read/Evaluate/Print loop // Read/Evaluate/Print loop
@ -4111,12 +4119,13 @@ void loop () {
if (autorun == 12) autorunimage(); if (autorun == 12) autorunimage();
} }
// Come here after error // Come here after error
delay(100); while (Serial.available()) Serial.read();
for (int i=0; i<TRACEMAX; i++) TraceDepth[i] = 0; for (int i=0; i<TRACEMAX; i++) TraceDepth[i] = 0;
#if defined(sdcardsupport) #if defined(sdcardsupport)
SDpfile.close(); SDgfile.close(); SDpfile.close(); SDgfile.close();
#endif #endif
#if defined(lisplibrary) #if defined(lisplibrary)
loadfromlibrary(NULL); if (!tstflag(LIBRARYLOADED)) { setflag(LIBRARYLOADED); loadfromlibrary(NULL); }
#endif #endif
repl(NULL); repl(NULL);
} }