Release 4.4b - 31st March 2023

Author: technoblogy

ulisp-esp-comments.ino

@@ -1,5 +1,5 @@
-/* uLisp ESP Release 4.4 - www.ulisp.com
-   David Johnson-Davies - www.technoblogy.com - 21st March 2023
+/* uLisp ESP Release 4.4b - www.ulisp.com
+   David Johnson-Davies - www.technoblogy.com - 31st March 2023
 
    Licensed under the MIT license: https://opensource.org/licenses/MIT
 */
@@ -498,10 +498,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;
 }
@@ -1003,7 +1008,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;
@@ -1013,17 +1018,24 @@ 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;
 }
 
 /*
   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;
 }
 
@@ -1058,8 +1070,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;
 }
@@ -1146,6 +1158,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
 
 /*
@@ -2599,8 +2625,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
@@ -2635,8 +2660,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;
@@ -2714,8 +2738,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));
@@ -2756,9 +2779,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);
@@ -2776,8 +2797,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);
@@ -2799,8 +2819,7 @@ object *sp_withserial (object *args, object *env) {
   to be read from the stream. The port if specified is ignored.
 */
 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);
@@ -2828,8 +2847,7 @@ object *sp_withi2c (object *args, object *env) {
   bitorder 0 for LSBFIRST and 1 for MSBFIRST (default 1), and SPI mode (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);
@@ -2870,8 +2888,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"));
@@ -4033,7 +4050,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) {
@@ -4090,8 +4107,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;
@@ -4102,8 +4119,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;
@@ -4417,10 +4434,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;
@@ -5226,7 +5241,7 @@ object *sp_error (object *args, object *env) {
   Evaluates the forms with str bound to a wifi-stream.
 */
 object *sp_withclient (object *args, object *env) {
-  object *params = first(args);
+  object *params = checkarguments(args, 1, 3);
   object *var = first(params);
   char buffer[BUFFERSIZE];
   params = cdr(params);
@@ -5345,7 +5360,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);
@@ -6204,7 +6219,7 @@ const char doc131[] PROGMEM = "(exp number)\n"
 "Returns exp(number).";
 const char doc132[] PROGMEM = "(sqrt number)\n"
 "Returns sqrt(number).";
-const char doc133[] PROGMEM = "(number [base])\n"
+const char doc133[] PROGMEM = "(log number [base])\n"
 "Returns the logarithm of number to the specified base. If base is omitted it defaults to e.";
 const char doc134[] PROGMEM = "(expt number power)\n"
 "Returns number raised to the specified power.\n"
@@ -6214,10 +6229,10 @@ const char doc135[] PROGMEM = "(ceiling number [divisor])\n"
 "Returns ceil(number/divisor). If omitted, divisor is 1.";
 const char doc136[] PROGMEM = "(floor number [divisor])\n"
 "Returns floor(number/divisor). If omitted, divisor is 1.";
-const char doc137[] PROGMEM = "(truncate number)\n"
-"Returns t if the argument is a floating-point number.";
-const char doc138[] PROGMEM = "(round number)\n"
-"Returns t if the argument is a floating-point number.";
+const char doc137[] PROGMEM = "(truncate number [divisor])\n"
+"Returns the integer part of number/divisor. If divisor is omitted it defaults to 1.";
+const char doc138[] PROGMEM = "(round number [divisor])\n"
+"Returns the integer closest to number/divisor. If divisor is omitted it defaults to 1.";
 const char doc139[] PROGMEM = "(char string n)\n"
 "Returns the nth character in a string, counting from zero.";
 const char doc140[] PROGMEM = "(char-code character)\n"
@@ -6258,10 +6273,8 @@ const char doc155[] PROGMEM = "(logior [value*])\n"
 "Returns the bitwise | of the values.";
 const char doc156[] PROGMEM = "(logxor [value*])\n"
 "Returns the bitwise ^ of the values.";
-const char doc157[] 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 doc157[] PROGMEM = "(lognot value)\n"
+"Returns the bitwise logical NOT of the value.";
 const char doc158[] 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 doc159[] PROGMEM = "(logbitp bit value)\n"
@@ -6811,6 +6824,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);
   }
 
@@ -7443,7 +7457,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) {
@@ -7494,8 +7507,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);
 }
 
@@ -7568,9 +7580,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();
@@ -7579,7 +7589,7 @@ void setup () {
   initenv();
   initsleep();
   initgfx();
-  pfstring(PSTR("uLisp 4.4 "), pserial); pln(pserial);
+  pfstring(PSTR("uLisp 4.4b "), pserial); pln(pserial);
 }
 
 // Read/Evaluate/Print loop
@@ -7599,7 +7609,7 @@ void repl (object *env) {
       pint(BreakLevel, pserial);
     }
     pserial('>'); pserial(' ');
-    Context = 0;
+    Context = NIL;
     object *line = read(gserial);
     if (BreakLevel && line == nil) { pln(pserial); return; }
     if (line == (object *)KET) error2(PSTR("unmatched right bracket"));