Version 3.6b - 20th June 2021

technoblogy · web-flow · commit 21c6fc3e0def · 2021-06-20T09:01:03.000+01:00
Fixes technoblogy#51, fixes technoblogy#52
diff --git a/ulisp-esp.ino b/ulisp-esp.ino
@@ -1,5 +1,5 @@
-/* uLisp ESP Version 3.6 - www.ulisp.com
-   David Johnson-Davies - www.technoblogy.com - 4th April 2021
+/* uLisp ESP Version 3.6b - www.ulisp.com
+   David Johnson-Davies - www.technoblogy.com - 20th June 2021
 
    Licensed under the MIT license: https://opensource.org/licenses/MIT
 */
@@ -226,6 +226,7 @@ object *apply (symbol_t name, object *function, object *args, object *env);
 char *lookupsymbol (symbol_t name);
 char *cstring (object *form, char *buffer, int buflen);
 object *edit (object *fun);
+void pfstring (PGM_P s, pfun_t pfun);
 
 // Error handling
 
@@ -353,6 +354,13 @@ object *stream (uint8_t streamtype, uint8_t address) {
   return ptr;
 }
 
+object *newstring () {
+  object *ptr = myalloc();
+  ptr->type = STRING;
+  ptr->chars = 0;
+  return ptr;
+}
+
 // Garbage collection
 
 void markobject (object *obj) {
@@ -993,21 +1001,20 @@ void indent (uint8_t spaces, char ch, pfun_t pfun) {
 }
 
 object *startstring (symbol_t name) {
-  object *string = myalloc();
-  string->type = STRING;
-  GlobalString = NULL;
+  object *string = newstring();
+  GlobalString = string;
   GlobalStringIndex = 0;
   return string;
 }
 
-void buildstring (uint8_t ch, int *chars, object **head) {
+void buildstring (uint8_t ch, object *string, int *chars) {
   static object* tail;
   static uint8_t shift;
   if (*chars == 0) {
     shift = (sizeof(int)-1)*8;
     *chars = ch<<shift;
     object *cell = myalloc();
-    if (*head == NULL) *head = cell; else tail->car = cell;
+    if (cdr(string) == NULL) cdr(string) = cell; else tail->car = cell;
     cell->car = NULL;
     cell->chars = *chars;
     tail = cell;
@@ -1020,18 +1027,15 @@ void buildstring (uint8_t ch, int *chars, object **head) {
 }
 
 object *readstring (uint8_t delim, gfun_t gfun) {
-  object *obj = myalloc();
-  obj->type = STRING;
+  object *obj = newstring();
   int ch = gfun();
   if (ch == -1) return nil;
-  object *head = NULL;
   int chars = 0;
   while ((ch != delim) && (ch != -1)) {
     if (ch == '\\') ch = gfun();
-    buildstring(ch, &chars, &head);
+    buildstring(ch, obj, &chars);
     ch = gfun();
   }
-  obj->cdr = head;
   return obj;
 }
 
@@ -1073,7 +1077,7 @@ int gstr () {
 }
 
 void pstr (char c) {
-  buildstring(c, &GlobalStringIndex, &GlobalString);
+  buildstring(c, GlobalString, &GlobalStringIndex);
 }
 
 char *cstringbuf (object *arg) {
@@ -1100,17 +1104,14 @@ char *cstring (object *form, char *buffer, int buflen) {
 }
 
 object *lispstring (char *s) {
-  object *obj = myalloc();
-  obj->type = STRING;
+  object *obj = newstring();
   char ch = *s++;
-  object *head = NULL;
   int chars = 0;
   while (ch) {
     if (ch == '\\') ch = *s++;
-    buildstring(ch, &chars, &head);
+    buildstring(ch, obj, &chars);
     ch = *s++;
   }
-  obj->cdr = head;
   return obj;
 }
 
@@ -1857,10 +1858,10 @@ object *sp_withoutputtostring (object *args, object *env) {
   object *pair = cons(var, stream(STRINGSTREAM, 0));
   push(pair,env);
   object *string = startstring(WITHOUTPUTTOSTRING);
+  push(string, GCStack);
   object *forms = cdr(args);
   eval(tf_progn(forms,env), env);
-  string->cdr = GlobalString;
-  GlobalString = NULL;
+  pop(GCStack);
   return string;
 }
 
@@ -1887,7 +1888,7 @@ object *sp_withi2c (object *args, object *env) {
   object *var = first(params);
   int address = checkinteger(WITHI2C, eval(second(params), env));
   params = cddr(params);
-  if (address == 0) params = cdr(params); // Ignore port
+  if (address == 0 && params != NULL) params = cdr(params); // Ignore port
   int read = 0; // Write
   I2CCount = 0;
   if (params != NULL) {
@@ -3066,8 +3067,7 @@ object *fn_stringfn (object *args, object *env) {
   object *arg = first(args);
   int type = arg->type;
   if (type == STRING) return arg;
-  object *obj = myalloc();
-  obj->type = STRING;
+  object *obj = newstring();
   if (type == CHARACTER) {
     object *cell = myalloc();
     cell->car = NULL;
@@ -3077,14 +3077,12 @@ object *fn_stringfn (object *args, object *env) {
   } else if (type == SYMBOL) {
     char *s = symbolname(arg->name);
     char ch = *s++;
-    object *head = NULL;
     int chars = 0;
     while (ch) {
       if (ch == '\\') ch = *s++;
-      buildstring(ch, &chars, &head);
+      buildstring(ch, arg, &chars);
       ch = *s++;
     }
-    obj->cdr = head;
   } else error(STRINGFN, PSTR("can't convert to string"), arg);
   return obj;
 }
@@ -3094,9 +3092,7 @@ object *fn_concatenate (object *args, object *env) {
   object *arg = first(args);
   if (arg->name != STRINGFN) error2(CONCATENATE, PSTR("only supports strings"));
   args = cdr(args);
-  object *result = myalloc();
-  result->type = STRING;
-  object *head = NULL;
+  object *result = newstring();
   int chars = 0;
   while (args != NULL) {
     object *obj = first(args);
@@ -3106,14 +3102,13 @@ object *fn_concatenate (object *args, object *env) {
       int quad = obj->chars;
       while (quad != 0) {
          char ch = quad>>((sizeof(int)-1)*8) & 0xFF;
-         buildstring(ch, &chars, &head);
+         buildstring(ch, result, &chars);
          quad = quad<<8;
       }
       obj = car(obj);
     }
     args = cdr(args);
   }
-  result->cdr = head;
   return result;
 }
 
@@ -3126,16 +3121,13 @@ object *fn_subseq (object *args, object *env) {
   int end;
   args = cddr(args);
   if (args != NULL) end = checkinteger(SUBSEQ, car(args)); else end = stringlength(arg);
-  object *result = myalloc();
-  result->type = STRING;
-  object *head = NULL;
+  object *result = newstring();
   int chars = 0;
   for (int i=start; i<end; i++) {
     char ch = nthchar(arg, i);
     if (ch == 0) error2(SUBSEQ, PSTR("index out of range"));
-    buildstring(ch, &chars, &head);
+    buildstring(ch, result, &chars);
   }
-  result->cdr = head;
   return result;
 }
 
@@ -3153,7 +3145,6 @@ object *fn_princtostring (object *args, object *env) {
   object *arg = first(args);
   object *obj = startstring(PRINCTOSTRING);
   prin1object(arg, pstr);
-  obj->cdr = GlobalString;
   return obj;
 }
 
@@ -3162,7 +3153,6 @@ object *fn_prin1tostring (object *args, object *env) {
   object *arg = first(args);
   object *obj = startstring(PRIN1TOSTRING);
   printobject(arg, pstr);
-  obj->cdr = GlobalString;
   return obj;
 }
 
@@ -3641,7 +3631,7 @@ object *fn_format (object *args, object *env) {
     }
     n++;
   }
-  if (output == nil) { obj->cdr = GlobalString; return obj; }
+  if (output == nil) return obj;
   else return nil;
 }
 
