kyle
/
ulisp
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Release 4.4b - 3rd April 2023

This commit is contained in:
David Johnson-Davies 2023-04-03 13:54:21 +01:00 committed by GitHub
parent 1d58a95a5e
commit 41fb7d760d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 129 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
ulisp-arm-comments.ino
View File

@ -1,5 +1,5 @@
/* uLisp ARM Release 4.4a - www.ulisp.com /* uLisp ARM Release 4.4b - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 22nd March 2023 David Johnson-Davies - www.technoblogy.com - 3rd April 2023
Licensed under the MIT license: https://opensource.org/licenses/MIT Licensed under the MIT license: https://opensource.org/licenses/MIT
*/ */
@ -206,7 +206,7 @@ const char LispLibrary[] PROGMEM = "";
#define CPU_RP2040 #define CPU_RP2040
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W) #elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
#define WORKSPACESIZE (15872-SDSIZE) /* Objects (8*bytes) */ #define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
#define LITTLEFS #define LITTLEFS
#include <WiFi.h> #include <WiFi.h>
#include <LittleFS.h> #include <LittleFS.h>
@ -584,10 +584,15 @@ bool eqsymbols (object *obj, char *buffer) {
object *arg = cdr(obj); object *arg = cdr(obj);
int i = 0; int i = 0;
while (!(arg == NULL && buffer[i] == 0)) { while (!(arg == NULL && buffer[i] == 0)) {
if (arg == NULL || buffer[i] == 0 || if (arg == NULL || buffer[i] == 0) return false;
arg->chars != (buffer[i]<<24 | buffer[i+1]<<16 | buffer[i+2]<<8 | buffer[i+3])) return false; int test = 0, shift = 24;
for (int j=0; j<4; j++, i++) {
if (buffer[i] == 0) break;
test = test | buffer[i]<<shift;
shift = shift - 8;
}
if (arg->chars != test) return false;
arg = car(arg); arg = car(arg);
i = i + 4;
} }
return true; return true;
} }
@ -1268,7 +1273,7 @@ int8_t toradix40 (char ch) {
fromradix40 - returns the character encoded by the number n. fromradix40 - returns the character encoded by the number n.
*/ */
char fromradix40 (char n) { char fromradix40 (char n) {
if (n >= 1 && n <= 9) return '0'+n-1; if (n >= 1 && n <= 10) return '0'+n-1;
if (n >= 11 && n <= 36) return 'a'+n-11; if (n >= 11 && n <= 36) return 'a'+n-11;
if (n == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$'; if (n == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$';
return 0; return 0;
@ -1278,8 +1283,11 @@ char fromradix40 (char n) {
pack40 - packs six radix40-encoded characters from buffer into a 32-bit number and returns it. pack40 - packs six radix40-encoded characters from buffer into a 32-bit number and returns it.
*/ */
uint32_t pack40 (char *buffer) { uint32_t pack40 (char *buffer) {
int x = 0; int x = 0, j = 0;
for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]); for (int i=0; i<6; i++) {
x = x * 40 + toradix40(buffer[j]);
if (buffer[j] != 0) j++;
}
return x; return x;
} }
@ -1287,8 +1295,12 @@ uint32_t pack40 (char *buffer) {
valid40 - returns true if the symbol in buffer can be encoded as six radix40-encoded characters. valid40 - returns true if the symbol in buffer can be encoded as six radix40-encoded characters.
*/ */
bool valid40 (char *buffer) { bool valid40 (char *buffer) {
if (toradix40(buffer[0]) < 11) return false; int t = 11;
for (int i=1; i<6; i++) if (toradix40(buffer[i]) < 0) return false; for (int i=0; i<6; i++) {
if (toradix40(buffer[i]) < t) return false;
if (buffer[i] == 0) break;
t = 0;
}
return true; return true;
} }
@ -1323,8 +1335,8 @@ int checkbitvalue (object *obj) {
/* /*
checkintfloat - check that obj is an integer or floating-point number and return the number checkintfloat - check that obj is an integer or floating-point number and return the number
*/ */
float checkintfloat (object *obj){ float checkintfloat (object *obj) {
if (integerp(obj)) return obj->integer; if (integerp(obj)) return (float)obj->integer;
if (!floatp(obj)) error(notanumber, obj); if (!floatp(obj)) error(notanumber, obj);
return obj->single_float; return obj->single_float;
} }
@ -1411,6 +1423,20 @@ int listlength (object *list) {
return length; return length;
} }
/*
checkarguments - checks the arguments list in a special form such as with-xxx,
dolist, or dotimes.
*/
object *checkarguments (object *args, int min, int max) {
if (args == NULL) error2(noargument);
args = first(args);
if (!listp(args)) error(notalist, args);
int length = listlength(args);
if (length < min) error(toofewargs, args);
if (length > max) error(toomanyargs, args);
return args;
}
// Mathematical helper functions // Mathematical helper functions
/* /*
@ -3185,8 +3211,7 @@ object *sp_setf (object *args, object *env) {
It then returns result, or nil if result is omitted. It then returns result, or nil if result is omitted.
*/ */
object *sp_dolist (object *args, object *env) { object *sp_dolist (object *args, object *env) {
if (args == NULL || listlength(first(args)) < 2) error2(noargument); object *params = checkarguments(args, 2, 3);
object *params = first(args);
object *var = first(params); object *var = first(params);
object *list = eval(second(params), env); object *list = eval(second(params), env);
push(list, GCStack); // Don't GC the list push(list, GCStack); // Don't GC the list
@ -3221,8 +3246,7 @@ object *sp_dolist (object *args, object *env) {
It then returns result, or nil if result is omitted. It then returns result, or nil if result is omitted.
*/ */
object *sp_dotimes (object *args, object *env) { object *sp_dotimes (object *args, object *env) {
if (args == NULL || listlength(first(args)) < 2) error2(noargument); object *params = checkarguments(args, 2, 3);
object *params = first(args);
object *var = first(params); object *var = first(params);
int count = checkinteger(eval(second(params), env)); int count = checkinteger(eval(second(params), env));
int index = 0; int index = 0;
@ -3300,8 +3324,7 @@ object *sp_untrace (object *args, object *env) {
Returns the total number of milliseconds taken. Returns the total number of milliseconds taken.
*/ */
object *sp_formillis (object *args, object *env) { object *sp_formillis (object *args, object *env) {
if (args == NULL) error2(noargument); object *param = checkarguments(args, 0, 1);
object *param = first(args);
unsigned long start = millis(); unsigned long start = millis();
unsigned long now, total = 0; unsigned long now, total = 0;
if (param != NULL) total = checkinteger(eval(first(param), env)); if (param != NULL) total = checkinteger(eval(first(param), env));
@ -3342,9 +3365,7 @@ object *sp_time (object *args, object *env) {
Returns a string containing the output to the stream variable str. Returns a string containing the output to the stream variable str.
*/ */
object *sp_withoutputtostring (object *args, object *env) { object *sp_withoutputtostring (object *args, object *env) {
if (args == NULL) error2(noargument); object *params = checkarguments(args, 1, 1);
object *params = first(args);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
object *pair = cons(var, stream(STRINGSTREAM, 0)); object *pair = cons(var, stream(STRINGSTREAM, 0));
push(pair,env); push(pair,env);
@ -3362,8 +3383,7 @@ object *sp_withoutputtostring (object *args, object *env) {
The optional baud gives the baud rate divided by 100, default 96. The optional baud gives the baud rate divided by 100, default 96.
*/ */
object *sp_withserial (object *args, object *env) { object *sp_withserial (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 3);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
int address = checkinteger(eval(second(params), env)); int address = checkinteger(eval(second(params), env));
params = cddr(params); params = cddr(params);
@ -3385,8 +3405,7 @@ object *sp_withserial (object *args, object *env) {
to be read from the stream. If port is omitted it defaults to 0, otherwise it specifies the port, 0 or 1. to be read from the stream. If port is omitted it defaults to 0, otherwise it specifies the port, 0 or 1.
*/ */
object *sp_withi2c (object *args, object *env) { object *sp_withi2c (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 4);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
int address = checkinteger(eval(second(params), env)); int address = checkinteger(eval(second(params), env));
params = cddr(params); params = cddr(params);
@ -3422,8 +3441,7 @@ object *sp_withi2c (object *args, object *env) {
bitorder 0 for LSBFIRST and 1 for MSBFIRST (default 1), SPI mode (default 0), and port 0 or 1 (default 0). bitorder 0 for LSBFIRST and 1 for MSBFIRST (default 1), SPI mode (default 0), and port 0 or 1 (default 0).
*/ */
object *sp_withspi (object *args, object *env) { object *sp_withspi (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 6);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
params = cdr(params); params = cdr(params);
if (params == NULL) error2(nostream); if (params == NULL) error2(nostream);
@ -3472,8 +3490,7 @@ object *sp_withspi (object *args, object *env) {
*/ */
object *sp_withsdcard (object *args, object *env) { object *sp_withsdcard (object *args, object *env) {
#if defined(sdcardsupport) #if defined(sdcardsupport)
object *params = first(args); object *params = checkarguments(args, 2, 3);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
params = cdr(params); params = cdr(params);
if (params == NULL) error2(PSTR("no filename specified")); if (params == NULL) error2(PSTR("no filename specified"));
@ -4746,7 +4763,7 @@ object *fn_sqrt (object *args, object *env) {
} }
/* /*
(number [base]) (log number [base])
Returns the logarithm of number to the specified base. If base is omitted it defaults to e. Returns the logarithm of number to the specified base. If base is omitted it defaults to e.
*/ */
object *fn_log (object *args, object *env) { object *fn_log (object *args, object *env) {
@ -4803,8 +4820,8 @@ object *fn_floor (object *args, object *env) {
} }
/* /*
(truncate number) (truncate number [divisor])
Returns t if the argument is a floating-point number. Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.
*/ */
object *fn_truncate (object *args, object *env) { object *fn_truncate (object *args, object *env) {
(void) env; (void) env;
@ -4815,8 +4832,8 @@ object *fn_truncate (object *args, object *env) {
} }
/* /*
(round number) (round number [divisor])
Returns t if the argument is a floating-point number. Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.
*/ */
object *fn_round (object *args, object *env) { object *fn_round (object *args, object *env) {
(void) env; (void) env;
@ -5130,10 +5147,8 @@ object *fn_logxor (object *args, object *env) {
} }
/* /*
(prin1-to-string item [stream]) (lognot value)
Prints its argument to a string, and returns the string. Returns the bitwise logical NOT of the value.
Characters and strings are printed with quotation marks and escape characters,
in a format that will be suitable for read-from-string.
*/ */
object *fn_lognot (object *args, object *env) { object *fn_lognot (object *args, object *env) {
(void) env; (void) env;
@ -5516,7 +5531,7 @@ object *fn_analogread (object *args, object *env) {
object *fn_analogreference (object *args, object *env) { object *fn_analogreference (object *args, object *env) {
(void) env; (void) env;
object *arg = first(args); object *arg = first(args);
#if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040) #if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
error2(PSTR("not supported")); error2(PSTR("not supported"));
#else #else
analogReference((eAnalogReference)checkkeyword(arg)); analogReference((eAnalogReference)checkkeyword(arg));
@ -5973,7 +5988,7 @@ object *sp_error (object *args, object *env) {
*/ */
object *sp_withclient (object *args, object *env) { object *sp_withclient (object *args, object *env) {
#if defined(ULISP_WIFI) #if defined(ULISP_WIFI)
object *params = first(args); object *params = checkarguments(args, 1, 3);
object *var = first(params); object *var = first(params);
char buffer[BUFFERSIZE]; char buffer[BUFFERSIZE];
params = cdr(params); params = cdr(params);
@ -6133,7 +6148,7 @@ object *fn_wificonnect (object *args, object *env) {
*/ */
object *sp_withgfx (object *args, object *env) { object *sp_withgfx (object *args, object *env) {
#if defined(gfxsupport) #if defined(gfxsupport)
object *params = first(args); object *params = checkarguments(args, 1, 1);
object *var = first(params); object *var = first(params);
object *pair = cons(var, stream(GFXSTREAM, 1)); object *pair = cons(var, stream(GFXSTREAM, 1));
push(pair,env); push(pair,env);
@ -7146,7 +7161,7 @@ const char doc133[] PROGMEM = "(exp number)\n"
"Returns exp(number)."; "Returns exp(number).";
const char doc134[] PROGMEM = "(sqrt number)\n" const char doc134[] PROGMEM = "(sqrt number)\n"
"Returns sqrt(number)."; "Returns sqrt(number).";
const char doc135[] PROGMEM = "(number [base])\n" const char doc135[] PROGMEM = "(log number [base])\n"
"Returns the logarithm of number to the specified base. If base is omitted it defaults to e."; "Returns the logarithm of number to the specified base. If base is omitted it defaults to e.";
const char doc136[] PROGMEM = "(expt number power)\n" const char doc136[] PROGMEM = "(expt number power)\n"
"Returns number raised to the specified power.\n" "Returns number raised to the specified power.\n"
@ -7156,10 +7171,10 @@ const char doc137[] PROGMEM = "(ceiling number [divisor])\n"
"Returns ceil(number/divisor). If omitted, divisor is 1."; "Returns ceil(number/divisor). If omitted, divisor is 1.";
const char doc138[] PROGMEM = "(floor number [divisor])\n" const char doc138[] PROGMEM = "(floor number [divisor])\n"
"Returns floor(number/divisor). If omitted, divisor is 1."; "Returns floor(number/divisor). If omitted, divisor is 1.";
const char doc139[] PROGMEM = "(truncate number)\n" const char doc139[] PROGMEM = "(truncate number [divisor])\n"
"Returns t if the argument is a floating-point number."; "Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.";
const char doc140[] PROGMEM = "(round number)\n" const char doc140[] PROGMEM = "(round number [divisor])\n"
"Returns t if the argument is a floating-point number."; "Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.";
const char doc141[] PROGMEM = "(char string n)\n" const char doc141[] PROGMEM = "(char string n)\n"
"Returns the nth character in a string, counting from zero."; "Returns the nth character in a string, counting from zero.";
const char doc142[] PROGMEM = "(char-code character)\n" const char doc142[] PROGMEM = "(char-code character)\n"
@ -7200,10 +7215,8 @@ const char doc157[] PROGMEM = "(logior [value*])\n"
"Returns the bitwise | of the values."; "Returns the bitwise | of the values.";
const char doc158[] PROGMEM = "(logxor [value*])\n" const char doc158[] PROGMEM = "(logxor [value*])\n"
"Returns the bitwise ^ of the values."; "Returns the bitwise ^ of the values.";
const char doc159[] PROGMEM = "(prin1-to-string item [stream])\n" const char doc159[] PROGMEM = "(lognot value)\n"
"Prints its argument to a string, and returns the string.\n" "Returns the bitwise logical NOT of the value.";
"Characters and strings are printed with quotation marks and escape characters,\n"
"in a format that will be suitable for read-from-string.";
const char doc160[] PROGMEM = "(ash value shift)\n" const char doc160[] PROGMEM = "(ash value shift)\n"
"Returns the result of bitwise shifting value by shift bits. If shift is positive, value is shifted to the left."; "Returns the result of bitwise shifting value by shift bits. If shift is positive, value is shifted to the left.";
const char doc161[] PROGMEM = "(logbitp bit value)\n" const char doc161[] PROGMEM = "(logbitp bit value)\n"
@ -7881,7 +7894,7 @@ object *eval (object *form, object *env) {
EVAL: EVAL:
// Enough space? // Enough space?
// Serial.println((uint32_t)sp - (uint32_t)&ENDSTACK); // Find best STACKDIFF value // Serial.println((uint32_t)sp - (uint32_t)&ENDSTACK); // Find best STACKDIFF value
if (((uint32_t)sp - (uint32_t)&ENDSTACK) < STACKDIFF) { Context = 0; error2(PSTR("stack overflow")); } if (((uint32_t)sp - (uint32_t)&ENDSTACK) < STACKDIFF) { Context = NIL; error2(PSTR("stack overflow")); }
if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // GC when 1/16 of workspace left if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // GC when 1/16 of workspace left
// Escape // Escape
if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));} if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));}
@ -7898,6 +7911,7 @@ object *eval (object *form, object *env) {
pair = value(name, GlobalEnv); pair = value(name, GlobalEnv);
if (pair != NULL) return cdr(pair); if (pair != NULL) return cdr(pair);
else if (builtinp(name)) return form; else if (builtinp(name)) return form;
Context = NIL;
error(PSTR("undefined"), form); error(PSTR("undefined"), form);
} }
@ -8556,7 +8570,6 @@ object *nextitem (gfun_t gfun) {
if (ch == '.') valid = 0; else if (digitvalue(ch)<base) valid = 1; else valid = -1; if (ch == '.') valid = 0; else if (digitvalue(ch)<base) valid = 1; else valid = -1;
bool isexponent = false; bool isexponent = false;
int exponent = 0, esign = 1; int exponent = 0, esign = 1;
buffer[2] = '\0'; buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; // In case symbol is < 5 letters
float divisor = 10.0; float divisor = 10.0;
while(!issp(ch) && !isbr(ch) && index < bufmax) { while(!issp(ch) && !isbr(ch) && index < bufmax) {
@ -8607,8 +8620,7 @@ object *nextitem (gfun_t gfun) {
builtin_t x = lookupbuiltin(buffer); builtin_t x = lookupbuiltin(buffer);
if (x == NIL) return nil; if (x == NIL) return nil;
if (x != ENDFUNCTIONS) return bsymbol(x); if (x != ENDFUNCTIONS) return bsymbol(x);
else if ((index <= 6) && valid40(buffer)) return intern(twist(pack40(buffer))); if (index <= 6 && valid40(buffer)) return intern(twist(pack40(buffer)));
buffer[index+1] = '\0'; buffer[index+2] = '\0'; buffer[index+3] = '\0'; // For internlong
return internlong(buffer); return internlong(buffer);
} }
@ -8687,9 +8699,7 @@ void initgfx () {
#endif #endif
} }
/* // Entry point from the Arduino IDE
setup - entry point from the Arduino IDE
*/
void setup () { void setup () {
Serial.begin(9600); Serial.begin(9600);
int start = millis(); int start = millis();
@ -8698,7 +8708,7 @@ void setup () {
initenv(); initenv();
initsleep(); initsleep();
initgfx(); initgfx();
pfstring(PSTR("uLisp 4.4a "), pserial); pln(pserial); pfstring(PSTR("uLisp 4.4b "), pserial); pln(pserial);
} }
// Read/Evaluate/Print loop // Read/Evaluate/Print loop
@ -8718,7 +8728,7 @@ void repl (object *env) {
pint(BreakLevel, pserial); pint(BreakLevel, pserial);
} }
pserial('>'); pserial(' '); pserial('>'); pserial(' ');
Context = 0; Context = NIL;
object *line = read(gserial); object *line = read(gserial);
#if defined(CPU_NRF52840) #if defined(CPU_NRF52840)
Serial.flush(); Serial.flush();

107
ulisp-arm.ino
View File

@ -1,5 +1,5 @@
/* uLisp ARM Release 4.4a - www.ulisp.com /* uLisp ARM Release 4.4b - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 22nd March 2023 David Johnson-Davies - www.technoblogy.com - 3rd April 2023
Licensed under the MIT license: https://opensource.org/licenses/MIT Licensed under the MIT license: https://opensource.org/licenses/MIT
*/ */
@ -206,7 +206,7 @@ const char LispLibrary[] PROGMEM = "";
#define CPU_RP2040 #define CPU_RP2040
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W) #elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
#define WORKSPACESIZE (15872-SDSIZE) /* Objects (8*bytes) */ #define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
#define LITTLEFS #define LITTLEFS
#include <WiFi.h> #include <WiFi.h>
#include <LittleFS.h> #include <LittleFS.h>
@ -521,10 +521,15 @@ bool eqsymbols (object *obj, char *buffer) {
object *arg = cdr(obj); object *arg = cdr(obj);
int i = 0; int i = 0;
while (!(arg == NULL && buffer[i] == 0)) { while (!(arg == NULL && buffer[i] == 0)) {
if (arg == NULL || buffer[i] == 0 || if (arg == NULL || buffer[i] == 0) return false;
arg->chars != (buffer[i]<<24 | buffer[i+1]<<16 | buffer[i+2]<<8 | buffer[i+3])) return false; int test = 0, shift = 24;
for (int j=0; j<4; j++, i++) {
if (buffer[i] == 0) break;
test = test | buffer[i]<<shift;
shift = shift - 8;
}
if (arg->chars != test) return false;
arg = car(arg); arg = car(arg);
i = i + 4;
} }
return true; return true;
} }
@ -1145,21 +1150,28 @@ int8_t toradix40 (char ch) {
} }
char fromradix40 (char n) { char fromradix40 (char n) {
if (n >= 1 && n <= 9) return '0'+n-1; if (n >= 1 && n <= 10) return '0'+n-1;
if (n >= 11 && n <= 36) return 'a'+n-11; if (n >= 11 && n <= 36) return 'a'+n-11;
if (n == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$'; if (n == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$';
return 0; return 0;
} }
uint32_t pack40 (char *buffer) { uint32_t pack40 (char *buffer) {
int x = 0; int x = 0, j = 0;
for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]); for (int i=0; i<6; i++) {
x = x * 40 + toradix40(buffer[j]);
if (buffer[j] != 0) j++;
}
return x; return x;
} }
bool valid40 (char *buffer) { bool valid40 (char *buffer) {
if (toradix40(buffer[0]) < 11) return false; int t = 11;
for (int i=1; i<6; i++) if (toradix40(buffer[i]) < 0) return false; for (int i=0; i<6; i++) {
if (toradix40(buffer[i]) < t) return false;
if (buffer[i] == 0) break;
t = 0;
}
return true; return true;
} }
@ -1182,8 +1194,8 @@ int checkbitvalue (object *obj) {
return n; return n;
} }
float checkintfloat (object *obj){ float checkintfloat (object *obj) {
if (integerp(obj)) return obj->integer; if (integerp(obj)) return (float)obj->integer;
if (!floatp(obj)) error(notanumber, obj); if (!floatp(obj)) error(notanumber, obj);
return obj->single_float; return obj->single_float;
} }
@ -1251,6 +1263,16 @@ int listlength (object *list) {
return length; return length;
} }
object *checkarguments (object *args, int min, int max) {
if (args == NULL) error2(noargument);
args = first(args);
if (!listp(args)) error(notalist, args);
int length = listlength(args);
if (length < min) error(toofewargs, args);
if (length > max) error(toomanyargs, args);
return args;
}
// Mathematical helper functions // Mathematical helper functions
object *add_floats (object *args, float fresult) { object *add_floats (object *args, float fresult) {
@ -2797,8 +2819,7 @@ object *sp_setf (object *args, object *env) {
// Other special forms // Other special forms
object *sp_dolist (object *args, object *env) { object *sp_dolist (object *args, object *env) {
if (args == NULL || listlength(first(args)) < 2) error2(noargument); object *params = checkarguments(args, 2, 3);
object *params = first(args);
object *var = first(params); object *var = first(params);
object *list = eval(second(params), env); object *list = eval(second(params), env);
push(list, GCStack); // Don't GC the list push(list, GCStack); // Don't GC the list
@ -2828,8 +2849,7 @@ object *sp_dolist (object *args, object *env) {
} }
object *sp_dotimes (object *args, object *env) { object *sp_dotimes (object *args, object *env) {
if (args == NULL || listlength(first(args)) < 2) error2(noargument); object *params = checkarguments(args, 2, 3);
object *params = first(args);
object *var = first(params); object *var = first(params);
int count = checkinteger(eval(second(params), env)); int count = checkinteger(eval(second(params), env));
int index = 0; int index = 0;
@ -2892,8 +2912,7 @@ object *sp_untrace (object *args, object *env) {
} }
object *sp_formillis (object *args, object *env) { object *sp_formillis (object *args, object *env) {
if (args == NULL) error2(noargument); object *param = checkarguments(args, 0, 1);
object *param = first(args);
unsigned long start = millis(); unsigned long start = millis();
unsigned long now, total = 0; unsigned long now, total = 0;
if (param != NULL) total = checkinteger(eval(first(param), env)); if (param != NULL) total = checkinteger(eval(first(param), env));
@ -2925,9 +2944,7 @@ object *sp_time (object *args, object *env) {
} }
object *sp_withoutputtostring (object *args, object *env) { object *sp_withoutputtostring (object *args, object *env) {
if (args == NULL) error2(noargument); object *params = checkarguments(args, 1, 1);
object *params = first(args);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
object *pair = cons(var, stream(STRINGSTREAM, 0)); object *pair = cons(var, stream(STRINGSTREAM, 0));
push(pair,env); push(pair,env);
@ -2940,8 +2957,7 @@ object *sp_withoutputtostring (object *args, object *env) {
} }
object *sp_withserial (object *args, object *env) { object *sp_withserial (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 3);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
int address = checkinteger(eval(second(params), env)); int address = checkinteger(eval(second(params), env));
params = cddr(params); params = cddr(params);
@ -2957,8 +2973,7 @@ object *sp_withserial (object *args, object *env) {
} }
object *sp_withi2c (object *args, object *env) { object *sp_withi2c (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 4);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
int address = checkinteger(eval(second(params), env)); int address = checkinteger(eval(second(params), env));
params = cddr(params); params = cddr(params);
@ -2988,8 +3003,7 @@ object *sp_withi2c (object *args, object *env) {
} }
object *sp_withspi (object *args, object *env) { object *sp_withspi (object *args, object *env) {
object *params = first(args); object *params = checkarguments(args, 2, 6);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
params = cdr(params); params = cdr(params);
if (params == NULL) error2(nostream); if (params == NULL) error2(nostream);
@ -3033,8 +3047,7 @@ object *sp_withspi (object *args, object *env) {
object *sp_withsdcard (object *args, object *env) { object *sp_withsdcard (object *args, object *env) {
#if defined(sdcardsupport) #if defined(sdcardsupport)
object *params = first(args); object *params = checkarguments(args, 2, 3);
if (params == NULL) error2(nostream);
object *var = first(params); object *var = first(params);
params = cdr(params); params = cdr(params);
if (params == NULL) error2(PSTR("no filename specified")); if (params == NULL) error2(PSTR("no filename specified"));
@ -4467,7 +4480,7 @@ object *fn_analogread (object *args, object *env) {
object *fn_analogreference (object *args, object *env) { object *fn_analogreference (object *args, object *env) {
(void) env; (void) env;
object *arg = first(args); object *arg = first(args);
#if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040) || defined(ARDUINO_SEEED_XIAO_RP2040) #if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_RASPBERRY_PI_PICO_W) || defined(ARDUINO_ADAFRUIT_FEATHER_RP2040) || defined(ARDUINO_ADAFRUIT_QTPY_RP2040)
error2(PSTR("not supported")); error2(PSTR("not supported"));
#else #else
analogReference((eAnalogReference)checkkeyword(arg)); analogReference((eAnalogReference)checkkeyword(arg));
@ -4825,7 +4838,7 @@ object *sp_error (object *args, object *env) {
object *sp_withclient (object *args, object *env) { object *sp_withclient (object *args, object *env) {
#if defined(ULISP_WIFI) #if defined(ULISP_WIFI)
object *params = first(args); object *params = checkarguments(args, 1, 3);
object *var = first(params); object *var = first(params);
char buffer[BUFFERSIZE]; char buffer[BUFFERSIZE];
params = cdr(params); params = cdr(params);
@ -4955,7 +4968,7 @@ object *fn_wificonnect (object *args, object *env) {
object *sp_withgfx (object *args, object *env) { object *sp_withgfx (object *args, object *env) {
#if defined(gfxsupport) #if defined(gfxsupport)
object *params = first(args); object *params = checkarguments(args, 1, 1);
object *var = first(params); object *var = first(params);
object *pair = cons(var, stream(GFXSTREAM, 1)); object *pair = cons(var, stream(GFXSTREAM, 1));
push(pair,env); push(pair,env);
@ -5885,7 +5898,7 @@ const char doc133[] PROGMEM = "(exp number)\n"
"Returns exp(number)."; "Returns exp(number).";
const char doc134[] PROGMEM = "(sqrt number)\n" const char doc134[] PROGMEM = "(sqrt number)\n"
"Returns sqrt(number)."; "Returns sqrt(number).";
const char doc135[] PROGMEM = "(number [base])\n" const char doc135[] PROGMEM = "(log number [base])\n"
"Returns the logarithm of number to the specified base. If base is omitted it defaults to e."; "Returns the logarithm of number to the specified base. If base is omitted it defaults to e.";
const char doc136[] PROGMEM = "(expt number power)\n" const char doc136[] PROGMEM = "(expt number power)\n"
"Returns number raised to the specified power.\n" "Returns number raised to the specified power.\n"
@ -5895,10 +5908,10 @@ const char doc137[] PROGMEM = "(ceiling number [divisor])\n"
"Returns ceil(number/divisor). If omitted, divisor is 1."; "Returns ceil(number/divisor). If omitted, divisor is 1.";
const char doc138[] PROGMEM = "(floor number [divisor])\n" const char doc138[] PROGMEM = "(floor number [divisor])\n"
"Returns floor(number/divisor). If omitted, divisor is 1."; "Returns floor(number/divisor). If omitted, divisor is 1.";
const char doc139[] PROGMEM = "(truncate number)\n" const char doc139[] PROGMEM = "(truncate number [divisor])\n"
"Returns t if the argument is a floating-point number."; "Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.";
const char doc140[] PROGMEM = "(round number)\n" const char doc140[] PROGMEM = "(round number [divisor])\n"
"Returns t if the argument is a floating-point number."; "Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.";
const char doc141[] PROGMEM = "(char string n)\n" const char doc141[] PROGMEM = "(char string n)\n"
"Returns the nth character in a string, counting from zero."; "Returns the nth character in a string, counting from zero.";
const char doc142[] PROGMEM = "(char-code character)\n" const char doc142[] PROGMEM = "(char-code character)\n"
@ -5939,10 +5952,8 @@ const char doc157[] PROGMEM = "(logior [value*])\n"
"Returns the bitwise | of the values."; "Returns the bitwise | of the values.";
const char doc158[] PROGMEM = "(logxor [value*])\n" const char doc158[] PROGMEM = "(logxor [value*])\n"
"Returns the bitwise ^ of the values."; "Returns the bitwise ^ of the values.";
const char doc159[] PROGMEM = "(prin1-to-string item [stream])\n" const char doc159[] PROGMEM = "(lognot value)\n"
"Prints its argument to a string, and returns the string.\n" "Returns the bitwise logical NOT of the value.";
"Characters and strings are printed with quotation marks and escape characters,\n"
"in a format that will be suitable for read-from-string.";
const char doc160[] PROGMEM = "(ash value shift)\n" const char doc160[] PROGMEM = "(ash value shift)\n"
"Returns the result of bitwise shifting value by shift bits. If shift is positive, value is shifted to the left."; "Returns the result of bitwise shifting value by shift bits. If shift is positive, value is shifted to the left.";
const char doc161[] PROGMEM = "(logbitp bit value)\n" const char doc161[] PROGMEM = "(logbitp bit value)\n"
@ -6591,7 +6602,7 @@ object *eval (object *form, object *env) {
EVAL: EVAL:
// Enough space? // Enough space?
// Serial.println((uint32_t)sp - (uint32_t)&ENDSTACK); // Find best STACKDIFF value // Serial.println((uint32_t)sp - (uint32_t)&ENDSTACK); // Find best STACKDIFF value
if (((uint32_t)sp - (uint32_t)&ENDSTACK) < STACKDIFF) { Context = 0; error2(PSTR("stack overflow")); } if (((uint32_t)sp - (uint32_t)&ENDSTACK) < STACKDIFF) { Context = NIL; error2(PSTR("stack overflow")); }
if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // GC when 1/16 of workspace left if (Freespace <= WORKSPACESIZE>>4) gc(form, env); // GC when 1/16 of workspace left
// Escape // Escape
if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));} if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));}
@ -6608,6 +6619,7 @@ object *eval (object *form, object *env) {
pair = value(name, GlobalEnv); pair = value(name, GlobalEnv);
if (pair != NULL) return cdr(pair); if (pair != NULL) return cdr(pair);
else if (builtinp(name)) return form; else if (builtinp(name)) return form;
Context = NIL;
error(PSTR("undefined"), form); error(PSTR("undefined"), form);
} }
@ -7178,7 +7190,6 @@ object *nextitem (gfun_t gfun) {
if (ch == '.') valid = 0; else if (digitvalue(ch)<base) valid = 1; else valid = -1; if (ch == '.') valid = 0; else if (digitvalue(ch)<base) valid = 1; else valid = -1;
bool isexponent = false; bool isexponent = false;
int exponent = 0, esign = 1; int exponent = 0, esign = 1;
buffer[2] = '\0'; buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; // In case symbol is < 5 letters
float divisor = 10.0; float divisor = 10.0;
while(!issp(ch) && !isbr(ch) && index < bufmax) { while(!issp(ch) && !isbr(ch) && index < bufmax) {
@ -7229,8 +7240,7 @@ object *nextitem (gfun_t gfun) {
builtin_t x = lookupbuiltin(buffer); builtin_t x = lookupbuiltin(buffer);
if (x == NIL) return nil; if (x == NIL) return nil;
if (x != ENDFUNCTIONS) return bsymbol(x); if (x != ENDFUNCTIONS) return bsymbol(x);
else if ((index <= 6) && valid40(buffer)) return intern(twist(pack40(buffer))); if (index <= 6 && valid40(buffer)) return intern(twist(pack40(buffer)));
buffer[index+1] = '\0'; buffer[index+2] = '\0'; buffer[index+3] = '\0'; // For internlong
return internlong(buffer); return internlong(buffer);
} }
@ -7297,6 +7307,7 @@ void initgfx () {
#endif #endif
} }
// Entry point from the Arduino IDE
void setup () { void setup () {
Serial.begin(9600); Serial.begin(9600);
int start = millis(); int start = millis();
@ -7305,7 +7316,7 @@ void setup () {
initenv(); initenv();
initsleep(); initsleep();
initgfx(); initgfx();
pfstring(PSTR("uLisp 4.4a "), pserial); pln(pserial); pfstring(PSTR("uLisp 4.4b "), pserial); pln(pserial);
} }
// Read/Evaluate/Print loop // Read/Evaluate/Print loop
@ -7322,7 +7333,7 @@ void repl (object *env) {
pint(BreakLevel, pserial); pint(BreakLevel, pserial);
} }
pserial('>'); pserial(' '); pserial('>'); pserial(' ');
Context = 0; Context = NIL;
object *line = read(gserial); object *line = read(gserial);
#if defined(CPU_NRF52840) #if defined(CPU_NRF52840)
Serial.flush(); Serial.flush();