Release 4.4b - 3rd April 2023
This commit is contained in:
David Johnson-Davies
GitHub
parent
1d58a95a5e
commit
41fb7d760d
|
|
@ -1,5 +1,5 @@
|
|||
/* uLisp ARM Release 4.4a - www.ulisp.com
|
||||
David Johnson-Davies - www.technoblogy.com - 22nd March 2023
|
||||
/* uLisp ARM Release 4.4b - www.ulisp.com
|
||||
David Johnson-Davies - www.technoblogy.com - 3rd April 2023
|
||||
|
||||
Licensed under the MIT license: https://opensource.org/licenses/MIT
|
||||
*/
|
||||
|
|
@ -206,7 +206,7 @@ const char LispLibrary[] PROGMEM = "";
|
|||
#define CPU_RP2040
|
||||
|
||||
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
|
||||
#define WORKSPACESIZE (15872-SDSIZE) /* Objects (8*bytes) */
|
||||
#define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
|
||||
#define LITTLEFS
|
||||
#include <WiFi.h>
|
||||
#include <LittleFS.h>
|
||||
|
|
@ -584,10 +584,15 @@ bool eqsymbols (object *obj, char *buffer) {
|
|||
object *arg = cdr(obj);
|
||||
int i = 0;
|
||||
while (!(arg == NULL && buffer[i] == 0)) {
|
||||
if (arg == NULL || buffer[i] == 0 ||
|
||||
arg->chars != (buffer[i]<<24 | buffer[i+1]<<16 | buffer[i+2]<<8 | buffer[i+3])) return false;
|
||||
if (arg == NULL || buffer[i] == 0) 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);
|
||||
i = i + 4;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
|
@ -1268,7 +1273,7 @@ int8_t toradix40 (char ch) {
|
|||
fromradix40 - returns the character encoded by the number 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 == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$';
|
||||
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.
|
||||
*/
|
||||
uint32_t pack40 (char *buffer) {
|
||||
int x = 0;
|
||||
for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]);
|
||||
int x = 0, j = 0;
|
||||
for (int i=0; i<6; i++) {
|
||||
x = x * 40 + toradix40(buffer[j]);
|
||||
if (buffer[j] != 0) j++;
|
||||
}
|
||||
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.
|
||||
*/
|
||||
bool valid40 (char *buffer) {
|
||||
if (toradix40(buffer[0]) < 11) return false;
|
||||
for (int i=1; i<6; i++) if (toradix40(buffer[i]) < 0) return false;
|
||||
int t = 11;
|
||||
for (int i=0; i<6; i++) {
|
||||
if (toradix40(buffer[i]) < t) return false;
|
||||
if (buffer[i] == 0) break;
|
||||
t = 0;
|
||||
}
|
||||
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
|
||||
*/
|
||||
float checkintfloat (object *obj){
|
||||
if (integerp(obj)) return obj->integer;
|
||||
float checkintfloat (object *obj) {
|
||||
if (integerp(obj)) return (float)obj->integer;
|
||||
if (!floatp(obj)) error(notanumber, obj);
|
||||
return obj->single_float;
|
||||
}
|
||||
|
|
@ -1411,6 +1423,20 @@ int listlength (object *list) {
|
|||
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
|
||||
|
||||
/*
|
||||
|
|
@ -3185,8 +3211,7 @@ object *sp_setf (object *args, object *env) {
|
|||
It then returns result, or nil if result is omitted.
|
||||
*/
|
||||
object *sp_dolist (object *args, object *env) {
|
||||
if (args == NULL || listlength(first(args)) < 2) error2(noargument);
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
object *list = eval(second(params), env);
|
||||
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.
|
||||
*/
|
||||
object *sp_dotimes (object *args, object *env) {
|
||||
if (args == NULL || listlength(first(args)) < 2) error2(noargument);
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
int count = checkinteger(eval(second(params), env));
|
||||
int index = 0;
|
||||
|
|
@ -3300,8 +3324,7 @@ object *sp_untrace (object *args, object *env) {
|
|||
Returns the total number of milliseconds taken.
|
||||
*/
|
||||
object *sp_formillis (object *args, object *env) {
|
||||
if (args == NULL) error2(noargument);
|
||||
object *param = first(args);
|
||||
object *param = checkarguments(args, 0, 1);
|
||||
unsigned long start = millis();
|
||||
unsigned long now, total = 0;
|
||||
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.
|
||||
*/
|
||||
object *sp_withoutputtostring (object *args, object *env) {
|
||||
if (args == NULL) error2(noargument);
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 1, 1);
|
||||
object *var = first(params);
|
||||
object *pair = cons(var, stream(STRINGSTREAM, 0));
|
||||
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.
|
||||
*/
|
||||
object *sp_withserial (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
int address = checkinteger(eval(second(params), env));
|
||||
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.
|
||||
*/
|
||||
object *sp_withi2c (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 4);
|
||||
object *var = first(params);
|
||||
int address = checkinteger(eval(second(params), env));
|
||||
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).
|
||||
*/
|
||||
object *sp_withspi (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 6);
|
||||
object *var = first(params);
|
||||
params = cdr(params);
|
||||
if (params == NULL) error2(nostream);
|
||||
|
|
@ -3472,8 +3490,7 @@ object *sp_withspi (object *args, object *env) {
|
|||
*/
|
||||
object *sp_withsdcard (object *args, object *env) {
|
||||
#if defined(sdcardsupport)
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
params = cdr(params);
|
||||
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.
|
||||
*/
|
||||
object *fn_log (object *args, object *env) {
|
||||
|
|
@ -4803,8 +4820,8 @@ object *fn_floor (object *args, object *env) {
|
|||
}
|
||||
|
||||
/*
|
||||
(truncate number)
|
||||
Returns t if the argument is a floating-point number.
|
||||
(truncate number [divisor])
|
||||
Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.
|
||||
*/
|
||||
object *fn_truncate (object *args, object *env) {
|
||||
(void) env;
|
||||
|
|
@ -4815,8 +4832,8 @@ object *fn_truncate (object *args, object *env) {
|
|||
}
|
||||
|
||||
/*
|
||||
(round number)
|
||||
Returns t if the argument is a floating-point number.
|
||||
(round number [divisor])
|
||||
Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.
|
||||
*/
|
||||
object *fn_round (object *args, object *env) {
|
||||
(void) env;
|
||||
|
|
@ -5130,10 +5147,8 @@ object *fn_logxor (object *args, object *env) {
|
|||
}
|
||||
|
||||
/*
|
||||
(prin1-to-string item [stream])
|
||||
Prints its argument to a string, and returns the string.
|
||||
Characters and strings are printed with quotation marks and escape characters,
|
||||
in a format that will be suitable for read-from-string.
|
||||
(lognot value)
|
||||
Returns the bitwise logical NOT of the value.
|
||||
*/
|
||||
object *fn_lognot (object *args, object *env) {
|
||||
(void) env;
|
||||
|
|
@ -5516,7 +5531,7 @@ object *fn_analogread (object *args, object *env) {
|
|||
object *fn_analogreference (object *args, object *env) {
|
||||
(void) env;
|
||||
object *arg = first(args);
|
||||
#if defined(ARDUINO_TEENSY40) || defined(ARDUINO_TEENSY41) || defined(MAX32620) || defined(ARDUINO_RASPBERRY_PI_PICO) || defined(ARDUINO_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"));
|
||||
#else
|
||||
analogReference((eAnalogReference)checkkeyword(arg));
|
||||
|
|
@ -5973,7 +5988,7 @@ object *sp_error (object *args, object *env) {
|
|||
*/
|
||||
object *sp_withclient (object *args, object *env) {
|
||||
#if defined(ULISP_WIFI)
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 1, 3);
|
||||
object *var = first(params);
|
||||
char buffer[BUFFERSIZE];
|
||||
params = cdr(params);
|
||||
|
|
@ -6133,7 +6148,7 @@ object *fn_wificonnect (object *args, object *env) {
|
|||
*/
|
||||
object *sp_withgfx (object *args, object *env) {
|
||||
#if defined(gfxsupport)
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 1, 1);
|
||||
object *var = first(params);
|
||||
object *pair = cons(var, stream(GFXSTREAM, 1));
|
||||
push(pair,env);
|
||||
|
|
@ -7146,7 +7161,7 @@ const char doc133[] PROGMEM = "(exp number)\n"
|
|||
"Returns exp(number).";
|
||||
const char doc134[] PROGMEM = "(sqrt number)\n"
|
||||
"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.";
|
||||
const char doc136[] PROGMEM = "(expt number 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.";
|
||||
const char doc138[] PROGMEM = "(floor number [divisor])\n"
|
||||
"Returns floor(number/divisor). If omitted, divisor is 1.";
|
||||
const char doc139[] PROGMEM = "(truncate number)\n"
|
||||
"Returns t if the argument is a floating-point number.";
|
||||
const char doc140[] PROGMEM = "(round number)\n"
|
||||
"Returns t if the argument is a floating-point number.";
|
||||
const char doc139[] PROGMEM = "(truncate number [divisor])\n"
|
||||
"Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.";
|
||||
const char doc140[] PROGMEM = "(round number [divisor])\n"
|
||||
"Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.";
|
||||
const char doc141[] PROGMEM = "(char string n)\n"
|
||||
"Returns the nth character in a string, counting from zero.";
|
||||
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.";
|
||||
const char doc158[] PROGMEM = "(logxor [value*])\n"
|
||||
"Returns the bitwise ^ of the values.";
|
||||
const char doc159[] PROGMEM = "(prin1-to-string item [stream])\n"
|
||||
"Prints its argument to a string, and returns the string.\n"
|
||||
"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 doc159[] PROGMEM = "(lognot value)\n"
|
||||
"Returns the bitwise logical NOT of the value.";
|
||||
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.";
|
||||
const char doc161[] PROGMEM = "(logbitp bit value)\n"
|
||||
|
|
@ -7881,7 +7894,7 @@ object *eval (object *form, object *env) {
|
|||
EVAL:
|
||||
// Enough space?
|
||||
// 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
|
||||
// Escape
|
||||
if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));}
|
||||
|
|
@ -7898,6 +7911,7 @@ object *eval (object *form, object *env) {
|
|||
pair = value(name, GlobalEnv);
|
||||
if (pair != NULL) return cdr(pair);
|
||||
else if (builtinp(name)) return form;
|
||||
Context = NIL;
|
||||
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;
|
||||
bool isexponent = false;
|
||||
int exponent = 0, esign = 1;
|
||||
buffer[2] = '\0'; buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; // In case symbol is < 5 letters
|
||||
float divisor = 10.0;
|
||||
|
||||
while(!issp(ch) && !isbr(ch) && index < bufmax) {
|
||||
|
|
@ -8607,8 +8620,7 @@ object *nextitem (gfun_t gfun) {
|
|||
builtin_t x = lookupbuiltin(buffer);
|
||||
if (x == NIL) return nil;
|
||||
if (x != ENDFUNCTIONS) return bsymbol(x);
|
||||
else if ((index <= 6) && valid40(buffer)) return intern(twist(pack40(buffer)));
|
||||
buffer[index+1] = '\0'; buffer[index+2] = '\0'; buffer[index+3] = '\0'; // For internlong
|
||||
if (index <= 6 && valid40(buffer)) return intern(twist(pack40(buffer)));
|
||||
return internlong(buffer);
|
||||
}
|
||||
|
||||
|
|
@ -8687,9 +8699,7 @@ void initgfx () {
|
|||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
setup - entry point from the Arduino IDE
|
||||
*/
|
||||
// Entry point from the Arduino IDE
|
||||
void setup () {
|
||||
Serial.begin(9600);
|
||||
int start = millis();
|
||||
|
|
@ -8698,7 +8708,7 @@ void setup () {
|
|||
initenv();
|
||||
initsleep();
|
||||
initgfx();
|
||||
pfstring(PSTR("uLisp 4.4a "), pserial); pln(pserial);
|
||||
pfstring(PSTR("uLisp 4.4b "), pserial); pln(pserial);
|
||||
}
|
||||
|
||||
// Read/Evaluate/Print loop
|
||||
|
|
@ -8718,7 +8728,7 @@ void repl (object *env) {
|
|||
pint(BreakLevel, pserial);
|
||||
}
|
||||
pserial('>'); pserial(' ');
|
||||
Context = 0;
|
||||
Context = NIL;
|
||||
object *line = read(gserial);
|
||||
#if defined(CPU_NRF52840)
|
||||
Serial.flush();
|
||||
|
|
|
|||
107
ulisp-arm.ino
107
ulisp-arm.ino
|
|
@ -1,5 +1,5 @@
|
|||
/* uLisp ARM Release 4.4a - www.ulisp.com
|
||||
David Johnson-Davies - www.technoblogy.com - 22nd March 2023
|
||||
/* uLisp ARM Release 4.4b - www.ulisp.com
|
||||
David Johnson-Davies - www.technoblogy.com - 3rd April 2023
|
||||
|
||||
Licensed under the MIT license: https://opensource.org/licenses/MIT
|
||||
*/
|
||||
|
|
@ -206,7 +206,7 @@ const char LispLibrary[] PROGMEM = "";
|
|||
#define CPU_RP2040
|
||||
|
||||
#elif defined(ARDUINO_RASPBERRY_PI_PICO_W)
|
||||
#define WORKSPACESIZE (15872-SDSIZE) /* Objects (8*bytes) */
|
||||
#define WORKSPACESIZE (15536-SDSIZE) /* Objects (8*bytes) */
|
||||
#define LITTLEFS
|
||||
#include <WiFi.h>
|
||||
#include <LittleFS.h>
|
||||
|
|
@ -521,10 +521,15 @@ bool eqsymbols (object *obj, char *buffer) {
|
|||
object *arg = cdr(obj);
|
||||
int i = 0;
|
||||
while (!(arg == NULL && buffer[i] == 0)) {
|
||||
if (arg == NULL || buffer[i] == 0 ||
|
||||
arg->chars != (buffer[i]<<24 | buffer[i+1]<<16 | buffer[i+2]<<8 | buffer[i+3])) return false;
|
||||
if (arg == NULL || buffer[i] == 0) 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);
|
||||
i = i + 4;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
|
@ -1145,21 +1150,28 @@ int8_t toradix40 (char ch) {
|
|||
}
|
||||
|
||||
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 == 37) return '-'; if (n == 38) return '*'; if (n == 39) return '$';
|
||||
return 0;
|
||||
}
|
||||
|
||||
uint32_t pack40 (char *buffer) {
|
||||
int x = 0;
|
||||
for (int i=0; i<6; i++) x = x * 40 + toradix40(buffer[i]);
|
||||
int x = 0, j = 0;
|
||||
for (int i=0; i<6; i++) {
|
||||
x = x * 40 + toradix40(buffer[j]);
|
||||
if (buffer[j] != 0) j++;
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
||||
bool valid40 (char *buffer) {
|
||||
if (toradix40(buffer[0]) < 11) return false;
|
||||
for (int i=1; i<6; i++) if (toradix40(buffer[i]) < 0) return false;
|
||||
int t = 11;
|
||||
for (int i=0; i<6; i++) {
|
||||
if (toradix40(buffer[i]) < t) return false;
|
||||
if (buffer[i] == 0) break;
|
||||
t = 0;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
||||
|
|
@ -1182,8 +1194,8 @@ int checkbitvalue (object *obj) {
|
|||
return n;
|
||||
}
|
||||
|
||||
float checkintfloat (object *obj){
|
||||
if (integerp(obj)) return obj->integer;
|
||||
float checkintfloat (object *obj) {
|
||||
if (integerp(obj)) return (float)obj->integer;
|
||||
if (!floatp(obj)) error(notanumber, obj);
|
||||
return obj->single_float;
|
||||
}
|
||||
|
|
@ -1251,6 +1263,16 @@ int listlength (object *list) {
|
|||
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
|
||||
|
||||
object *add_floats (object *args, float fresult) {
|
||||
|
|
@ -2797,8 +2819,7 @@ object *sp_setf (object *args, object *env) {
|
|||
// Other special forms
|
||||
|
||||
object *sp_dolist (object *args, object *env) {
|
||||
if (args == NULL || listlength(first(args)) < 2) error2(noargument);
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
object *list = eval(second(params), env);
|
||||
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) {
|
||||
if (args == NULL || listlength(first(args)) < 2) error2(noargument);
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
int count = checkinteger(eval(second(params), env));
|
||||
int index = 0;
|
||||
|
|
@ -2892,8 +2912,7 @@ object *sp_untrace (object *args, object *env) {
|
|||
}
|
||||
|
||||
object *sp_formillis (object *args, object *env) {
|
||||
if (args == NULL) error2(noargument);
|
||||
object *param = first(args);
|
||||
object *param = checkarguments(args, 0, 1);
|
||||
unsigned long start = millis();
|
||||
unsigned long now, total = 0;
|
||||
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) {
|
||||
if (args == NULL) error2(noargument);
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 1, 1);
|
||||
object *var = first(params);
|
||||
object *pair = cons(var, stream(STRINGSTREAM, 0));
|
||||
push(pair,env);
|
||||
|
|
@ -2940,8 +2957,7 @@ object *sp_withoutputtostring (object *args, object *env) {
|
|||
}
|
||||
|
||||
object *sp_withserial (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
int address = checkinteger(eval(second(params), env));
|
||||
params = cddr(params);
|
||||
|
|
@ -2957,8 +2973,7 @@ object *sp_withserial (object *args, object *env) {
|
|||
}
|
||||
|
||||
object *sp_withi2c (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 4);
|
||||
object *var = first(params);
|
||||
int address = checkinteger(eval(second(params), env));
|
||||
params = cddr(params);
|
||||
|
|
@ -2988,8 +3003,7 @@ object *sp_withi2c (object *args, object *env) {
|
|||
}
|
||||
|
||||
object *sp_withspi (object *args, object *env) {
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 6);
|
||||
object *var = first(params);
|
||||
params = cdr(params);
|
||||
if (params == NULL) error2(nostream);
|
||||
|
|
@ -3033,8 +3047,7 @@ object *sp_withspi (object *args, object *env) {
|
|||
|
||||
object *sp_withsdcard (object *args, object *env) {
|
||||
#if defined(sdcardsupport)
|
||||
object *params = first(args);
|
||||
if (params == NULL) error2(nostream);
|
||||
object *params = checkarguments(args, 2, 3);
|
||||
object *var = first(params);
|
||||
params = cdr(params);
|
||||
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) {
|
||||
(void) env;
|
||||
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"));
|
||||
#else
|
||||
analogReference((eAnalogReference)checkkeyword(arg));
|
||||
|
|
@ -4825,7 +4838,7 @@ object *sp_error (object *args, object *env) {
|
|||
|
||||
object *sp_withclient (object *args, object *env) {
|
||||
#if defined(ULISP_WIFI)
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 1, 3);
|
||||
object *var = first(params);
|
||||
char buffer[BUFFERSIZE];
|
||||
params = cdr(params);
|
||||
|
|
@ -4955,7 +4968,7 @@ object *fn_wificonnect (object *args, object *env) {
|
|||
|
||||
object *sp_withgfx (object *args, object *env) {
|
||||
#if defined(gfxsupport)
|
||||
object *params = first(args);
|
||||
object *params = checkarguments(args, 1, 1);
|
||||
object *var = first(params);
|
||||
object *pair = cons(var, stream(GFXSTREAM, 1));
|
||||
push(pair,env);
|
||||
|
|
@ -5885,7 +5898,7 @@ const char doc133[] PROGMEM = "(exp number)\n"
|
|||
"Returns exp(number).";
|
||||
const char doc134[] PROGMEM = "(sqrt number)\n"
|
||||
"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.";
|
||||
const char doc136[] PROGMEM = "(expt number 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.";
|
||||
const char doc138[] PROGMEM = "(floor number [divisor])\n"
|
||||
"Returns floor(number/divisor). If omitted, divisor is 1.";
|
||||
const char doc139[] PROGMEM = "(truncate number)\n"
|
||||
"Returns t if the argument is a floating-point number.";
|
||||
const char doc140[] PROGMEM = "(round number)\n"
|
||||
"Returns t if the argument is a floating-point number.";
|
||||
const char doc139[] PROGMEM = "(truncate number [divisor])\n"
|
||||
"Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.";
|
||||
const char doc140[] PROGMEM = "(round number [divisor])\n"
|
||||
"Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.";
|
||||
const char doc141[] PROGMEM = "(char string n)\n"
|
||||
"Returns the nth character in a string, counting from zero.";
|
||||
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.";
|
||||
const char doc158[] PROGMEM = "(logxor [value*])\n"
|
||||
"Returns the bitwise ^ of the values.";
|
||||
const char doc159[] PROGMEM = "(prin1-to-string item [stream])\n"
|
||||
"Prints its argument to a string, and returns the string.\n"
|
||||
"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 doc159[] PROGMEM = "(lognot value)\n"
|
||||
"Returns the bitwise logical NOT of the value.";
|
||||
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.";
|
||||
const char doc161[] PROGMEM = "(logbitp bit value)\n"
|
||||
|
|
@ -6591,7 +6602,7 @@ object *eval (object *form, object *env) {
|
|||
EVAL:
|
||||
// Enough space?
|
||||
// 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
|
||||
// Escape
|
||||
if (tstflag(ESCAPE)) { clrflag(ESCAPE); error2(PSTR("escape!"));}
|
||||
|
|
@ -6608,6 +6619,7 @@ object *eval (object *form, object *env) {
|
|||
pair = value(name, GlobalEnv);
|
||||
if (pair != NULL) return cdr(pair);
|
||||
else if (builtinp(name)) return form;
|
||||
Context = NIL;
|
||||
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;
|
||||
bool isexponent = false;
|
||||
int exponent = 0, esign = 1;
|
||||
buffer[2] = '\0'; buffer[3] = '\0'; buffer[4] = '\0'; buffer[5] = '\0'; // In case symbol is < 5 letters
|
||||
float divisor = 10.0;
|
||||
|
||||
while(!issp(ch) && !isbr(ch) && index < bufmax) {
|
||||
|
|
@ -7229,8 +7240,7 @@ object *nextitem (gfun_t gfun) {
|
|||
builtin_t x = lookupbuiltin(buffer);
|
||||
if (x == NIL) return nil;
|
||||
if (x != ENDFUNCTIONS) return bsymbol(x);
|
||||
else if ((index <= 6) && valid40(buffer)) return intern(twist(pack40(buffer)));
|
||||
buffer[index+1] = '\0'; buffer[index+2] = '\0'; buffer[index+3] = '\0'; // For internlong
|
||||
if (index <= 6 && valid40(buffer)) return intern(twist(pack40(buffer)));
|
||||
return internlong(buffer);
|
||||
}
|
||||
|
||||
|
|
@ -7297,6 +7307,7 @@ void initgfx () {
|
|||
#endif
|
||||
}
|
||||
|
||||
// Entry point from the Arduino IDE
|
||||
void setup () {
|
||||
Serial.begin(9600);
|
||||
int start = millis();
|
||||
|
|
@ -7305,7 +7316,7 @@ void setup () {
|
|||
initenv();
|
||||
initsleep();
|
||||
initgfx();
|
||||
pfstring(PSTR("uLisp 4.4a "), pserial); pln(pserial);
|
||||
pfstring(PSTR("uLisp 4.4b "), pserial); pln(pserial);
|
||||
}
|
||||
|
||||
// Read/Evaluate/Print loop
|
||||
|
|
@ -7322,7 +7333,7 @@ void repl (object *env) {
|
|||
pint(BreakLevel, pserial);
|
||||
}
|
||||
pserial('>'); pserial(' ');
|
||||
Context = 0;
|
||||
Context = NIL;
|
||||
object *line = read(gserial);
|
||||
#if defined(CPU_NRF52840)
|
||||
Serial.flush();
|
||||
|
|
|
|||
Loading…
Reference in New Issue