Version 1.9 16th May 2017

Version 1.9 16th May 2017

* support for characters and the character functions char, char-code, code-char, and characterp
* additional string functions string<, string>, read-from-string, prin1-to-string, and princ-to-string
* the additional I/O functions read-line, write-line, and write-string which support input/output via serial, SPI, and I2C where appropriate
* a sort function.

--- ulisp.ino
+++ ulisp.ino
@@ -1,5 +1,5 @@
-/* uLisp ATmega Version 1.8 - www.ulisp.com
-   David Johnson-Davies - www.technoblogy.com - 15th April 2017
+/* uLisp Version 1.9 - www.ulisp.com
+   David Johnson-Davies - www.technoblogy.com - 16th May 2017

    Licensed under the MIT license: https://opensource.org/licenses/MIT
 */
@@ -32,32 +32,37 @@
 #define numberp(x)         ((x)->type == NUMBER)
 #define symbolp(x)         ((x)->type == SYMBOL)
 #define stringp(x)         ((x)->type == STRING)
+#define characterp(x)      ((x)->type == CHARACTER)
 #define streamp(x)         ((x)->type == STREAM)

 #define mark(x)            (car(x) = (object *)(((unsigned int)(car(x))) | MARKBIT))
-#define unmark(x)          (car(x) = (object *)(((unsigned int)(car(x))) & MARKMASK))
+#define unmark(x)          (car(x) = (object *)(((unsigned int)(car(x))) & ~MARKBIT))
 #define marked(x)          ((((unsigned int)(car(x))) & MARKBIT) != 0)
-#define MARKBIT            0x0001
-#define MARKMASK           0xFFFE
+#define MARKBIT            1
+
+#define setflag(x)         (Flags = Flags | 1<<(x))
+#define clrflag(x)         (Flags = Flags & ~(1<<(x)))
+#define tstflag(x)         (Flags & 1<<(x))

 // Constants

 const int TRACEMAX = 3; // Number of traced functions
-enum type {ZERO=0, SYMBOL=2, NUMBER=4, STREAM=6, STRING=8, PAIR=10};  // STRING and PAIR must be last
+enum type { ZERO=0, SYMBOL=2, NUMBER=4, STREAM=6, CHARACTER=8, STRING=10, PAIR=12 };  // STRING and PAIR must be last
 enum token { UNUSED, BRA, KET, QUO, DOT };
 enum stream { SERIALSTREAM, I2CSTREAM, SPISTREAM };

-enum function { SYMBOLS, NIL, TEE, NOTHING, STRINGFN, AMPREST, LAMBDA, LET, LETSTAR, CLOSURE,
-SPECIAL_FORMS, QUOTE, DEFUN, DEFVAR, SETQ, LOOP, PUSH, POP, INCF, DECF, SETF, DOLIST, DOTIMES, TRACE,
-UNTRACE, FORMILLIS, WITHI2C, WITHSPI, TAIL_FORMS, PROGN, RETURN, IF, COND, WHEN, UNLESS, AND, OR,
-FUNCTIONS, NOT, NULLFN, CONS, ATOM, LISTP, CONSP, NUMBERP, SYMBOLP, STREAMP, EQ, CAR, FIRST, CDR, REST,
-CAAR, CADR, SECOND, CDAR, CDDR, CAAAR, CAADR, CADAR, CADDR, THIRD, CDAAR, CDADR, CDDAR, CDDDR, LENGTH,
-LIST, REVERSE, NTH, ASSOC, MEMBER, APPLY, FUNCALL, APPEND, MAPC, MAPCAR, ADD, SUBTRACT, MULTIPLY, DIVIDE,
-MOD, ONEPLUS, ONEMINUS, ABS, RANDOM, MAX, MIN, NUMEQ, LESS, LESSEQ, GREATER, GREATEREQ, NOTEQ, PLUSP,
-MINUSP, ZEROP, ODDP, EVENP, STRINGP, STRINGEQ, CONCATENATE, SUBSEQ, LOGAND, LOGIOR, LOGXOR, LOGNOT, ASH,
-LOGBITP, EVAL, GLOBALS, LOCALS, MAKUNBOUND, BREAK, READ, PRIN1, PRINT, PRINC, TERPRI, READLINE, READBYTE,
-WRITEBYTE, RESTARTI2C, GC, ROOM, SAVEIMAGE, LOADIMAGE, CLS, PINMODE, DIGITALREAD, DIGITALWRITE,
-ANALOGREAD, ANALOGWRITE, DELAY, MILLIS, NOTE, EDIT, PPRINT, ENDFUNCTIONS };
+enum function { SYMBOLS, NIL, TEE, NOTHING, AMPREST, LAMBDA, LET, LETSTAR, CLOSURE, SPECIAL_FORMS, QUOTE,
+DEFUN, DEFVAR, SETQ, LOOP, PUSH, POP, INCF, DECF, SETF, DOLIST, DOTIMES, TRACE, UNTRACE, FORMILLIS,
+WITHSERIAL, WITHI2C, WITHSPI, TAIL_FORMS, PROGN, RETURN, IF, COND, WHEN, UNLESS, AND, OR, FUNCTIONS, NOT,
+NULLFN, CONS, ATOM, LISTP, CONSP, NUMBERP, SYMBOLP, STREAMP, EQ, CAR, FIRST, CDR, REST, CAAR, CADR,
+SECOND, CDAR, CDDR, CAAAR, CAADR, CADAR, CADDR, THIRD, CDAAR, CDADR, CDDAR, CDDDR, LENGTH, LIST, REVERSE,
+NTH, ASSOC, MEMBER, APPLY, FUNCALL, APPEND, MAPC, MAPCAR, ADD, SUBTRACT, MULTIPLY, DIVIDE, MOD, ONEPLUS,
+ONEMINUS, ABS, RANDOM, MAX, MIN, NUMEQ, LESS, LESSEQ, GREATER, GREATEREQ, NOTEQ, PLUSP, MINUSP, ZEROP,
+ODDP, EVENP, CHAR, CHARCODE, CODECHAR, CHARACTERP, STRINGP, STRINGEQ, STRINGLESS, STRINGGREATER, SORT,
+STRINGFN, CONCATENATE, SUBSEQ, READFROMSTRING, PRINCTOSTRING, PRIN1TOSTRING, LOGAND, LOGIOR, LOGXOR,
+LOGNOT, ASH, LOGBITP, EVAL, GLOBALS, LOCALS, MAKUNBOUND, BREAK, READ, PRIN1, PRINT, PRINC, TERPRI,
+READBYTE, READLINE, WRITEBYTE, WRITESTRING, WRITELINE, RESTARTI2C, GC, ROOM, SAVEIMAGE, LOADIMAGE, CLS,
+PINMODE, DIGITALREAD, DIGITALWRITE, ANALOGREAD, ANALOGWRITE, DELAY, MILLIS, NOTE, EDIT, PPRINT, ENDFUNCTIONS };

 // Typedefs

@@ -88,22 +93,25 @@
   int max;
 } tbl_entry_t;

+typedef char (*gfun_t)();
+typedef void (*pfun_t)(char);
+
 // Workspace - sizes in bytes
 #define WORDALIGNED __attribute__((aligned (2)))
 #define BUFFERSIZE 18

 #if defined(__AVR_ATmega328P__)
-#define WORKSPACESIZE 317               /* Cells (4*bytes) */
+#define WORKSPACESIZE 316               /* Cells (4*bytes) */
 #define IMAGEDATASIZE 254               /* Cells */
 #define SYMBOLTABLESIZE BUFFERSIZE      /* Bytes - no long symbols */

 #elif defined(__AVR_ATmega2560__)
-#define WORKSPACESIZE 1280              /* Cells (4*bytes) */
+#define WORKSPACESIZE 1216              /* Cells (4*bytes) */
 #define IMAGEDATASIZE 893               /* Cells */
 #define SYMBOLTABLESIZE 512             /* Bytes */

 #elif defined(__AVR_ATmega1284P__)
-#define WORKSPACESIZE 2880              /* Cells (4*bytes) */
+#define WORKSPACESIZE 2816              /* Cells (4*bytes) */
 #define IMAGEDATASIZE 893               /* Cells */
 #define SYMBOLTABLESIZE 512             /* Bytes */

@@ -116,22 +124,25 @@

 jmp_buf exception;
 unsigned int Freespace = 0;
-char ReturnFlag = 0;
 object *Freelist;
 char *SymbolTop = SymbolTable;
 extern uint8_t _end;
-int i2cCount;
+unsigned int I2CCount;
 unsigned int TraceFn[TRACEMAX];
 unsigned int TraceDepth[TRACEMAX];

 object *GlobalEnv;
 object *GCStack = NULL;
+object *GlobalString;
+int GlobalStringIndex = 0;
 char BreakLevel = 0;
 char LastChar = 0;
 char LastPrint = 0;
-volatile char Escape = 0;
-char ExitEditor = 0;
 char PrintReadably = 1;
+
+// Flags
+enum flag { RETURNFLAG, ESCAPE, EXITEDITOR };
+volatile char Flags;

 // Forward references
 object *tee;
@@ -139,7 +150,7 @@
 object *eval (object *form, object *env);
 object *read ();
 void repl(object *env);
-void printobject (object *form);
+void printobject (object *form, pfun_t pfun);
 char *lookupbuiltin (symbol_t name);
 int lookupfn (symbol_t name);
 int builtin (char* n);
@@ -159,7 +170,7 @@
 }

 object *myalloc () {
-  if (Freespace == 0) error(F("No room"));
+  if (Freespace == 0) error(PSTR("No room"));
   object *temp = Freelist;
   Freelist = cdr(Freelist);
   Freespace--;
@@ -179,6 +190,13 @@
   object *ptr = myalloc();
   ptr->type = NUMBER;
   ptr->integer = n;
+  return ptr;
+}
+
+object *character (char c) {
+  object *ptr = myalloc();
+  ptr->type = CHARACTER;
+  ptr->integer = c;
   return ptr;
 }

@@ -250,7 +268,7 @@
   markobject(env);
   sweep();
   #if defined(printgcs)
-  pchar('{'); pint(Freespace - start); pchar('}');
+  pserial('{'); pint(Freespace - start, pserial); pserial('}');
   #endif
 }

@@ -259,7 +277,7 @@
 void movepointer (object *from, object *to) {
   for (int i=0; i<WORKSPACESIZE; i++) {
     object *obj = &Workspace[i];
-    unsigned int type = (obj->type) & MARKMASK;
+    unsigned int type = (obj->type) & ~MARKBIT;
     if (marked(obj) && (type >= STRING || type==ZERO)) {
       if (car(obj) == (object *)((unsigned int)from | MARKBIT))
         car(obj) = (object *)((unsigned int)to | MARKBIT);
@@ -269,11 +287,11 @@
   // Fix strings
   for (int i=0; i<WORKSPACESIZE; i++) {
     object *obj = &Workspace[i];
-    if (marked(obj) && ((obj->type) & MARKMASK) == STRING) {
+    if (marked(obj) && ((obj->type) & ~MARKBIT) == STRING) {
       obj = cdr(obj);
       while (obj != NULL) {
         if (cdr(obj) == to) cdr(obj) = from;
-        obj = (object *)((unsigned int)(car(obj)) & MARKMASK);
+        obj = (object *)((unsigned int)(car(obj)) & ~MARKBIT);
       }
     }
   }
@@ -323,8 +341,8 @@
   unsigned int imagesize = compactimage(&arg);
   // Save to EEPROM
   if (imagesize > IMAGEDATASIZE) {
-    pfstring(F("Error: Image size too large: "));
-    pint(imagesize); pln();
+    pfstring(PSTR("Error: Image size too large: "), pserial);
+    pint(imagesize, pserial); pln(pserial);
     GCStack = NULL;
     longjmp(exception, 1);
   }
@@ -342,7 +360,7 @@

 int loadimage () {
   unsigned int imagesize = eeprom_read_word(&image.datasize);
-  if (imagesize == 0 || imagesize == 0xFFFF) error(F("No saved image"));
+  if (imagesize == 0 || imagesize == 0xFFFF) error(PSTR("No saved image"));
   GlobalEnv = (object *)eeprom_read_word(&image.globalenv);
   GCStack = (object *)eeprom_read_word(&image.gcstack);
   #if SYMBOLTABLESIZE > BUFFERSIZE
@@ -355,27 +373,28 @@
 }

 void autorunimage () {
+  object *nullenv = NULL;
   object *autorun = (object *)eeprom_read_word(&image.eval);
   if (autorun != NULL && (unsigned int)autorun != 0xFFFF) {
     loadimage();
-    apply(autorun, NULL, NULL);
+    apply(autorun, NULL, &nullenv);
   }
 }

 // Error handling

-void error (const __FlashStringHelper *string) {
-  pfl(); pfstring(F("Error: "));
-  pfstring(string); pln();
+void error (PGM_P string) {
+  pfl(pserial); pfstring(PSTR("Error: "), pserial);
+  pfstring(string, pserial); pln(pserial);
   GCStack = NULL;
   longjmp(exception, 1);
 }

-void error2 (object *symbol, const __FlashStringHelper *string) {
-  pfl(); pfstring(F("Error: "));
-  if (symbol == NULL) pfstring(F("function "));
-  else { pchar('\''); printobject(symbol); pfstring(F("' ")); }
-  pfstring(string); pln();
+void error2 (object *symbol, PGM_P string) {
+  pfl(pserial); pfstring(PSTR("Error: "), pserial);
+  if (symbol == NULL) pfstring(PSTR("function "), pserial);
+  else { pserial('\''); printobject(symbol, pserial); pfstring(PSTR("' "), pserial); }
+  pfstring(string, pserial); pln(pserial);
   GCStack = NULL;
   longjmp(exception, 1);
 }
@@ -383,6 +402,7 @@
 // Tracing

 boolean tracing (symbol_t name) {
+  if (name == 0) return 0;
   int i = 0;
   while (i < TRACEMAX) {
     if (TraceFn[i] == name) return i+1;
@@ -392,13 +412,13 @@
 }

 void trace (symbol_t name) {
-  if (tracing(name)) error(F("Already being traced"));
+  if (tracing(name)) error(PSTR("Already being traced"));
   int i = 0;
   while (i < TRACEMAX) {
     if (TraceFn[i] == 0) { TraceFn[i] = name; TraceDepth[i] = 0; return; }
     i++;
   }
-  error(F("Already tracing 3 functions"));
+  error(PSTR("Already tracing 3 functions"));
 }

 void untrace (symbol_t name) {
@@ -407,7 +427,7 @@
     if (TraceFn[i] == name) { TraceFn[i] = 0; return; }
     i++;
   }
-  error(F("It wasn't being traced"));
+  error(PSTR("It wasn't being traced"));
 }

 // Helper functions
@@ -430,7 +450,7 @@
   return type >= PAIR || type == ZERO;
 }

-int toradix40 (int ch) {
+int toradix40 (char ch) {
   if (ch == 0) return 0;
   if (ch >= '0' && ch <= '9') return ch-'0'+30;
   ch = ch | 0x20;
@@ -460,12 +480,12 @@
 }

 char *name (object *obj){
-  char *buffer = SymbolTop;
-  buffer[3] = '\0';
-  if(obj->type != SYMBOL) error(F("Error in name"));
+  if (obj->type != SYMBOL) error(PSTR("Error in name"));
   symbol_t x = obj->name;
   if (x < ENDFUNCTIONS) return lookupbuiltin(x);
   else if (x >= 64000) return lookupsymbol(x);
+  char *buffer = SymbolTop;
+  buffer[3] = '\0';
   for (int n=2; n>=0; n--) {
     buffer[n] = fromradix40(x % 40);
     x = x / 40;
@@ -474,24 +494,31 @@
 }

 int integer (object *obj){
-  if(obj->type != NUMBER) error(F("not a number"));
+  if (!numberp(obj)) error(PSTR("Not a number"));
   return obj->integer;
 }

+int fromchar (object *obj){
+  if (!characterp(obj)) error(PSTR("Not a character"));
+  return obj->integer;
+}
+
 int istream (object *obj){
-  if(obj->type != STREAM) error(F("not a stream"));
+  if (!streamp(obj)) error(PSTR("Not a stream"));
   return obj->integer;
 }

 int issymbol (object *obj, symbol_t n) {
-  return obj->type == SYMBOL && obj->name == n;
+  return symbolp(obj) && obj->name == n;
 }

 int eq (object *arg1, object *arg2) {
   int same_object = (arg1 == arg2);
-  int same_symbol = (arg1->type == SYMBOL && arg2->type == SYMBOL && arg1->name == arg2->name);
-  int same_number = (arg1->type == NUMBER && arg2->type == NUMBER && arg1->integer == arg2->integer);
-  return (same_object || same_symbol || same_number);
+  int same_value = (arg1->cdr == arg2->cdr);
+  int same_symbol = (symbolp(arg1) && symbolp(arg2) && same_value);
+  int same_number = (numberp(arg1) && numberp(arg2) && same_value);
+  int same_character = (characterp(arg1) && characterp(arg2) && same_value);
+  return same_object || same_symbol || same_number || same_character;
 }

 int listlength (object *list) {
@@ -503,38 +530,65 @@
   return length;
 }

+// Association lists
+
+object *assoc (object *key, object *list) {
+  while (list != NULL) {
+    object *pair = first(list);
+    if (eq(key,car(pair))) return pair;
+    list = cdr(list);
+  }
+  return nil;
+}
+
+object *delassoc (object *key, object **alist) {
+  object *list = *alist;
+  object *prev = NULL;
+  while (list != NULL) {
+    object *pair = first(list);
+    if (eq(key,car(pair))) {
+      if (prev == NULL) *alist = cdr(list);
+      else cdr(prev) = cdr(list);
+      return key;
+    }
+    prev = list;
+    list = cdr(list);
+  }
+  return nil;
+}
+
 // String utilities

 void indent (int spaces) {
-  for (int i=0; i<spaces; i++) pchar(' ');
-}
-
-void buildstring (char ch, int *chars, object **head, object **tail) {
+  for (int i=0; i<spaces; i++) pserial(' ');
+}
+
+void buildstring (char ch, int *chars, object **head) {
+  static object* tail;
   if (*chars == 0) {
     *chars = ch<<8;
     object *cell = myalloc();
-    if (*head == NULL) *head = cell; else (*tail)->car = cell;
+    if (*head == NULL) *head = cell; else tail->car = cell;
     cell->car = NULL;
     cell->integer = *chars;
-    *tail = cell;
+    tail = cell;
   } else {
     *chars = *chars | ch;
-    (*tail)->integer = *chars;
+    tail->integer = *chars;
     *chars = 0;
   }
 }

-object *readstring (char delim) {
+object *readstring (char delim, gfun_t gfun) {
   object *obj = myalloc();
   obj->type = STRING;
-  char ch = gchar();
+  char ch = gfun();
   object *head = NULL;
-  object *tail = NULL;
   int chars = 0;
   while (ch != delim) {
-    if (ch == '\\') ch = gchar();
-    buildstring(ch, &chars, &head, &tail);
-    ch = gchar();
+    if (ch == '\\') ch = gfun();
+    buildstring(ch, &chars, &head);
+    ch = gfun();
   }
   obj->cdr = head;
   return obj;
@@ -552,16 +606,16 @@
   return length;
 }

-char character (object *string, int n) {
+char nthchar (object *string, int n) {
   object *arg = cdr(string);
   int top = n>>1;
   for (int i=0; i<top; i++) {
-    if (arg == NULL) error(F("'subseq' index out of range"));
+    if (arg == NULL) return 0;
     arg = car(arg);
   }
+  if (arg == NULL) return 0;
   char ch;
   if (n&1) ch = (arg->integer) & 0xFF; else ch = (arg->integer)>>8 & 0xFF;
-  if (ch == 0) error(F("'subseq' index out of range"));
   return ch;
 }

@@ -580,7 +634,7 @@
   symbol_t varname = var->name;
   object *pair = value(varname, env);
   if (pair == NULL) pair = value(varname, GlobalEnv);
-  if (pair == NULL) error2(var,F("unknown variable"));
+  if (pair == NULL) error2(var,PSTR("unknown variable"));
   return pair;
 }

@@ -598,7 +652,6 @@
     while (*env != NULL && car(*env) != NULL) {
       pop(*env);
     }
-    if (*env == NULL) error(F("no frame to drop"));
   } else {
     push(nil, *env);
   }
@@ -610,7 +663,8 @@
   int trace = tracing(fname->name);
   if (trace) {
     indent(TraceDepth[trace-1]<<1);
-    pint(TraceDepth[trace-1]++); pchar(':'); pchar(' '); pchar('('); printobject(fname);
+    pint(TraceDepth[trace-1]++, pserial);
+    pserial(':'); pserial(' '); pserial('('); printobject(fname, pserial);
   }
   object *params = first(function);
   function = cdr(function);
@@ -635,22 +689,22 @@
     }
     push(cons(var,value), *env);
     params = cdr(params);
-    if (trace) { pchar(' '); printobject(value); }
-  }
-  if (params != NULL) error2(fname, F("has too few parameters"));
-  if (args != NULL) error2(fname, F("has too many parameters"));
-  if (trace) { pchar(')'); pln(); }
+    if (trace) { pserial(' '); printobject(value, pserial); }
+  }
+  if (params != NULL) error2(fname, PSTR("has too few parameters"));
+  if (args != NULL) error2(fname, PSTR("has too many parameters"));
+  if (trace) { pserial(')'); pln(pserial); }
   // Do an implicit progn
   return tf_progn(function, *env);
 }

 object *apply (object *function, object *args, object **env) {
-  if (function->type == SYMBOL) {
+  if (symbolp(function)) {
     symbol_t name = function->name;
     int nargs = listlength(args);
-    if (name >= ENDFUNCTIONS) error2(function, F("is not valid here"));
-    if (nargs<lookupmin(name)) error2(function, F("has too few arguments"));
-    if (nargs>lookupmax(name)) error2(function, F("has too many arguments"));
+    if (name >= ENDFUNCTIONS) error2(function, PSTR("is not valid here"));
+    if (nargs<lookupmin(name)) error2(function, PSTR("has too few arguments"));
+    if (nargs>lookupmax(name)) error2(function, PSTR("has too many arguments"));
     return ((fn_ptr_type)lookupfn(name))(args, *env);
   }
   if (listp(function) && issymbol(car(function), LAMBDA)) {
@@ -663,7 +717,7 @@
     object *result = closure(NULL, car(function), cdr(function), args, env);
     return eval(result, *env);
   }
-  error2(function, F("is an illegal function"));
+  error2(function, PSTR("is an illegal function"));
   return NULL;
 }

@@ -674,39 +728,39 @@
   object* function = first(args);
   if (issymbol(function, CAR) || issymbol(function, FIRST)) {
     object *value = eval(second(args), env);
-    if (!listp(value)) error(F("Can't take car"));
+    if (!listp(value)) error(PSTR("Can't take car"));
     return &car(value);
   }
   if (issymbol(function, CDR) || issymbol(function, REST)) {
     object *value = eval(second(args), env);
-    if (!listp(value)) error(F("Can't take cdr"));
+    if (!listp(value)) error(PSTR("Can't take cdr"));
     return &cdr(value);
   }
   if (issymbol(function, NTH)) {
     int index = integer(eval(second(args), env));
     object *list = eval(third(args), env);
-    if (atom(list)) error(F("'nth' second argument is not a list"));
+    if (atom(list)) error(PSTR("'nth' second argument is not a list"));
     while (index > 0) {
       list = cdr(list);
-      if (list == NULL) error(F("'nth' index out of range"));
+      if (list == NULL) error(PSTR("'nth' index out of range"));
       index--;
     }
     return &car(list);
   }
-  error(F("Illegal place"));
+  error(PSTR("Illegal place"));
   return nil;
 }

 // Checked car and cdr

 inline object *carx (object *arg) {
-  if (!listp(arg)) error(F("Can't take car"));
+  if (!listp(arg)) error(PSTR("Can't take car"));
   if (arg == nil) return nil;
   return car(arg);
 }

 inline object *cdrx (object *arg) {
-  if (!listp(arg)) error(F("Can't take cdr"));
+  if (!listp(arg)) error(PSTR("Can't take cdr"));
   if (arg == nil) return nil;
   return cdr(arg);
 }
@@ -745,8 +799,9 @@
   }
 }

-uint8_t I2Cread(uint8_t last) {
-  TWCR = 1<<TWINT | 1<<TWEN | (last ? 0 : (1<<TWEA));
+uint8_t I2Cread() {
+  if (I2CCount != 0) I2CCount--;
+  TWCR = 1<<TWINT | 1<<TWEN | ((I2CCount == 0) ? 0 : (1<<TWEA));
   while (!(TWCR & 1<<TWINT));
   return TWDR;
 }
@@ -780,25 +835,91 @@
   while (TWCR & 1<<TWSTO); // wait until stop and bus released
 }

+inline char spiread () { return SPI.transfer(0); }
+#if defined(__AVR_ATmega1284P__)
+inline char serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
+#elif defined(__AVR_ATmega2560__)
+inline char serial1read () { while (!Serial1.available()) testescape(); return Serial1.read(); }
+inline char serial2read () { while (!Serial2.available()) testescape(); return Serial2.read(); }
+inline char serial3read () { while (!Serial3.available()) testescape(); return Serial3.read(); }
+#endif
+
+gfun_t gstreamfun (object *args) {
+  int streamtype = SERIALSTREAM;
+  int address = 0;
+  gfun_t gfun = gserial;
+  if (args != NULL) {
+    int stream = istream(first(args));
+    streamtype = stream>>8; address = stream & 0xFF;
+  }
+  if (streamtype == I2CSTREAM) gfun = (gfun_t)I2Cread;
+  else if (streamtype == SPISTREAM) gfun = spiread;
+  else if (streamtype == SERIALSTREAM) {
+    if (address == 0) gfun = gserial;
+    #if defined(__AVR_ATmega1284P__)
+    else if (address == 1) gfun = serial1read;
+    #elif defined(__AVR_ATmega2560__)
+    else if (address == 1) gfun = serial1read;
+    else if (address == 2) gfun = serial2read;
+    else if (address == 3) gfun = serial3read;
+    #endif
+  }
+  else error(PSTR("Unknown stream type"));
+  return gfun;
+}
+
+inline void spiwrite (char c) { SPI.transfer(c); }
+#if defined(__AVR_ATmega1284P__)
+inline void serial1write (char c) { Serial1.write(c); }
+#elif defined(__AVR_ATmega2560__)
+inline void serial1write (char c) { Serial1.write(c); }
+inline void serial2write (char c) { Serial2.write(c); }
+inline void serial3write (char c) { Serial3.write(c); }
+#endif
+
+pfun_t pstreamfun (object *args) {
+  int streamtype = SERIALSTREAM;
+  int address = 0;
+  pfun_t pfun = pserial;
+  if (args != NULL) {
+    int stream = istream(first(args));
+    streamtype = stream>>8; address = stream & 0xFF;
+  }
+  if (streamtype == I2CSTREAM) pfun = (pfun_t)I2Cwrite;
+  else if (streamtype == SPISTREAM) pfun = spiwrite;
+  else if (streamtype == SERIALSTREAM) {
+    if (address == 0) pfun = pserial;
+    #if defined(__AVR_ATmega1284P__)
+    else if (address == 1) pfun = serial1write;
+    #elif defined(__AVR_ATmega2560__)
+    else if (address == 1) pfun = serial1write;
+    else if (address == 2) pfun = serial2write;
+    else if (address == 3) pfun = serial3write;
+    #endif
+  }
+  else error(PSTR("'write-string' unknown stream type"));
+  return pfun;
+}
+
 // Check pins

 void checkanalogread (int pin) {
 #if defined(__AVR_ATmega328P__)
-  if (!(pin>=0 && pin<=5)) error(F("'analogread' invalid pin"));
+  if (!(pin>=0 && pin<=5)) error(PSTR("'analogread' invalid pin"));
 #elif defined(__AVR_ATmega2560__)
-  if (!(pin>=0 && pin<=15)) error(F("'analogread' invalid pin"));
+  if (!(pin>=0 && pin<=15)) error(PSTR("'analogread' invalid pin"));
 #elif defined(__AVR_ATmega1284P__)
-  if (!(pin>=0 && pin<=7)) error(F("'analogread' invalid pin"));
+  if (!(pin>=0 && pin<=7)) error(PSTR("'analogread' invalid pin"));
 #endif
 }

 void checkanalogwrite (int pin) {
 #if defined(__AVR_ATmega328P__)
-  if (!(pin>=3 && pin<=11 && pin!=4 && pin!=7 && pin!=8)) error(F("'analogwrite' invalid pin"));
+  if (!(pin>=3 && pin<=11 && pin!=4 && pin!=7 && pin!=8)) error(PSTR("'analogwrite' invalid pin"));
 #elif defined(__AVR_ATmega2560__)
-  if (!((pin>=2 && pin<=13) || (pin>=44 && pin <=46))) error(F("'analogwrite' invalid pin"));
+  if (!((pin>=2 && pin<=13) || (pin>=44 && pin <=46))) error(PSTR("'analogwrite' invalid pin"));
 #elif defined(__AVR_ATmega1284P__)
-  if (!(pin==3 || pin==4 || pin==6 || pin==7 || (pin>=12 && pin<=15))) error(F("'analogwrite' invalid pin"));
+  if (!(pin==3 || pin==4 || pin==6 || pin==7 || (pin>=12 && pin<=15))) error(PSTR("'analogwrite' invalid pin"));
 #endif
 }

@@ -814,9 +935,9 @@
   } else if (pin == 11) {
     DDRB = DDRB | 1<<DDB3; // PB3 (Arduino D11) as output
     TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
-  } else error(F("'note' pin not supported"));
+  } else error(PSTR("'note' pin not supported"));
   int prescaler = 9 - octave - note/12;
-  if (prescaler<3 || prescaler>6) error(F("'note' octave out of range"));
+  if (prescaler<3 || prescaler>6) error(PSTR("'note' octave out of range"));
   OCR2A = pgm_read_byte(&scale[note%12]) - 1;
   TCCR2B = 0<<WGM22 | prescaler<<CS20;

@@ -827,9 +948,9 @@
   } else if (pin == 10) {
     DDRB = DDRB | 1<<DDB4; // PB4 (Arduino D10) as output
     TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
-  } else error(F("'note' pin not supported"));
+  } else error(PSTR("'note' pin not supported"));
   int prescaler = 9 - octave - note/12;
-  if (prescaler<3 || prescaler>6) error(F("'note' octave out of range"));
+  if (prescaler<3 || prescaler>6) error(PSTR("'note' octave out of range"));
   OCR2A = pgm_read_byte(&scale[note%12]) - 1;
   TCCR2B = 0<<WGM22 | prescaler<<CS20;

@@ -840,9 +961,9 @@
   } else if (pin == 15) {
     DDRD = DDRD | 1<<DDD7; // PD7 (Arduino D15) as output
     TCCR2A = 1<<COM2A0 | 0<<COM2B0 | 2<<WGM20; // Toggle OC2A on match
-  } else error(F("'note' pin not supported"));
+  } else error(PSTR("'note' pin not supported"));
   int prescaler = 9 - octave - note/12;
-  if (prescaler<3 || prescaler>6) error(F("'note' octave out of range"));
+  if (prescaler<3 || prescaler>6) error(PSTR("'note' octave out of range"));
   OCR2A = pgm_read_byte(&scale[note%12]) - 1;
   TCCR2B = 0<<WGM22 | prescaler<<CS20;
   #endif
@@ -863,7 +984,7 @@
 object *sp_defun (object *args, object *env) {
   (void) env;
   object *var = first(args);
-  if (var->type != SYMBOL) error2(var, F("is not a symbol"));
+  if (var->type != SYMBOL) error2(var, PSTR("is not a symbol"));
   object *val = cons(symbol(LAMBDA), cdr(args));
   object *pair = value(var->name,GlobalEnv);
   if (pair != NULL) { cdr(pair) = val; return var; }
@@ -873,7 +994,7 @@

 object *sp_defvar (object *args, object *env) {
   object *var = first(args);
-  if (var->type != SYMBOL) error2(var, F("is not a symbol"));
+  if (var->type != SYMBOL) error2(var, PSTR("is not a symbol"));
   object *val = eval(second(args), env);
   object *pair = value(var->name,GlobalEnv);
   if (pair != NULL) { cdr(pair) = val; return var; }
@@ -889,15 +1010,14 @@
 }

 object *sp_loop (object *args, object *env) {
-  ReturnFlag = 0;
+  clrflag(RETURNFLAG);
   object *start = args;
   for (;;) {
     args = start;
     while (args != NULL) {
-      object *form = car(args);
-      object *result = eval(form,env);
-      if (ReturnFlag == 1) {
-        ReturnFlag = 0;
+      object *result = eval(car(args),env);
+      if (tstflag(RETURNFLAG)) {
+        clrflag(RETURNFLAG);
         return result;
       }
       args = cdr(args);
@@ -926,8 +1046,8 @@
   args = cdr(args);
   if (args != NULL) increment = integer(eval(first(args), env));
   #if defined(checkoverflow)
-  if (increment < 1) { if (-32768 - increment > result) error(F("'incf' arithmetic overflow")); }
-  else { if (32767 - increment < result) error(F("'incf' arithmetic overflow")); }
+  if (increment < 1) { if (-32768 - increment > result) error(PSTR("'incf' arithmetic overflow")); }
+  else { if (32767 - increment < result) error(PSTR("'incf' arithmetic overflow")); }
   #endif
   result = result + increment;
   *loc = number(result);
@@ -941,8 +1061,8 @@
   args = cdr(args);
   if (args != NULL) decrement = integer(eval(first(args), env));
   #if defined(checkoverflow)
-  if (decrement < 1) { if (32767 + decrement < result) error(F("'decf' arithmetic overflow")); }
-  else { if (-32768 + decrement > result) error(F("'decf' arithmetic overflow")); }
+  if (decrement < 1) { if (32767 + decrement < result) error(PSTR("'decf' arithmetic overflow")); }
+  else { if (-32768 + decrement > result) error(PSTR("'decf' arithmetic overflow")); }
   #endif
   result = result - decrement;
   *loc = number(result);
@@ -959,43 +1079,51 @@
 object *sp_dolist (object *args, object *env) {
   object *params = first(args);
   object *var = first(params);
-  object *result = nil;
+  object *result;
   object *list = eval(second(params), env);
-  if (!listp(list)) error(F("'dolist' argument is not a list"));
+  if (!listp(list)) error(PSTR("'dolist' argument is not a list"));
   push(list, GCStack); // Don't GC the list
   object *pair = cons(var,nil);
   push(pair,env);
   params = cdr(cdr(params));
-  if (params != NULL) result = car(params);
   object *forms = cdr(args);
   while (list != NULL) {
     cdr(pair) = first(list);
     list = cdr(list);
-    eval(tf_progn(forms,env), env);
+    result = eval(tf_progn(forms,env), env);
+    if (tstflag(RETURNFLAG)) {
+      clrflag(RETURNFLAG);
+      return result;
+    }
   }
   cdr(pair) = nil;
   pop(GCStack);
-  return eval(result, env);
+  if (params == NULL) return nil;
+  return eval(car(params), env);
 }

 object *sp_dotimes (object *args, object *env) {
   object *params = first(args);
   object *var = first(params);
-  object *result = nil;
+  object *result;
   int count = integer(eval(second(params), env));
   int index = 0;
   params = cdr(cdr(params));
-  if (params != NULL) result = car(params);
   object *pair = cons(var,number(0));
   push(pair,env);
   object *forms = cdr(args);
   while (index < count) {
     cdr(pair) = number(index);
     index++;
-    eval(tf_progn(forms,env), env);
+    result = eval(tf_progn(forms,env), env);
+    if (tstflag(RETURNFLAG)) {
+      clrflag(RETURNFLAG);
+      return result;
+    }
   }
   cdr(pair) = number(index);
-  return eval(result, env);
+  if (params == NULL) return nil;
+  return eval(car(params), env);
 }

 object *sp_trace (object *args, object *env) {
@@ -1041,16 +1169,46 @@
   return nil;
 }

+object *sp_withserial (object *args, object *env) {
+  object *params = first(args);
+  object *var = first(params);
+  int address = integer(eval(second(params), env));
+  params = cddr(params);
+  #if defined(__AVR_ATmega1284P__) || defined(__AVR_ATmega2560__)
+  int baud = 96;
+  if (params != NULL) baud = integer(eval(first(params), env));
+  #endif
+  object *pair = cons(var, stream(SERIALSTREAM, address));
+  push(pair,env);
+  #if defined(__AVR_ATmega1284P__)
+  if (address == 1) Serial1.begin(baud*100);
+  #elif defined(__AVR_ATmega2560__)
+  if (address == 1) Serial1.begin(baud*100);
+  else if (address == 2) Serial2.begin(baud*100);
+  else if (address == 3) Serial3.begin(baud*100);
+  #endif
+  object *forms = cdr(args);
+  object *result = eval(tf_progn(forms,env), env);
+  #if defined(__AVR_ATmega1284P__)
+  if (address == 1) Serial1.end();
+  #elif defined(__AVR_ATmega2560__)
+  if (address == 1) Serial1.end();
+  else if (address == 2) Serial2.end();
+  else if (address == 3) Serial3.end();
+  #endif
+  return result;
+}
+
 object *sp_withi2c (object *args, object *env) {
   object *params = first(args);
   object *var = first(params);
   int address = integer(eval(second(params), env));
   params = cddr(params);
   int read = 0; // Write
-  i2cCount = 0;
+  I2CCount = 0;
   if (params != NULL) {
     object *rw = eval(first(params), env);
-    if (numberp(rw)) i2cCount = integer(rw);
+    if (numberp(rw)) I2CCount = integer(rw);
     read = (rw != NULL);
   }
   I2Cinit(1); // Pullups
@@ -1073,7 +1231,7 @@
   params = cddr(params);
   if (params != NULL) {
     int d = integer(eval(first(params), env));
-    if (d<1 || d>7) error(F("'with-spi' invalid divider"));
+    if (d<1 || d>7) error(PSTR("'with-spi' invalid divider"));
     if (d == 7) divider = 3;
     else if (d & 1) divider = (d>>1) + 4;
     else divider = (d>>1) - 1;
@@ -1102,7 +1260,8 @@
   if (args == NULL) return nil;
   object *more = cdr(args);
   while (more != NULL) {
-  eval(car(args), env);
+    object *result = eval(car(args),env);
+    if (tstflag(RETURNFLAG)) return result;
     args = more;
     more = cdr(args);
   }
@@ -1110,13 +1269,14 @@
 }

 object *tf_return (object *args, object *env) {
-  ReturnFlag = 1;
+  setflag(RETURNFLAG);
   return tf_progn(args, env);
 }

 object *tf_if (object *args, object *env) {
   if (eval(first(args), env) != nil) return second(args);
-  return third(args);
+  args = cddr(args);
+  return (args != NULL) ? first(args) : nil;
 }

 object *tf_cond (object *args, object *env) {
@@ -1287,7 +1447,7 @@
   (void) env;
   object *arg = first(args);
   if (listp(arg)) return number(listlength(arg));
-  if (!stringp(arg)) error(F("'length' argument is not a list or string"));
+  if (!stringp(arg)) error(PSTR("'length' argument is not a list or string"));
   return number(stringlength(arg));
 }

@@ -1299,7 +1459,7 @@
 object *fn_reverse (object *args, object *env) {
   (void) env;
   object *list = first(args);
-  if (!listp(list)) error(F("'reverse' argument is not a list"));
+  if (!listp(list)) error(PSTR("'reverse' argument is not a list"));
   object *result = NULL;
   while (list != NULL) {
     push(first(list),result);
@@ -1312,7 +1472,7 @@
   (void) env;
   int n = integer(first(args));
   object *list = second(args);
-  if (!listp(list)) error(F("'nth' second argument is not a list"));
+  if (!listp(list)) error(PSTR("'nth' second argument is not a list"));
   while (list != NULL) {
     if (n == 0) return car(list);
     list = cdr(list);
@@ -1325,20 +1485,15 @@
   (void) env;
   object *key = first(args);
   object *list = second(args);
-  if (!listp(list)) error(F("'assoc' second argument is not a list"));
-  while (list != NULL) {
-    object *pair = first(list);
-    if (eq(key,car(pair))) return pair;
-    list = cdr(list);
-  }
-  return nil;
+  if (!listp(list)) error(PSTR("'assoc' second argument is not a list"));
+  return assoc(key,list);
 }

 object *fn_member (object *args, object *env) {
   (void) env;
   object *item = first(args);
   object *list = second(args);
-  if (!listp(list)) error(F("'member' second argument is not a list"));
+  if (!listp(list)) error(PSTR("'member' second argument is not a list"));
   while (list != NULL) {
     if (eq(item,car(list))) return list;
     list = cdr(list);
@@ -1353,7 +1508,7 @@
     previous = last;
     last = cdr(last);
   }
-  if (!listp(car(last))) error(F("'apply' last argument is not a list"));
+  if (!listp(car(last))) error(PSTR("'apply' last argument is not a list"));
   cdr(previous) = car(last);
   return apply(first(args), cdr(args), &env);
 }
@@ -1368,7 +1523,7 @@
   object *tail = NULL;
   while (args != NULL) {
     object *list = first(args);
-    if (!listp(list)) error(F("'append' argument is not a list"));
+    if (!listp(list)) error(PSTR("'append' argument is not a list"));
     while (list != NULL) {
       object *obj = cons(first(list),NULL);
       if (head == NULL) {
@@ -1389,11 +1544,11 @@
   object *function = first(args);
   object *list1 = second(args);
   object *result = list1;
-  if (!listp(list1)) error(F("'mapc' second argument is not a list"));
+  if (!listp(list1)) error(PSTR("'mapc' second argument is not a list"));
   object *list2 = cddr(args);
   if (list2 != NULL) {
     list2 = car(list2);
-    if (!listp(list2)) error(F("'mapc' third argument is not a list"));
+    if (!listp(list2)) error(PSTR("'mapc' third argument is not a list"));
   }
   if (list2 != NULL) {
     while (list1 != NULL && list2 != NULL) {
@@ -1413,11 +1568,11 @@
 object *fn_mapcar (object *args, object *env) {
   object *function = first(args);
   object *list1 = second(args);
-  if (!listp(list1)) error(F("'mapcar' second argument is not a list"));
+  if (!listp(list1)) error(PSTR("'mapcar' second argument is not a list"));
   object *list2 = cddr(args);
   if (list2 != NULL) {
     list2 = car(list2);
-    if (!listp(list2)) error(F("'mapcar' third argument is not a list"));
+    if (!listp(list2)) error(PSTR("'mapcar' third argument is not a list"));
   }
   object *head = NULL;
   object *tail = NULL;
@@ -1463,8 +1618,8 @@
   while (args != NULL) {
     int temp = integer(car(args));
     #if defined(checkoverflow)
-    if (temp < 1) { if (-32768 - temp > result) error(F("'+' arithmetic overflow")); }
-    else { if (32767 - temp < result) error(F("'+' arithmetic overflow")); }
+    if (temp < 1) { if (-32768 - temp > result) error(PSTR("'+' arithmetic overflow")); }
+    else { if (32767 - temp < result) error(PSTR("'+' arithmetic overflow")); }
     #endif
     result = result + temp;
     args = cdr(args);
@@ -1478,15 +1633,15 @@
   args = cdr(args);
   if (args == NULL) {
     #if defined(checkoverflow)
-    if (result == -32768) error(F("'-' arithmetic overflow"));
+    if (result == -32768) error(PSTR("'-' arithmetic overflow"));
     #endif
     return number(-result);
   }
   while (args != NULL) {
     int temp = integer(car(args));
     #if defined(checkoverflow)
-    if (temp < 1) { if (32767 + temp < result) error(F("'-' arithmetic overflow")); }
-    else { if (-32768 + temp > result) error(F("'-' arithmetic overflow")); }
+    if (temp < 1) { if (32767 + temp < result) error(PSTR("'-' arithmetic overflow")); }
+    else { if (-32768 + temp > result) error(PSTR("'-' arithmetic overflow")); }
     #endif
     result = result - temp;
     args = cdr(args);
@@ -1500,7 +1655,7 @@
   while (args != NULL){
     #if defined(checkoverflow)
     signed long temp = (signed long) result * integer(car(args));
-    if ((temp > 32767) || (temp < -32768)) error(F("'*' arithmetic overflow"));
+    if ((temp > 32767) || (temp < -32768)) error(PSTR("'*' arithmetic overflow"));
     result = temp;
     #else
     result = result * integer(car(args));
@@ -1516,9 +1671,9 @@
   args = cdr(args);
   while (args != NULL) {
     int arg = integer(car(args));
-    if (arg == 0) error(F("Division by zero"));
+    if (arg == 0) error(PSTR("Division by zero"));
     #if defined(checkoverflow)
-    if ((result == -32768) && (arg == -1)) error(F("'/' arithmetic overflow"));
+    if ((result == -32768) && (arg == -1)) error(PSTR("'/' arithmetic overflow"));
     #endif
     result = result / arg;
     args = cdr(args);
@@ -1530,7 +1685,7 @@
   (void) env;
   int arg1 = integer(first(args));
   int arg2 = integer(second(args));
-  if (arg2 == 0) error(F("Division by zero"));
+  if (arg2 == 0) error(PSTR("Division by zero"));
   int r = arg1 % arg2;
   if ((arg1<0) != (arg2<0)) r = r + arg2;
   return number(r);
@@ -1540,7 +1695,7 @@
   (void) env;
   int result = integer(first(args));
   #if defined(checkoverflow)
-  if (result == 32767) error(F("'1+' arithmetic overflow"));
+  if (result == 32767) error(PSTR("'1+' arithmetic overflow"));
   #endif
   return number(result + 1);
 }
@@ -1549,7 +1704,7 @@
   (void) env;
   int result = integer(first(args));
   #if defined(checkoverflow)
-  if (result == -32768) error(F("'1-' arithmetic overflow"));
+  if (result == -32768) error(PSTR("'1-' arithmetic overflow"));
   #endif
   return number(result - 1);
 }
@@ -1558,7 +1713,7 @@
   (void) env;
   int result = integer(first(args));
   #if defined(checkoverflow)
-  if (result == -32768) error(F("'abs' arithmetic overflow"));
+  if (result == -32768) error(PSTR("'abs' arithmetic overflow"));
   #endif
   return number(abs(result));
 }
@@ -1709,50 +1864,141 @@
   else return nil;
 }

+// Characters
+
+object *fn_char (object *args, object *env) {
+  (void) env;
+  char c = nthchar(first(args), integer(second(args)));
+  if (c == 0) error(PSTR("'char' index out of range"));
+  return character(c);
+}
+
+object *fn_charcode (object *args, object *env) {
+  (void) env;
+  return number(fromchar(first(args)));
+}
+
+object *fn_codechar (object *args, object *env) {
+  (void) env;
+  return character(integer(first(args)));
+}
+
+object *fn_characterp (object *args, object *env) {
+  (void) env;
+  return characterp(first(args)) ? tee : nil;
+}
+
 // Strings

 object *fn_stringp (object *args, object *env) {
   (void) env;
+  return stringp(first(args)) ? tee : nil;
+}
+
+bool stringcompare (object *args, bool lt, bool gt, bool eq) {
   object *arg1 = first(args);
-  return stringp(arg1) ? tee : nil;
-}
-
-object *fn_stringeq (object *args, object *env) {
-  (void) env;
-  object *arg1 = first(args);
-  if (!stringp(arg1)) error(F("'string=' first argument is not a string"));
   object *arg2 = second(args);
-  if (!stringp(arg2)) error(F("'string=' second argument is not a string"));
+  if (!stringp(arg1) || !stringp(arg2)) error(PSTR("String compare argument is not a string"));
   arg1 = cdr(arg1);
   arg2 = cdr(arg2);
   while ((arg1 != NULL) || (arg2 != NULL)) {
-    if ((arg1 == NULL) || (arg2 == NULL) || (arg1->integer != arg2->integer)) return nil;
+    if (arg1 == NULL) return lt;
+    if (arg2 == NULL) return gt;
+    if (arg1->integer < arg2->integer) return lt;
+    if (arg1->integer > arg2->integer) return gt;
     arg1 = car(arg1);
     arg2 = car(arg2);
   }
-  return tee;
+  return eq;
+}
+
+object *fn_stringeq (object *args, object *env) {
+  (void) env;
+  return stringcompare(args, false, false, true) ? tee : nil;
+}
+
+object *fn_stringless (object *args, object *env) {
+  (void) env;
+  return stringcompare(args, true, false, false) ? tee : nil;
+}
+
+object *fn_stringgreater (object *args, object *env) {
+  (void) env;
+  return stringcompare(args, false, true, false) ? tee : nil;
+}
+
+object *fn_sort (object *args, object *env) {
+  if (first(args) == NULL) return nil;
+  object *list = cons(nil,first(args));
+  push(list,GCStack);
+  object *predicate = second(args);
+  object *compare = cons(NULL,cons(NULL,NULL));
+  object *ptr = cdr(list);
+  while (cdr(ptr) != NULL) {
+    object *go = list;
+    while (go != ptr) {
+      car(compare) = car(cdr(ptr));
+      car(cdr(compare)) = car(cdr(go));
+      if (apply(predicate, compare, &env)) break;
+      go = cdr(go);
+    }
+    if (go != ptr) {
+      object *obj = cdr(ptr);
+      cdr(ptr) = cdr(obj);
+      cdr(obj) = cdr(go);
+      cdr(go) = obj;
+    } else ptr = cdr(ptr);
+  }
+  pop(GCStack);
+  return cdr(list);
+}
+
+object *fn_stringfn (object *args, object *env) {
+  (void) env;
+  object *arg = first(args);
+  int type = arg->type;
+  if (type == STRING) return arg;
+  object *obj = myalloc();
+  obj->type = STRING;
+  if (type == CHARACTER) {
+    object *cell = myalloc();
+    cell->car = NULL;
+    cell->integer = fromchar(arg)<<8;
+    obj->cdr = cell;
+  } else if (type == SYMBOL) {
+    char *s = name(arg);
+    char ch = *s++;
+    object *head = NULL;
+    int chars = 0;
+    while (ch) {
+      if (ch == '\\') ch = *s++;
+      buildstring(ch, &chars, &head);
+      ch = *s++;
+    }
+    obj->cdr = head;
+  } else error(PSTR("Cannot convert to string"));
+  return obj;
 }

 object *fn_concatenate (object *args, object *env) {
   (void) env;
   object *arg = first(args);
   symbol_t name = arg->name;
-  if (name != STRINGFN) error(F("Only string result supported"));
+  if (name != STRINGFN) error(PSTR("Only string result supported"));
   args = cdr(args);
   object *result = myalloc();
   result->type = STRING;
   object *head = NULL;
-  object *tail = NULL;
   int chars = 0;
   while (args != NULL) {
     object *obj = first(args);
-    if (obj->type != STRING) error2(obj, F("not a string"));
+    if (obj->type != STRING) error2(obj, PSTR("not a string"));
     obj = cdr(obj);
     while (obj != NULL) {
       int pair = obj->integer;
        while (pair != 0) {
          char ch = pair>>8 & 0xFF;
-         buildstring(ch, &chars, &head, &tail);
+         buildstring(ch, &chars, &head);
          pair = pair<<8;
       }
       obj = car(obj);
@@ -1766,7 +2012,7 @@
 object *fn_subseq (object *args, object *env) {
   (void) env;
   object *arg = first(args);
-  if (!stringp(arg)) error(F("'subseq' first argument is not a string"));
+  if (!stringp(arg)) error(PSTR("'subseq' first argument is not a string"));
   int start = integer(second(args));
   int end;
   args = cddr(args);
@@ -1774,14 +2020,64 @@
   object *result = myalloc();
   result->type = STRING;
   object *head = NULL;
-  object *tail = NULL;
   int chars = 0;
   for (int i=start; i<end; i++) {
-    char ch = character(arg, i);
-    buildstring(ch, &chars, &head, &tail);
+    char ch = nthchar(arg, i);
+    if (ch == 0) error(PSTR("'subseq' index out of range"));
+    buildstring(ch, &chars, &head);
   }
   result->cdr = head;
   return result;
+}
+
+char gstr () {
+  if (LastChar) {
+    char temp = LastChar;
+    LastChar = 0;
+    return temp;
+  }
+  char c = nthchar(GlobalString, GlobalStringIndex++);
+  return (c != 0) ? c : '\n';
+}
+
+object *fn_readfromstring (object *args, object *env) {
+  (void) env;
+  object *arg = first(args);
+  if (!stringp(arg)) error(PSTR("'read-from-string' argument is not a string"));
+  GlobalString = arg;
+  GlobalStringIndex = 0;
+  return read(gstr);
+}
+
+void pstr (char c) {
+  buildstring(c, &GlobalStringIndex, &GlobalString);
+}
+
+object *fn_princtostring (object *args, object *env) {
+  (void) env;
+  object *arg = first(args);
+  object *obj = myalloc();
+  obj->type = STRING;
+  GlobalString = NULL;
+  GlobalStringIndex = 0;
+  char temp = PrintReadably;
+  PrintReadably = 0;
+  printobject(arg, pstr);
+  PrintReadably = temp;
+  obj->cdr = GlobalString;
+  return obj;
+}
+
+object *fn_prin1tostring (object *args, object *env) {
+  (void) env;
+  object *arg = first(args);
+  object *obj = myalloc();
+  obj->type = STRING;
+  GlobalString = NULL;
+  GlobalStringIndex = 0;
+  printobject(arg, pstr);
+  obj->cdr = GlobalString;
+  return obj;
 }

 // Bitwise operators
@@ -1857,29 +2153,15 @@
 }

 object *fn_makunbound (object *args, object *env) {
-  (void) args;
   (void) env;
   object *key = first(args);
   deletesymbol(key->name);
-  object *list = GlobalEnv;
-  object *prev = NULL;
-  while (list != NULL) {
-    object *pair = first(list);
-    if (eq(key,car(pair))) {
-      if (prev == NULL) GlobalEnv = cdr(list);
-      else cdr(prev) = cdr(list);
-      return key;
-    }
-    prev = list;
-    list = cdr(list);
-  }
-  error2(key, F("not found"));
-  return nil;
+  return delassoc(key, &GlobalEnv);
 }

 object *fn_break (object *args, object *env) {
   (void) args;
-  pfstring(F("\rBreak!\r"));
+  pfstring(PSTR("\rBreak!\r"), pserial);
   BreakLevel++;
   repl(env);
   BreakLevel--;
@@ -1889,22 +2171,22 @@
 object *fn_read (object *args, object *env) {
   (void) args;
   (void) env;
-  return read();
+  return read(gserial);
 }

 object *fn_prin1 (object *args, object *env) {
   (void) env;
   object *obj = first(args);
-  printobject(obj);
+  printobject(obj, pserial);
   return obj;
 }

 object *fn_print (object *args, object *env) {
   (void) env;
-  pln();
+  pln(pserial);
   object *obj = first(args);
-  printobject(obj);
-  pchar(' ');
+  printobject(obj, pserial);
+  pserial(' ');
   return obj;
 }

@@ -1913,49 +2195,52 @@
   object *obj = first(args);
   char temp = PrintReadably;
   PrintReadably = 0;
-  printobject(obj);
+  printobject(obj, pserial);
   PrintReadably = temp;
   return obj;
 }

 object *fn_terpri (object *args, object *env) {
   (void) args, (void) env;
-  pln();
+  pln(pserial);
   return nil;
 }

+object *fn_readbyte (object *args, object *env) {
+  (void) env;
+  return number((gstreamfun(args))());
+}
+
 object *fn_readline (object *args, object *env) {
-  (void) args, (void) env;
-  return readstring('\r');
-}
-
-object *fn_readbyte (object *args, object *env) {
-  (void) env;
-  int stream = SERIALSTREAM<<8;
-  int last = 0;
-  if (args != NULL) stream = istream(first(args));
-  args = cdr(args);
-  if (args != NULL) last = (first(args) != NULL);
-  if (stream>>8 == I2CSTREAM) {
-    if (i2cCount >= 0) i2cCount--;
-    return number(I2Cread((i2cCount == 0) || last));
-  } else if (stream>>8 == SPISTREAM) return number(SPI.transfer(0));
-  else if (stream == SERIALSTREAM<<8) return number(gchar());
-  else error(F("'read-byte' unknown stream type"));
+  (void) env;
+  return readstring('\n', gstreamfun(args));
+}
+
+object *fn_writebyte (object *args, object *env) {
+  (void) env;
+  int value = integer(first(args));
+  (pstreamfun(cdr(args)))(value);
   return nil;
 }

-object *fn_writebyte (object *args, object *env) {
-  (void) env;
-  object *val = first(args);
-  int value = integer(val);
-  int stream = SERIALSTREAM<<8;
-  args = cdr(args);
-  if (args != NULL) stream = istream(first(args));
-  if (stream>>8 == I2CSTREAM) return (I2Cwrite(value)) ? tee : nil;
-  else if (stream>>8 == SPISTREAM) return number(SPI.transfer(value));
-  else if (stream == SERIALSTREAM<<8) pchar(value);
-  else error(F("'write-byte' unknown stream type"));
+object *fn_writestring (object *args, object *env) {
+  (void) env;
+  object *obj = first(args);
+  char temp = PrintReadably;
+  PrintReadably = 0;
+  printstring(obj, pstreamfun(cdr(args)));
+  PrintReadably = temp;
+  return nil;
+}
+
+object *fn_writeline (object *args, object *env) {
+  (void) env;
+  object *obj = first(args);
+  char temp = PrintReadably;
+  PrintReadably = 0;
+  printstring(obj, pstreamfun(cdr(args)));
+  (pstreamfun(cdr(args)))('\n');
+  PrintReadably = temp;
   return nil;
 }

@@ -1964,14 +2249,14 @@
   int stream = first(args)->integer;
   args = cdr(args);
   int read = 0; // Write
-  i2cCount = 0;
+  I2CCount = 0;
   if (args != NULL) {
     object *rw = first(args);
-    if (numberp(rw)) i2cCount = integer(rw);
+    if (numberp(rw)) I2CCount = integer(rw);
     read = (rw != NULL);
   }
   int address = stream & 0xFF;
-  if (stream>>8 != I2CSTREAM) error(F("'restart' not i2c"));
+  if (stream>>8 != I2CSTREAM) error(PSTR("'restart' not i2c"));
   return I2Crestart(address, read) ? tee : nil;
 }

@@ -1979,11 +2264,11 @@
   unsigned long start = micros();
   int initial = Freespace;
   gc(obj, env);
-  pfstring(F("Space: "));
-  pint(Freespace - initial);
-  pfstring(F(" bytes, Time: "));
-  pint(micros() - start);
-  pfstring(F(" uS\r"));
+  pfstring(PSTR("Space: "), pserial);
+  pint(Freespace - initial, pserial);
+  pfstring(PSTR(" bytes, Time: "), pserial);
+  pint(micros() - start, pserial);
+  pfstring(PSTR(" uS\r"), pserial);
   return nil;
 }

@@ -2004,7 +2289,7 @@

 object *fn_cls(object *args, object *env) {
   (void) args, (void) env;
-  pchar(12);
+  pserial(12);
   return nil;
 }

@@ -2014,7 +2299,7 @@
   (void) env;
   int pin = integer(first(args));
   object *mode = second(args);
-  if (mode->type == NUMBER) pinMode(pin, mode->integer);
+  if (numberp(mode)) pinMode(pin, mode->integer);
   else pinMode(pin, (mode != nil));
   return nil;
 }
@@ -2079,44 +2364,45 @@
 object *fn_edit (object *args, object *env) {
   object *fun = first(args);
   object *pair = findvalue(fun, env);
-  ExitEditor = 0;
+  clrflag(EXITEDITOR);
   object *arg = edit(eval(fun, env));
   cdr(pair) = arg;
   return arg;
 }

-object *edit(object *fun) {
+object *edit (object *fun) {
   while (1) {
-    if (ExitEditor) return fun;
-    char c = gchar();
-    if (c == 'q') ExitEditor = 1;
+    if (tstflag(EXITEDITOR)) return fun;
+    char c = gserial();
+    if (c == 'q') setflag(EXITEDITOR);
     else if (c == 'b') return fun;
-    else if (c == 'r') fun = read();
-    else if (c == '\r') { pfl(); superprint(fun, 0); pln(); }
-    else if (c == 'c') fun = cons(read(), fun);
-    else if (atom(fun)) pchar('!');
+    else if (c == 'r') fun = read(gserial);
+    else if (c == '\n') { pfl(pserial); superprint(fun, 0); pln(pserial); }
+    else if (c == 'c') fun = cons(read(gserial), fun);
+    else if (atom(fun)) pserial('!');
     else if (c == 'd') fun = cons(car(fun), edit(cdr(fun)));
     else if (c == 'a') fun = cons(edit(car(fun)), cdr(fun));
     else if (c == 'x') fun = cdr(fun);
-    else pchar('?');
+    else pserial('?');
   }
 }

 // Pretty printer

-const int ppindent = 2;
-int ppwidth = 80;
+const int PPINDENT = 2;
+const int PPWIDTH = 80;

 int atomwidth (object *obj) {
   if (obj == NULL) return 3;
-  if (obj->type == NUMBER) {
+  if (numberp(obj)) {
     int w = 1;
     int n = obj->integer;
     if (n < 0) { n = -n; w++; }
     while (n >= 10) { n = n/10; w++; }
     return w;
   }
-  if (obj->type == STRING) return stringlength(obj);
+  if (stringp(obj)) return stringlength(obj);
+  if (characterp(obj)) return 3; // Interim solution
   int w = 0;
   char *s = name(obj);
   while (*s++) w++;
@@ -2143,10 +2429,10 @@
 }

 void superprint (object *form, int lm) {
-  if (atom(form)) printobject(form);
-  else if (quoted(form)) { pchar('\''); superprint(car(cdr(form)), lm + 1); }
-  else if (subwidth(form, ppwidth - lm) >= 0) supersub(form, lm + ppindent, 0);
-  else supersub(form, lm + ppindent, 1);
+  if (atom(form)) printobject(form, pserial);
+  else if (quoted(form)) { pserial('\''); superprint(car(cdr(form)), lm + 1); }
+  else if (subwidth(form, PPWIDTH - lm) >= 0) supersub(form, lm + PPINDENT, 0);
+  else supersub(form, lm + PPINDENT, 1);
 }

 const int ppspecials = 8;
@@ -2163,20 +2449,20 @@
     }
   }
   while (form != NULL) {
-    if (atom(form)) { pfstring(F(" . ")); printobject(form); pchar(')'); return; }
-    else if (separate) { pchar('('); separate = 0; }
-    else if (special) { pchar(' '); special--; }
-    else if (!super) pchar(' ');
-    else { pln(); indent(lm); }
+    if (atom(form)) { pfstring(PSTR(" . "), pserial); printobject(form, pserial); pserial(')'); return; }
+    else if (separate) { pserial('('); separate = 0; }
+    else if (special) { pserial(' '); special--; }
+    else if (!super) pserial(' ');
+    else { pln(pserial); indent(lm); }
     superprint(car(form), lm);
     form = cdr(form);
   }
-  pchar(')'); return;
+  pserial(')'); return;
 }

 object *fn_pprint (object *args, object *env) {
   (void) env;
-  pln();
+  pln(pserial);
   superprint(first(args), 0);
   return symbol(NOTHING);
 }
@@ -2189,28 +2475,28 @@
 const char string1[] PROGMEM = "nil";
 const char string2[] PROGMEM = "t";
 const char string3[] PROGMEM = "nothing";
-const char string4[] PROGMEM = "string";
-const char string5[] PROGMEM = "&rest";
-const char string6[] PROGMEM = "lambda";
-const char string7[] PROGMEM = "let";
-const char string8[] PROGMEM = "let*";
-const char string9[] PROGMEM = "closure";
-const char string10[] PROGMEM = "special_forms";
-const char string11[] PROGMEM = "quote";
-const char string12[] PROGMEM = "defun";
-const char string13[] PROGMEM = "defvar";
-const char string14[] PROGMEM = "setq";
-const char string15[] PROGMEM = "loop";
-const char string16[] PROGMEM = "push";
-const char string17[] PROGMEM = "pop";
-const char string18[] PROGMEM = "incf";
-const char string19[] PROGMEM = "decf";
-const char string20[] PROGMEM = "setf";
-const char string21[] PROGMEM = "dolist";
-const char string22[] PROGMEM = "dotimes";
-const char string23[] PROGMEM = "trace";
-const char string24[] PROGMEM = "untrace";
-const char string25[] PROGMEM = "for-millis";
+const char string4[] PROGMEM = "&rest";
+const char string5[] PROGMEM = "lambda";
+const char string6[] PROGMEM = "let";
+const char string7[] PROGMEM = "let*";
+const char string8[] PROGMEM = "closure";
+const char string9[] PROGMEM = "special_forms";
+const char string10[] PROGMEM = "quote";
+const char string11[] PROGMEM = "defun";
+const char string12[] PROGMEM = "defvar";
+const char string13[] PROGMEM = "setq";
+const char string14[] PROGMEM = "loop";
+const char string15[] PROGMEM = "push";
+const char string16[] PROGMEM = "pop";
+const char string17[] PROGMEM = "incf";
+const char string18[] PROGMEM = "decf";
+const char string19[] PROGMEM = "setf";
+const char string20[] PROGMEM = "dolist";
+const char string21[] PROGMEM = "dotimes";
+const char string22[] PROGMEM = "trace";
+const char string23[] PROGMEM = "untrace";
+const char string24[] PROGMEM = "for-millis";
+const char string25[] PROGMEM = "with-serial";
 const char string26[] PROGMEM = "with-i2c";
 const char string27[] PROGMEM = "with-spi";
 const char string28[] PROGMEM = "tail_forms";
@@ -2284,45 +2570,58 @@
 const char string96[] PROGMEM = "zerop";
 const char string97[] PROGMEM = "oddp";
 const char string98[] PROGMEM = "evenp";
-const char string99[] PROGMEM = "stringp";
-const char string100[] PROGMEM = "string=";
-const char string101[] PROGMEM = "concatenate";
-const char string102[] PROGMEM = "subseq";
-const char string103[] PROGMEM = "logand";
-const char string104[] PROGMEM = "logior";
-const char string105[] PROGMEM = "logxor";
-const char string106[] PROGMEM = "lognot";
-const char string107[] PROGMEM = "ash";
-const char string108[] PROGMEM = "logbitp";
-const char string109[] PROGMEM = "eval";
-const char string110[] PROGMEM = "globals";
-const char string111[] PROGMEM = "locals";
-const char string112[] PROGMEM = "makunbound";
-const char string113[] PROGMEM = "break";
-const char string114[] PROGMEM = "read";
-const char string115[] PROGMEM = "prin1";
-const char string116[] PROGMEM = "print";
-const char string117[] PROGMEM = "princ";
-const char string118[] PROGMEM = "terpri";
-const char string119[] PROGMEM = "read-line";
-const char string120[] PROGMEM = "read-byte";
-const char string121[] PROGMEM = "write-byte";
-const char string122[] PROGMEM = "restart-i2c";
-const char string123[] PROGMEM = "gc";
-const char string124[] PROGMEM = "room";
-const char string125[] PROGMEM = "save-image";
-const char string126[] PROGMEM = "load-image";
-const char string127[] PROGMEM = "cls";
-const char string128[] PROGMEM = "pinmode";
-const char string129[] PROGMEM = "digitalread";
-const char string130[] PROGMEM = "digitalwrite";
-const char string131[] PROGMEM = "analogread";
-const char string132[] PROGMEM = "analogwrite";
-const char string133[] PROGMEM = "delay";
-const char string134[] PROGMEM = "millis";
-const char string135[] PROGMEM = "note";
-const char string136[] PROGMEM = "edit";
-const char string137[] PROGMEM = "pprint";
+const char string99[] PROGMEM = "char";
+const char string100[] PROGMEM = "char-code";
+const char string101[] PROGMEM = "code-char";
+const char string102[] PROGMEM = "characterp";
+const char string103[] PROGMEM = "stringp";
+const char string104[] PROGMEM = "string=";
+const char string105[] PROGMEM = "string<";
+const char string106[] PROGMEM = "string>";
+const char string107[] PROGMEM = "sort";
+const char string108[] PROGMEM = "string";
+const char string109[] PROGMEM = "concatenate";
+const char string110[] PROGMEM = "subseq";
+const char string111[] PROGMEM = "read-from-string";
+const char string112[] PROGMEM = "princ-to-string";
+const char string113[] PROGMEM = "prin1-to-string";
+const char string114[] PROGMEM = "logand";
+const char string115[] PROGMEM = "logior";
+const char string116[] PROGMEM = "logxor";
+const char string117[] PROGMEM = "lognot";
+const char string118[] PROGMEM = "ash";
+const char string119[] PROGMEM = "logbitp";
+const char string120[] PROGMEM = "eval";
+const char string121[] PROGMEM = "globals";
+const char string122[] PROGMEM = "locals";
+const char string123[] PROGMEM = "makunbound";
+const char string124[] PROGMEM = "break";
+const char string125[] PROGMEM = "read";
+const char string126[] PROGMEM = "prin1";
+const char string127[] PROGMEM = "print";
+const char string128[] PROGMEM = "princ";
+const char string129[] PROGMEM = "terpri";
+const char string130[] PROGMEM = "read-byte";
+const char string131[] PROGMEM = "read-line";
+const char string132[] PROGMEM = "write-byte";
+const char string133[] PROGMEM = "write-string";
+const char string134[] PROGMEM = "write-line";
+const char string135[] PROGMEM = "restart-i2c";
+const char string136[] PROGMEM = "gc";
+const char string137[] PROGMEM = "room";
+const char string138[] PROGMEM = "save-image";
+const char string139[] PROGMEM = "load-image";
+const char string140[] PROGMEM = "cls";
+const char string141[] PROGMEM = "pinmode";
+const char string142[] PROGMEM = "digitalread";
+const char string143[] PROGMEM = "digitalwrite";
+const char string144[] PROGMEM = "analogread";
+const char string145[] PROGMEM = "analogwrite";
+const char string146[] PROGMEM = "delay";
+const char string147[] PROGMEM = "millis";
+const char string148[] PROGMEM = "note";
+const char string149[] PROGMEM = "edit";
+const char string150[] PROGMEM = "pprint";

 const tbl_entry_t lookup_table[] PROGMEM = {
   { string0, NULL, NIL, NIL },
@@ -2330,27 +2629,27 @@
   { string2, NULL, 1, 0 },
   { string3, NULL, 1, 0 },
   { string4, NULL, 1, 0 },
-  { string5, NULL, 1, 0 },
+  { string5, NULL, 0, 127 },
   { string6, NULL, 0, 127 },
   { string7, NULL, 0, 127 },
   { string8, NULL, 0, 127 },
-  { string9, NULL, 0, 127 },
-  { string10, NULL, NIL, NIL },
-  { string11, sp_quote, 1, 1 },
-  { string12, sp_defun, 0, 127 },
-  { string13, sp_defvar, 2, 2 },
-  { string14, sp_setq, 2, 2 },
-  { string15, sp_loop, 0, 127 },
-  { string16, sp_push, 2, 2 },
-  { string17, sp_pop, 1, 1 },
-  { string18, sp_incf, 1, 2 },
-  { string19, sp_decf, 1, 2 },
-  { string20, sp_setf, 2, 2 },
-  { string21, sp_dolist, 1, 127 },
-  { string22, sp_dotimes, 1, 127 },
-  { string23, sp_trace, 0, 1 },
-  { string24, sp_untrace, 0, 1 },
-  { string25, sp_formillis, 1, 127 },
+  { string9, NULL, NIL, NIL },
+  { string10, sp_quote, 1, 1 },
+  { string11, sp_defun, 0, 127 },
+  { string12, sp_defvar, 2, 2 },
+  { string13, sp_setq, 2, 2 },
+  { string14, sp_loop, 0, 127 },
+  { string15, sp_push, 2, 2 },
+  { string16, sp_pop, 1, 1 },
+  { string17, sp_incf, 1, 2 },
+  { string18, sp_decf, 1, 2 },
+  { string19, sp_setf, 2, 2 },
+  { string20, sp_dolist, 1, 127 },
+  { string21, sp_dotimes, 1, 127 },
+  { string22, sp_trace, 0, 1 },
+  { string23, sp_untrace, 0, 1 },
+  { string24, sp_formillis, 1, 127 },
+  { string25, sp_withserial, 1, 127 },
   { string26, sp_withi2c, 1, 127 },
   { string27, sp_withspi, 1, 127 },
   { string28, NULL, NIL, NIL },
@@ -2424,48 +2723,71 @@
   { string96, fn_zerop, 1, 1 },
   { string97, fn_oddp, 1, 1 },
   { string98, fn_evenp, 1, 1 },
-  { string99, fn_stringp, 1, 1 },
-  { string100, fn_stringeq, 2, 2 },
-  { string101, fn_concatenate, 1, 127 },
-  { string102, fn_subseq, 2, 3 },
-  { string103, fn_logand, 0, 127 },
-  { string104, fn_logior, 0, 127 },
-  { string105, fn_logxor, 0, 127 },
-  { string106, fn_lognot, 1, 1 },
-  { string107, fn_ash, 2, 2 },
-  { string108, fn_logbitp, 2, 2 },
-  { string109, fn_eval, 1, 1 },
-  { string110, fn_globals, 0, 0 },
-  { string111, fn_locals, 0, 0 },
-  { string112, fn_makunbound, 1, 1 },
-  { string113, fn_break, 0, 0 },
-  { string114, fn_read, 0, 0 },
-  { string115, fn_prin1, 1, 1 },
-  { string116, fn_print, 1, 1 },
-  { string117, fn_princ, 1, 1 },
-  { string118, fn_terpri, 0, 0 },
-  { string119, fn_readline, 0, 0 },
-  { string120, fn_readbyte, 0, 2 },
-  { string121, fn_writebyte, 1, 2 },
-  { string122, fn_restarti2c, 1, 2 },
-  { string123, fn_gc, 0, 0 },
-  { string124, fn_room, 0, 0 },
-  { string125, fn_saveimage, 0, 1 },
-  { string126, fn_loadimage, 0, 0 },
-  { string127, fn_cls, 0, 0 },
-  { string128, fn_pinmode, 2, 2 },
-  { string129, fn_digitalread, 1, 1 },
-  { string130, fn_digitalwrite, 2, 2 },
-  { string131, fn_analogread, 1, 1 },
-  { string132, fn_analogwrite, 2, 2 },
-  { string133, fn_delay, 1, 1 },
-  { string134, fn_millis, 0, 0 },
-  { string135, fn_note, 0, 3 },
-  { string136, fn_edit, 1, 1 },
-  { string137, fn_pprint, 1, 1 },
+  { string99, fn_char, 2, 2 },
+  { string100, fn_charcode, 1, 1 },
+  { string101, fn_codechar, 1, 1 },
+  { string102, fn_characterp, 1, 1 },
+  { string103, fn_stringp, 1, 1 },
+  { string104, fn_stringeq, 2, 2 },
+  { string105, fn_stringless, 2, 2 },
+  { string106, fn_stringgreater, 2, 2 },
+  { string107, fn_sort, 2, 2 },
+  { string108, fn_stringfn, 1, 1 },
+  { string109, fn_concatenate, 1, 127 },
+  { string110, fn_subseq, 2, 3 },
+  { string111, fn_readfromstring, 1, 1 },
+  { string112, fn_princtostring, 1, 1 },
+  { string113, fn_prin1tostring, 1, 1 },
+  { string114, fn_logand, 0, 127 },
+  { string115, fn_logior, 0, 127 },
+  { string116, fn_logxor, 0, 127 },
+  { string117, fn_lognot, 1, 1 },
+  { string118, fn_ash, 2, 2 },
+  { string119, fn_logbitp, 2, 2 },
+  { string120, fn_eval, 1, 1 },
+  { string121, fn_globals, 0, 0 },
+  { string122, fn_locals, 0, 0 },
+  { string123, fn_makunbound, 1, 1 },
+  { string124, fn_break, 0, 0 },
+  { string125, fn_read, 0, 0 },
+  { string126, fn_prin1, 1, 1 },
+  { string127, fn_print, 1, 1 },
+  { string128, fn_princ, 1, 1 },
+  { string129, fn_terpri, 0, 0 },
+  { string130, fn_readbyte, 0, 2 },
+  { string131, fn_readline, 0, 1 },
+  { string132, fn_writebyte, 1, 2 },
+  { string133, fn_writestring, 1, 2 },
+  { string134, fn_writeline, 1, 2 },
+  { string135, fn_restarti2c, 1, 2 },
+  { string136, fn_gc, 0, 0 },
+  { string137, fn_room, 0, 0 },
+  { string138, fn_saveimage, 0, 1 },
+  { string139, fn_loadimage, 0, 0 },
+  { string140, fn_cls, 0, 0 },
+  { string141, fn_pinmode, 2, 2 },
+  { string142, fn_digitalread, 1, 1 },
+  { string143, fn_digitalwrite, 2, 2 },
+  { string144, fn_analogread, 1, 1 },
+  { string145, fn_analogwrite, 2, 2 },
+  { string146, fn_delay, 1, 1 },
+  { string147, fn_millis, 0, 0 },
+  { string148, fn_note, 0, 3 },
+  { string149, fn_edit, 1, 1 },
+  { string150, fn_pprint, 1, 1 },
 };

 // Table lookup functions
+
+int builtin (char* n) {
+  int entry = 0;
+  while (entry < ENDFUNCTIONS) {
+    if(strcmp_P(n, (char*)pgm_read_word(&lookup_table[entry].string)) == 0)
+      return entry;
+    entry++;
+  }
+  return ENDFUNCTIONS;
+}

 int longsymbol (char *buffer) {
   char *p = SymbolTable;
@@ -2474,32 +2796,22 @@
   if (p == buffer) {
     // Add to symbol table?
     char *newtop = SymbolTop + strlen(p) + 1;
-    if (SYMBOLTABLESIZE - (newtop - SymbolTable) < BUFFERSIZE) error(F("No room for long symbols"));
+    if (SYMBOLTABLESIZE - (newtop - SymbolTable) < BUFFERSIZE) error(PSTR("No room for long symbols"));
     SymbolTop = newtop;
   }
-  if (i > 1535) error(F("Too many long symbols"));
+  if (i > 1535) error(PSTR("Too many long symbols"));
   return i + 64000; // First number unused by radix40
 }

-int builtin(char* n){
-  int entry = 0;
-  while (entry < ENDFUNCTIONS) {
-    if(strcmp_P(n, (char*)pgm_read_word(&lookup_table[entry].string)) == 0)
-      return entry;
-    entry++;
-  }
-  return ENDFUNCTIONS;
-}
-
-int lookupfn(symbol_t name) {
+int lookupfn (symbol_t name) {
   return pgm_read_word(&lookup_table[name].fptr);
 }

-int lookupmin(symbol_t name) {
+int lookupmin (symbol_t name) {
   return pgm_read_word(&lookup_table[name].min);
 }

-int lookupmax(symbol_t name) {
+int lookupmax (symbol_t name) {
   return pgm_read_word(&lookup_table[name].max);
 }

@@ -2511,7 +2823,7 @@

 char *lookupsymbol (symbol_t name) {
   char *p = SymbolTable;
-  int i=name-64000;
+  int i = name - 64000;
   while (i > 0 && p < SymbolTop) {p = p + strlen(p) + 1; i--; }
   if (p == SymbolTop) return NULL; else return p;
 }
@@ -2525,6 +2837,10 @@
   SymbolTop = p;
 }

+void testescape () {
+  if (Serial.read() == '~') error(PSTR("Escape!"));
+}
+
 // Main evaluator

 object *eval (object *form, object *env) {
@@ -2532,18 +2848,18 @@
   EVAL:
   // Enough space?
   if (Freespace < 20) gc(form, env);
-  if (_end != 0xA5) error(F("Stack overflow"));
+  if (_end != 0xA5) error(PSTR("Stack overflow"));
   // Escape
-  if (Escape) { Escape = 0; error(F("Escape!"));}
+  if (tstflag(ESCAPE)) { clrflag(ESCAPE); error(PSTR("Escape!"));}
   #if defined (serialmonitor)
-  if (Serial.read() == '~') error(F("Escape!"));
-  #endif
+  testescape();
+  #endif

   if (form == NULL) return nil;

-  if ((form->type == NUMBER) || (form->type == STRING)) return form;
-
-  if (form->type == SYMBOL) {
+  if (numberp(form) || characterp(form) || stringp(form)) return form;
+
+  if (symbolp(form)) {
     symbol_t name = form->name;
     if (name == NIL) return nil;
     object *pair = value(name, env);
@@ -2551,15 +2867,16 @@
     pair = value(name, GlobalEnv);
     if (pair != NULL) return cdr(pair);
     else if (name <= ENDFUNCTIONS) return form;
-    error2(form, F("undefined"));
+    error2(form, PSTR("undefined"));
   }

   // It's a list
   object *function = car(form);
   object *args = cdr(form);
+  if (!listp(args)) error(PSTR("Can't evaluate a dotted pair"));

   // List starts with a symbol?
-  if (function->type == SYMBOL) {
+  if (symbolp(function)) {
     symbol_t name = function->name;

     if ((name == LET) || (name == LETSTAR)) {
@@ -2567,14 +2884,17 @@
       object *assigns = first(args);
       object *forms = cdr(args);
       object *newenv = env;
+      push(newenv, GCStack);
       while (assigns != NULL) {
         object *assign = car(assigns);
         if (consp(assign)) push(cons(first(assign),eval(second(assign),env)), newenv);
         else push(cons(assign,nil), newenv);
+        car(GCStack) = newenv;
         if (name == LETSTAR) env = newenv;
         assigns = cdr(assigns);
       }
       env = newenv;
+      pop(GCStack);
       form = tf_progn(forms,env);
       TC = TCstart;
       goto EVAL;
@@ -2587,7 +2907,7 @@
         object *pair = first(env);
         if (pair != NULL) {
           object *val = cdr(pair);
-          if (val->type == NUMBER) val = number(val->integer);
+          if (numberp(val)) val = number(val->integer);
           push(cons(car(pair), val), envcopy);
         }
         env = cdr(env);
@@ -2626,11 +2946,11 @@
   function = car(head);
   args = cdr(head);

-  if (function->type == SYMBOL) {
+  if (symbolp(function)) {
     symbol_t name = function->name;
-    if (name >= ENDFUNCTIONS) error2(fname, F("is not valid here"));
-    if (nargs<lookupmin(name)) error2(fname, F("has too few arguments"));
-    if (nargs>lookupmax(name)) error2(fname, F("has too many arguments"));
+    if (name >= ENDFUNCTIONS) error2(fname, PSTR("is not valid here"));
+    if (nargs<lookupmin(name)) error2(fname, PSTR("has too few arguments"));
+    if (nargs>lookupmax(name)) error2(fname, PSTR("has too many arguments"));
     object *result = ((fn_ptr_type)lookupfn(name))(args, env);
     pop(GCStack);
     return result;
@@ -2644,8 +2964,10 @@
     if (trace) {
       object *result = eval(form, env);
       indent((--(TraceDepth[trace-1]))<<1);
-      pint(TraceDepth[trace-1]); pchar(':'); pchar(' '); printobject(fname); pfstring(F(" returned "));
-      printobject(result); pln();
+      pint(TraceDepth[trace-1], pserial);
+      pserial(':'); pserial(' ');
+      printobject(fname, pserial); pfstring(PSTR(" returned "), pserial);
+      printobject(result, pserial); pln(pserial);
       return result;
     } else {
       TC = 1;
@@ -2662,102 +2984,120 @@
     goto EVAL;
   }

-  error2(fname, F("is an illegal function")); return nil;
-}
-
-// Input/Output
+  error2(fname, PSTR("is an illegal function")); return nil;
+}

 // Print functions

-void pchar (char c) {
+void pserial (char c) {
   LastPrint = c;
+  if (c == '\n') Serial.write('\r');
   Serial.write(c);
-  if (c == '\r') Serial.write('\n');
-}
-
-void pstring (char *s) {
-  while (*s) pchar(*s++);
-}
-
-void printstring (object *form) {
-  if (PrintReadably) pchar('"');
+}
+
+const char ControlCodes[] PROGMEM = "Null\0SOH\0STX\0ETX\0EOT\0ENQ\0ACK\0Bell\0Backspace\0Tab\0Newline\0VT\0"
+"Page\0Return\0SO\0SI\0DLE\0DC1\0DC2\0DC3\0DC4\0NAK\0SYN\0ETB\0CAN\0EM\0SUB\0Escape\0FS\0GS\0RS\0US\0Space\0";
+
+void pcharacter (char c, pfun_t pfun) {
+  if (!PrintReadably) pfun(c);
+  else {
+    pfun('#'); pfun('\\');
+    if (c > 32) pfun(c);
+    else {
+      PGM_P p = ControlCodes;
+      while (c > 0) {p = p + strlen_P(p) + 1; c--; }
+      pfstring(p, pfun);
+    }
+  }
+}
+
+void pstring (char *s, pfun_t pfun) {
+  while (*s) pfun(*s++);
+}
+
+void printstring (object *form, pfun_t pfun) {
+  if (PrintReadably) pfun('"');
   form = cdr(form);
   while (form != NULL) {
     int chars = form->integer;
     char ch = chars>>8 & 0xFF;
-    if (PrintReadably && ch == '"') pchar('\\');
-    pchar(ch);
+    if (PrintReadably && (ch == '"' || ch == '\\')) pfun('\\');
+    pfun(ch);
     ch = chars & 0xFF;
-    if (PrintReadably && ch == '"') pchar('\\');
-    if (ch) pchar(ch);
+    if (PrintReadably && (ch == '"' || ch == '\\')) pfun('\\');
+    if (ch) pfun(ch);
     form = car(form);
   }
-  if (PrintReadably) pchar('"');
-}
-
-void pfstring (const __FlashStringHelper *s) {
-  PGM_P p = reinterpret_cast<PGM_P>(s);
+  if (PrintReadably) pfun('"');
+}
+
+void pfstring (PGM_P s, pfun_t pfun) {
+  int p = (int)s;
   while (1) {
     char c = pgm_read_byte(p++);
     if (c == 0) return;
-    pchar(c);
-  }
-}
-
-void pint (int i) {
+    pfun(c);
+  }
+}
+
+void pint (int i, pfun_t pfun) {
   int lead = 0;
-  if (i<0) pchar('-');
+  if (i<0) pfun('-');
   for (int d=10000; d>0; d=d/10) {
     int j = i/d;
-    if (j!=0 || lead || d==1) { pchar(abs(j)+'0'); lead=1;}
+    if (j!=0 || lead || d==1) { pfun(abs(j)+'0'); lead=1;}
     i = i - j*d;
   }
 }

-void pln () {
-  pchar('\r');
-}
-
-void pfl () {
-  if (LastPrint != '\r') pchar('\r');
-}
-
-void printobject(object *form){
-  if (form == NULL) pfstring(F("nil"));
-  else if (listp(form) && issymbol(car(form), CLOSURE)) pfstring(F("<closure>"));
+inline void pln (pfun_t pfun) {
+  pfun('\n');
+}
+
+void pfl (pfun_t pfun) {
+  if (LastPrint != '\n') pfun('\n');
+}
+
+void printobject(object *form, pfun_t pfun){
+  if (form == NULL) pfstring(PSTR("nil"), pfun);
+  else if (listp(form) && issymbol(car(form), CLOSURE)) pfstring(PSTR("<closure>"), pfun);
   else if (listp(form)) {
-    pchar('(');
-    printobject(car(form));
+    pfun('(');
+    printobject(car(form), pfun);
     form = cdr(form);
     while (form != NULL && listp(form)) {
-      pchar(' ');
-      printobject(car(form));
+      pfun(' ');
+      printobject(car(form), pfun);
       form = cdr(form);
     }
     if (form != NULL) {
-      pfstring(F(" . "));
-      printobject(form);
-    }
-    pchar(')');
-  } else if (form->type == NUMBER) {
-    pint(integer(form));
-  } else if (form->type == SYMBOL) {
-    if (form->name != NOTHING) pstring(name(form));
-  } else if (form->type == STRING) {
-    printstring(form);
-  } else if (form->type == STREAM) {
-    pfstring(F("<"));
-    if ((form->integer)>>8 == SPISTREAM) pfstring(F("spi"));
-    else if ((form->integer)>>8 == I2CSTREAM) pfstring(F("i2c"));
-    else pfstring(F("serial"));
-    pfstring(F("-stream "));
-    pint(form->integer & 0xFF);
-    pchar('>');
+      pfstring(PSTR(" . "), pfun);
+      printobject(form, pfun);
+    }
+    pfun(')');
+  } else if (numberp(form)) {
+    pint(integer(form), pfun);
+  } else if (symbolp(form)) {
+    if (form->name != NOTHING) pstring(name(form), pfun);
+  } else if (characterp(form)) {
+    pcharacter(form->integer, pfun);
+  } else if (stringp(form)) {
+    printstring(form, pfun);
+  } else if (streamp(form)) {
+    pfstring(PSTR("<"), pfun);
+    if ((form->integer)>>8 == SPISTREAM) pfstring(PSTR("spi"), pfun);
+    else if ((form->integer)>>8 == I2CSTREAM) pfstring(PSTR("i2c"), pfun);
+    else pfstring(PSTR("serial"), pfun);
+    pfstring(PSTR("-stream "), pfun);
+    pint(form->integer & 0xFF, pfun);
+    pfun('>');
   } else
-    error(F("Error in print."));
-}
-
-int gchar () {
+    error(PSTR("Error in print."));
+}
+
+// Read functions
+
+char gserial () {
   if (LastChar) {
     char temp = LastChar;
     LastChar = 0;
@@ -2765,19 +3105,19 @@
   }
   while (!Serial.available());
   char temp = Serial.read();
-  if (temp != '\r') pchar(temp);
+  if (temp != '\n') pserial(temp);
   return temp;
 }

-object *nextitem() {
-  int ch = gchar();
-  while(isspace(ch)) ch = gchar();
+object *nextitem (gfun_t gfun) {
+  char ch = gfun();
+  while(isspace(ch)) ch = gfun();

   if (ch == ';') {
-    while(ch != '(') ch = gchar();
+    while(ch != '(') ch = gfun();
     ch = '(';
   }
-  if (ch == '\r') ch = gchar();
+  if (ch == '\n') ch = gfun();
   if (ch == EOF) exit(0);

   if (ch == ')') return (object *)KET;
@@ -2786,27 +3126,28 @@
   if (ch == '.') return (object *)DOT;

   // Parse string
-  if (ch == '"') return readstring('"');
+  if (ch == '"') return readstring('"', gfun);

-  // Parse variable or number
+  // Parse variable, character, or number
   int index = 0, base = 10, sign = 1;
   char *buffer = SymbolTop;
   int bufmax = SYMBOLTABLESIZE-(buffer-SymbolTable)-1; // Max index
   unsigned int result = 0;
   if (ch == '+') {
     buffer[index++] = ch;
-    ch = gchar();
+    ch = gfun();
   } else if (ch == '-') {
     sign = -1;
     buffer[index++] = ch;
-    ch = gchar();
+    ch = gfun();
   } else if (ch == '#') {
-    ch = gchar() | 0x20;
-    if (ch == 'b') base = 2;
-    else if (ch == 'o') base = 8;
-    else if (ch == 'x') base = 16;
-    else error(F("Illegal character after #"));
-    ch = gchar();
+    ch = gfun() & ~0x20;
+    if (ch == '\\') base = 0; // character
+    else if (ch == 'B') base = 2;
+    else if (ch == 'O') base = 8;
+    else if (ch == 'X') base = 16;
+    else error(PSTR("Illegal character after #"));
+    ch = gfun();
   }
   int isnumber = (digitvalue(ch)<base);
   buffer[2] = '\0'; // In case variable is one letter
@@ -2816,7 +3157,7 @@
     int temp = digitvalue(ch);
     result = result * base + temp;
     isnumber = isnumber && (digitvalue(ch)<base);
-    ch = gchar();
+    ch = gfun();
   }

   buffer[index] = '\0';
@@ -2824,8 +3165,16 @@
   if (ch == '(') LastChar = '(';

   if (isnumber) {
-    if (base == 10 && result > ((unsigned int)32767+(1-sign)/2)) error(F("Number out of range"));
+    if (base == 10 && result > ((unsigned int)32767+(1-sign)/2)) error(PSTR("Number out of range"));
     return number(result*sign);
+  } else if (base == 0) {
+    if (index == 1) return character(buffer[0]);
+    PGM_P p = ControlCodes; char c = 0;
+    while (c < 33) {
+      if (strcasecmp_P(buffer, p) == 0) return character(c);
+      p = p + strlen_P(p) + 1; c++;
+    }
+    error(PSTR("Unknown character"));
   }

   int x = builtin(buffer);
@@ -2835,40 +3184,45 @@
   else return symbol(longsymbol(buffer));
 }

-object *readrest() {
-  object *item = nextitem();
-
-  if(item == (object *)KET) return NULL;
-
-  if(item == (object *)DOT) {
-    object *arg1 = read();
-    if (readrest() != NULL) error(F("Malformed list"));
-    return arg1;
-  }
-
-  if(item == (object *)QUO) {
-    object *arg1 = read();
-    return cons(cons(symbol(QUOTE), cons(arg1, NULL)), readrest());
-  }
-
-  if(item == (object *)BRA) item = readrest();
-  return cons(item, readrest());
-}
-
-object *read() {
-  object *item = nextitem();
-  if (item == (object *)BRA) return readrest();
-  if (item == (object *)DOT) return read();
-  if (item == (object *)QUO) return cons(symbol(QUOTE), cons(read(), NULL));
+object *readrest (gfun_t gfun) {
+  object *item = nextitem(gfun);
+  object *head = NULL;
+  object *tail = NULL;
+
+  while (item != (object *)KET) {
+    if (item == (object *)BRA) {
+      item = readrest(gfun);
+    } else if (item == (object *)QUO) {
+      item = cons(symbol(QUOTE), cons(read(gfun), NULL));
+    } else if (item == (object *)DOT) {
+      tail->cdr = read(gfun);
+      if (readrest(gfun) != NULL) error(PSTR("Malformed list"));
+      return head;
+    } else {
+      object *cell = cons(item, NULL);
+      if (head == NULL) head = cell;
+      else tail->cdr = cell;
+      tail = cell;
+      item = nextitem(gfun);
+    }
+  }
+  return head;
+}
+
+object *read (gfun_t gfun) {
+  object *item = nextitem(gfun);
+  if (item == (object *)BRA) return readrest(gfun);
+  if (item == (object *)DOT) return read(gfun);
+  if (item == (object *)QUO) return cons(symbol(QUOTE), cons(read(gfun), NULL));
   return item;
 }
+
+// Setup

 void initenv() {
   GlobalEnv = NULL;
   tee = symbol(TEE);
 }
-
-// Setup

 void setup() {
   Serial.begin(9600);
@@ -2876,38 +3230,38 @@
   initworkspace();
   initenv();
   _end = 0xA5;      // Canary to check stack
-  pfstring(F("uLisp 1.8")); pln();
+  pfstring(PSTR("uLisp 1.9 "), pserial); pln(pserial);
 }

 // Read/Evaluate/Print loop

-void repl(object *env) {
+void repl (object *env) {
   for (;;) {
     randomSeed(micros());
     gc(NULL, env);
     #if defined (printfreespace)
-    pint(Freespace);
+    pint(Freespace, pserial);
     #endif
     if (BreakLevel) {
-      pfstring(F(" : "));
-      pint(BreakLevel);
-    }
-    pfstring(F("> "));
-    object *line = read();
-    if (BreakLevel && line == nil) { pln(); return; }
-    if (line == (object *)KET) error(F("Unmatched right bracket"));
+      pfstring(PSTR(" : "), pserial);
+      pint(BreakLevel, pserial);
+    }
+    pfstring(PSTR("> "), pserial);
+    object *line = read(gserial);
+    if (BreakLevel && line == nil) { pln(pserial); return; }
+    if (line == (object *)KET) error(PSTR("Unmatched right bracket"));
     push(line, GCStack);
-    pfl();
+    pfl(pserial);
     line = eval(line, env);
-    pfl();
-    printobject(line);
+    pfl(pserial);
+    printobject(line, pserial);
     pop(GCStack);
-    pfl();
-    pln();
-  }
-}
-
-void loop() {
+    pfl(pserial);
+    pln(pserial);
+  }
+}
+
+void loop () {
   if (!setjmp(exception)) {
     #if defined(resetautorun)
     autorunimage();
@@ -2915,4 +3269,3 @@
   }
   repl(NULL);
 }
-


first working version

first working version

--- StuntCarRacer/Arduino_Code/HapkitController/HapkitController.ino
+++ StuntCarRacer/Arduino_Code/HapkitController/HapkitController.ino
@@ -46,6 +46,7 @@
 double rh = 0.065659;   //[m]
 // Force output variables
 double force = 0;           // force at the handle
+double force_vibrate = 0;
 double Tp = 0;              // torque of the motor pulley
 double duty = 0;            // duty cylce (between 0 and 255)
 unsigned int output = 0;    // output command to the motor
@@ -58,6 +59,7 @@
 float vibrationfrequency = 10.0f;
 float amplitude = 1.0f;
 bool on_off = true;
+float springfactor = 0.0f;

 /*
       Setup function - this function run once when reset button is pressed.
@@ -131,11 +133,11 @@
 */
 void motorControl()
 {
-  if(abs(xh) > 35.0f);
+  if(abs(xh) > 35.0f)
     force = 0.0f;
-  Tp = rp / rs * rh * force;  // Compute the require motor pulley torque (Tp) to generate that force
+  Tp = rp / rs * rh * (force + force_vibrate);  // Compute the require motor pulley torque (Tp) to generate that force
   // Determine correct direction for motor torque
-  if (force < 0) {
+  if ((force+force_vibrate) < 0) {
     digitalWrite(dirPin, HIGH);
   } else {
     digitalWrite(dirPin, LOW);
@@ -230,9 +232,10 @@
   static float last_error = 0.0f;
   static float I = 0.0f;

-  static float kP = 0.2f;
+  const static float kP = 0.1f;
   static float kI = 0.0f;
-  static float kD = 0.00004f;
+  static float kD = 0.0f;//0.00004f;
+  float kP_scaled;

   const float MAX_DIFFERENCE = 0.0f;
   const float LIMITPLUS = 1.0f;
@@ -240,29 +243,21 @@
   const float MAX_FORCE_OUTPUT = 0.0f;
   float actualForceUsed = 0.0f;

+  kP_scaled = kP * springfactor / 1000.0f;
+
   float error = set_position - xh;
-  float time_now = (float)micros() * 1e-6f;
-
-  float dt = time_now - last_time;
-  float P = error * kP;
-  I += error * kI * dt;
-
-  if ( I > LIMITPLUS)
-    I = LIMITPLUS;
-  else if ( I < LIMITMINUS)
-    I = LIMITMINUS;
+
+  float P = error * kP_scaled;

   float D = -vh * kD;

   force = P + I + D;
-
-  last_time = time_now;
 }

 void shake(int interval_ms,float frequency_hz, float strength)
 {
     vibrationfrequency = frequency_hz;
-    nextcall = millis() + (uint32_t)interval_ms*64UL;
+    nextcall = millis() + (uint32_t)interval_ms * 64UL;
     amplitude = strength;
     on_off = true;
 }
@@ -286,9 +281,12 @@
     Serial.print(" ");
     Serial.println(xh);
   }
-  on_off ? set_position = xh + amplitude * sin(vibrationfrequency*2.0f*M_PI*millis()/64000.0f) : force = 0;
+
+
+  // calculations for haptic event feedback
+  on_off ? force_vibrate = amplitude * sin(vibrationfrequency*2.0f*M_PI*millis()/64000.0f) : force_vibrate = 0;
+
   motorControl();
-
 }

 /*
@@ -306,21 +304,21 @@
   //TODO the reading and decoding goes here

   if (fbEvent.startsWith("FB")) {
-	force = atoi(fbEvent.substring(3).c_str());
+	springfactor = atof(fbEvent.substring(3).c_str()); // roughly from 0 to 1000
     //Serial.print("force: ");
     //Serial.println(force);
   } else if (fbEvent.startsWith("HitCar")) {
-	shake(500, 100.0f, 2.0f);
+	shake(500, 100.0f, 0.1f);
   } else if (fbEvent.startsWith("Creak")) {
-    shake(500, 100.0f, 2.0f);
+    shake(500, 100.0f, 0.1f);
   } else if (fbEvent.startsWith("Smash")) {
-	shake(500, 100.0f, 2.0f);
+	shake(500, 100.0f, 0.5f);
   } else if (fbEvent.startsWith("Wreck")) {
-	shake(500, 200.0f, 2.0f);
+	shake(500, 200.0f, 0.1f);
   } else if (fbEvent.startsWith("Offroad")) {
-	shake(500, 50.0f, 2.0f);
+	shake(500, 20.0f, 0.1f);
   } else if (fbEvent.startsWith("Grounded")) {
-	shake(200, 500.0f, 4.0f);
+	shake(200, 10.0f, 0.1f);
   }
 }


Update NTPClient.ino

Update NTPClient.ino

Instead of hardwiring the IP address of one server into the program, look-up an IP address from the host name.  This way you get a random server from the pool each time.

--- hardware/esp8266com/esp8266/libraries/ESP8266WiFi/examples/NTPClient/NTPClient.ino
+++ hardware/esp8266com/esp8266/libraries/ESP8266WiFi/examples/NTPClient/NTPClient.ino
@@ -27,7 +27,11 @@

 unsigned int localPort = 2390;      // local port to listen for UDP packets

-IPAddress timeServer(129, 6, 15, 28); // time.nist.gov NTP server
+/* Don't hardwire the IP address or we won't get the benefits of the pool.
+ *  Lookup the IP address for the host name instead */
+//IPAddress timeServer(129, 6, 15, 28); // time.nist.gov NTP server
+IPAddress timeServerIP; // time.nist.gov NTP server address
+const char* ntpServerName = "time.nist.gov";

 const int NTP_PACKET_SIZE = 48; // NTP time stamp is in the first 48 bytes of the message

@@ -65,6 +69,9 @@

 void loop()
 {
+  //get a random server from the pool
+  WiFi.hostByName(ntpServerName, timeServerIP);
+
   sendNTPpacket(timeServer); // send an NTP packet to a time server
   // wait to see if a reply is available
   delay(1000);


Bugfix

Bugfix

flashed data from serial, could cause bug where first packet would be corrupted

--- Battery_Tester/Battery_Tester.ino
+++ Battery_Tester/Battery_Tester.ino
@@ -44,7 +44,7 @@
 	double currentCurrent=0.0;
 	double totalCurrent=0.0;
 	long startTime = 0;
-	double resistorValue = 1.95; // tweak for better accuracy in startTest function
+	double resistorValue = 1.95;  //tweak for better accuracy in startTest function
 	long stopTime = -1;
 	double capacity = -1.0;
 	double totalWattHours = 0.0;
@@ -58,7 +58,7 @@
 unsigned long fanStopAt = 0;

 void setup() {
-  system_update_cpu_freq(80);	// 80 or 160
+  system_update_cpu_freq(160);	// 80 or 160
   system_phy_set_max_tpw(35); // 0 - 82 radio TX power
   pinMode(wifiLEDPin,OUTPUT);
   pinMode(fanPin,OUTPUT);
@@ -105,8 +105,7 @@
   checkFanState();
 }

-void setupAP()
-{
+void setupAP(){
   const char WiFiAPPSK[] = "12345678";
   WiFi.mode(WIFI_AP);
   const char *ssid = "BatteryTester";
@@ -461,7 +460,13 @@
 	batteriesStopped = 0;
 	startFanDelay = false;
 	digitalWrite(fanPin,HIGH); // turn on the fan
+	//clear serial buffer of any old data
+	while (Serial.available()){
+	Serial.read();
+	}
 	Serial.println(F("START START"));
+	currentDataString = "";
+	currentDataStringComplete = false;
 }
 void testForFiles(){// make sure there are files to prevent webpage errors


Remove Arduino.ORG reference

Remove Arduino.ORG reference

--- examples/Boards_Ethernet/Arduino_Ethernet2/Arduino_Ethernet2.ino
+++ examples/Boards_Ethernet/Arduino_Ethernet2/Arduino_Ethernet2.ino
@@ -17,11 +17,11 @@
   This example code is in public domain.

  *************************************************************
-  This example shows how to use Arduino.org Ethernet Shield 2 (W5500)
+  This example shows how to use Arduino Ethernet Shield 2 (W5500)
   to connect your project to Blynk.

-  NOTE: You may have to install Arduino.ORG IDE to get it working:
-          http://www.arduino.org/software
+  Note: This requires Ethernet2 library
+    from http://librarymanager/all#Ethernet2

         Pins 10, 11, 12 and 13 are reserved for Ethernet module.
         DON'T use them in your sketch directly!


temp set by msg

temp set by msg

--- _72-homekit-accessories-Aircon/_72-homekit-accessories-Aircon.ino
+++ _72-homekit-accessories-Aircon/_72-homekit-accessories-Aircon.ino
@@ -163,7 +163,6 @@
     }
   }

-  /*
   if (receivedtopic == subscribe_set)
   {
     if (root.containsKey("ac_temp"))
@@ -178,15 +177,15 @@
         //        ir_data.ac_flow = root["ac_flow"];
         //    }
         //
-
+        /*
         if (ir_data.ac_mode == 1 && bpresence)
         {
             ir_data.haveData = true;
         }
+        */
       }
     }
   }
-  */
 }

 void ICACHE_RAM_ATTR callback(char* intopic, byte* inpayload, unsigned int length)


This release fixes some issues and more optimized

--- TinyScreenClockAndDisplay.ino
+++ TinyScreenClockAndDisplay.ino
@@ -27,7 +27,7 @@
 int buttonReleased=0;
 int countdown = 0;

-char notificationLine1[20]="Release 2.1.1";
+char notificationLine1[20]="Build 2.5.0";

 void setup(void) { // setup
   Wire.begin();
@@ -41,7 +41,9 @@
   display.print("Welcome");
   display.setCursor(0,40);
   display.print("Booting up");
-  Serial.print("Initializing");
+  displayState = 1;
+  display.on();
+  countdown = 90;
   delay(2000);
   display.clearWindow(0,0,0,0);
 }
@@ -90,7 +92,7 @@

   // Time
   display.setCursor(0,30);
-  display.fontColor(GREEN,BLACK);
+  display.fontColor(YELLOW,BLACK);
   int hours = RTC.getHours();
   if (hours > 12)
 {
@@ -101,35 +103,31 @@

   if (RTC.getMinutes() < 10)
    {
-     display.fontColor(YELLOW,BLACK);
      display.print("0");
      display.print(minute);
    }
    else
    {
-     display.fontColor(YELLOW,BLACK);
      display.print(minute);
    }

-  display.fontColor(GREEN,BLACK);

   display.print(":");

    if (RTC.getSeconds() < 10)
    {
-     display.fontColor(RED,BLACK);
      display.print("0");
      display.print(second);
    }
    else
    {
-     display.fontColor(RED,BLACK);
      display.print(second);
    }
 }
 void displayNotifications(){
   display.setFont(liberationSans_10ptFontInfo);
   display.setCursor(0,50);
+  display.fontColor(RED,BLACK);
   display.print(notificationLine1);
   for(int i=0;i<40;i++)display.write(' ');
   display.setCursor(0,50);
@@ -142,8 +140,6 @@
   ADCSRA |= _BV( ADSC );
   while( ( (ADCSRA & (1<<ADSC)) != 0 ) );
   int result = (((InternalReferenceVoltage * 1024L) / ADC) + 5L) / 10L;
-  //Serial.println(result);
-  //if(result>440){//probably charging
   result=constrain(result-300,0,120);
   int x=72;
   int y=2;


Update comment

Update comment

--- software/arduino/iota-ifttt/iota-ifttt.ino
+++ software/arduino/iota-ifttt/iota-ifttt.ino
@@ -19,14 +19,14 @@

   WiFi.mode(WIFI_STA);
   WiFi.begin(WIFI_SSID, WIFI_PASSWORD);
-  Serial.print("Wifi verbinden");
+  Serial.print("Connecting wifi");

   while (WiFi.status() != WL_CONNECTED) {
     delay(500);
     Serial.print(".");
   }

-  Serial.println(" verbonden!");
+  Serial.println(" connected!");
   Serial.print("IP: ");
   Serial.println(WiFi.localIP());


Added compressor and defrost output

Added compressor and defrost output

--- chillduino.ino
+++ chillduino.ino
@@ -24,6 +24,8 @@
 #include <Adafruit_NeoPixel.h>
 #include "chillduino.h"

+#define COMPRESSOR     9
+#define DEFROST        10
 #define DOOR_SWITCH    13
 #define DEFROST_SWITCH 12
 #define THERMISTOR     A0
@@ -71,6 +73,8 @@
 void setup(void) {
   pinMode(DOOR_SWITCH, INPUT);
   pinMode(DEFROST_SWITCH, INPUT);
+  pinMode(COMPRESSOR, OUTPUT);
+  pinMode(DEFROST, OUTPUT);

   chillduino
     .setMinimumFreshFoodThermistorReading(370)
@@ -108,5 +112,8 @@
     else {
       setLedColor(LED_OFF_R, LED_OFF_G, LED_OFF_B);
     }
+
+    digitalWrite(COMPRESSOR, chillduino.isCompressorRunning());
+    digitalWrite(DEFROST, chillduino.isDefrostRunning());
   }
 }


added t_buttons_controller

added t_buttons_controller

--- jenny5-firmware/jenny5-firmware.ino
+++ jenny5-firmware/jenny5-firmware.ino
@@ -3,7 +3,7 @@
 #include "ultrasonic_sensors_controller.h"
 #include "potentiometers_controller.h"
 #include "stepper_motors_control.h"
-#include "button_controller.h"
+#include "buttons_controller.h"
 #include "jenny5_types.h"
 #include "infrared_sensors_controller.h"
 #include "dc_motors_controller_TB6612FNG.h"
@@ -15,6 +15,7 @@
 t_potentiometers_controller potentiometers_controller;
 t_ultrasonic_sensors_controller ultrasonic_sensors_controller;
 t_infrared_sensors_controller infrared_sensors_controller;
+t_buttons_controller buttons_controller;

 char is_command_running;

@@ -32,7 +33,7 @@
 void setup()
 {
   first_start = 0;
-  strcpy(firmware_version, "2016.02.19.0");
+  strcpy(firmware_version, "2016.02.20.0");

   current_buffer[0] = 0;

@@ -74,11 +75,14 @@
   Serial.println(F("GUx# // Gets the parameters for ultrasound x: trig_pin echo_pin. Outputs UPx t e#"));

   Serial.println(F("CS n d1 s1 e1 d2 s2 e2# // Creates the stepper motors controller and set some of its parameters. n is the number of motors, d, s, e are dir, step and enable pins. Outputs CS# when done."));
+  Serial.println(F("CD n p1 d11 d12 e1 p2 d21 d22 e2# // Creates the dc motors controller and set some of its parameters. n is the number of motors, p is the pwm_pin, d1 and d2 are the direction pins and e is the enable pins. Outputs CD# when done."));
+  Serial.println(F("CV n# // Creates the servo motors controller and set some of its parameters. n is the number of motors, Outputs CV# when done."));
+
   Serial.println(F("CP n p1 l1 h1 _h1 _d1 p2 l2 h2 _h2 _d2# // Creates the potentiometers controller and set some of its parameters. n is the number of potentiometers, p is the output pin, l, h and _h are bottom, upper and home position, _d is the directon of the sensor relative to the direction in which the motor is moving. Outputs CP# when done."));
   Serial.println(F("CU n t1 e1 t2 e2# // Creates the ultrasonic controller and set some of its parameters. n is the number of sonars, t and e are trigger and echo pins. Outputs CU# when done."));
-  Serial.println(F("CI n p1 l1 p2 l2# // Creates the infrared controller and set some of its parameters. n is the number of infrared sensors, p is the analog pin and l is the low and e are trigger and echo pins. Outputs CU# when done."));
-  Serial.println(F("CD n p1 d11 d12 e1 p2 d21 d22 e2# // Creates the dc motors controller and set some of its parameters. n is the number of motors, p is the pwm_pin, d1 and d2 are the direction pins and e is the enable pins. Outputs CD# when done."));
-  Serial.println(F("CV n# // Creates the servo motors controller and set some of its parameters. n is the number of motors, Outputs CV# when done."));
+  Serial.println(F("CI n p1 l1 p2 l2# // Creates the infrared controller and set some of its parameters. n is the number of infrared sensors, p is the analog pin and l is the low and e are trigger and echo pins. Outputs CI# when done."));
+  Serial.println(F("CB n p1 p2# // Creates the buttons controller and set some of its parameters. n is the number of button sensors, p is the digital pin. Outputs CB# when done."));
+

   Serial.println(F("V# // Outputs version string. eg: 2016.01.17.0#"));

@@ -111,7 +115,7 @@
             i++;// error on incomplete string (does nothing)
         }
         else
-          if (tmp_str[i + 1] == 'D' || tmp_str[i + 1] == 'd'){// stepper motor
+          if (tmp_str[i + 1] == 'D' || tmp_str[i + 1] == 'd'){// DC motor
             int motor_index, num_miliseconds;
             int num_read = sscanf(tmp_str + i + 2, "%d%d", &motor_index, &num_miliseconds);
             if (num_read == 2){
@@ -183,7 +187,7 @@
             else
               if (tmp_str[i + 1] == 'D' || tmp_str[i + 1] == 'd'){// go stepper home
                 sscanf(tmp_str + i + 2, "%d", &motor_index);
-                dc_motors_controller_TB6612FNG.go_home(motor_index, &potentiometers_controller);
+                dc_motors_controller_TB6612FNG.go_home(motor_index, &buttons_controller);
                 sprintf(serial_out, "HD%d#", motor_index);
               }
             is_command_running = 1;


fixed the bug with infinite loop if there were blank spaces between commands

--- jenny5-firmware/jenny5-firmware.ino
+++ jenny5-firmware/jenny5-firmware.ino
@@ -18,7 +18,7 @@

 char is_command_running;

-char firmware_version[] = "2015.12.09.0";// year.month.day.version
+char firmware_version[] = "2015.12.19.1";// year.month.day.built number

 char current_buffer[65];

@@ -64,7 +64,7 @@
 {
   byte i = 0;
   while (i < str_length){
-    if (current_buffer[i] >= 'A' && current_buffer[i] <= 'Z' || current_buffer[i] >= 'a' && current_buffer[i] <= 'z'){
+    if (tmp_str[i] >= 'A' && tmp_str[i] <= 'Z' || tmp_str[i] >= 'a' && tmp_str[i] <= 'z'){
       if (tmp_str[i] == 'M' || tmp_str[i] == 'm'){// moves motor
         int motor_index, num_steps;
         sscanf(tmp_str + i + 1, "%d%d", &motor_index, &num_steps);
@@ -191,6 +191,7 @@
               tmp_str[j - i] = 0;

               #ifdef DEBUG
+
                 Serial.write("current command is=");
                 Serial.write(tmp_str);
                 Serial.println();
@@ -199,7 +200,7 @@
               parse_and_execute_commands(tmp_str, j - i);

               // remove the current executed command
-              strcpy(current_buffer, current_buffer + j + 1);// not sure if this is good
+              strcpy(current_buffer, current_buffer + j + 1);// not sure if this is good due to overlaps

               #ifdef DEBUG
                 Serial.write("buffer left=");


deal with mixed-up Nucleo serial port order

--- projects/ask/stm32f1init/stm32f1init.ino
+++ projects/ask/stm32f1init/stm32f1init.ino
@@ -21,8 +21,13 @@

 #else // assume an STM32F103 running at 72 MHz, with hardware serial

+#ifdef ARDUINO_STM_NUCLEO_F103RB
+#define Target  Serial
+#define Log     Serial1
+#else
 #define Target  Serial1
 #define Log     Serial
+#endif

 #define TIMEOUT 2000000


Go to waiting mode when starting up.

Go to waiting mode when starting up.

--- timer/timer.ino
+++ timer/timer.ino
@@ -37,7 +37,6 @@

   // start in waiting state
   change_to_state(STATE_WAITING);
-  change_to_state(STATE_MODE);
 }

 void loop() {


Made better success/fail messages to include message being sent

--- transmitter/transmitter.ino
+++ transmitter/transmitter.ino
@@ -65,9 +65,9 @@
         radio.stopListening();

         if (!radio.write( &msg, sizeof(msg))){
-                Serial.println(F("failed to send"));
+                Serial.print(F("Failed to send: ")); Serial.println(msg);
         } else {
-                Serial.println("Success");
+                Serial.print("Success: "); Serial.println(msg);
         }

         packet_count++;


LCD tweaks

LCD tweaks

--- dds_playground/src/sketch.ino
+++ dds_playground/src/sketch.ino
@@ -78,11 +78,11 @@
                 tablemask |= (1 << i);
             }
         }
+
+        lcd.write('|');
         lcd.print(tablemask, HEX);
-        lcd.write('/');
+        lcd.write('|');
         lcd.print(used_wavetables);
-        lcd.write('/');
-        lcd.print(wavetables[0].currentnote);
         lcd.print("  ");
     }


Implemented comments by @IowaDave

Implemented comments by @IowaDave

--- examples/AlarmInterrupt/AlarmInterrupt.ino
+++ examples/AlarmInterrupt/AlarmInterrupt.ino
@@ -16,11 +16,11 @@
 #include <DS3231.h>
 #include <Wire.h>

-// Clock interrupt pin
+// myRTC interrupt pin
 #define CLINT 2

 // Setup clock
-DS3231 Clock;
+DS3231 myRTC;

 // Interrupt signaling byte
 volatile byte tick = 1;
@@ -29,11 +29,11 @@
     // Begin I2C communication
     Wire.begin();

-    // Setup alarm two to fire every second
-    Clock.turnOffAlarm(1);
-    Clock.setA1Time(0, 0, 0, 0, 0b01111111, false, false, false);
-    Clock.turnOnAlarm(1);
-    Clock.checkIfAlarm(1);
+    // Setup alarm one to fire every second
+    myRTC.turnOffAlarm(1);
+    myRTC.setA1Time(0, 0, 0, 0, 0b01111111, false, false, false);
+    myRTC.turnOnAlarm(1);
+    myRTC.checkIfAlarm(1);

     // attach clock interrupt
     pinMode(CLINT, INPUT_PULLUP);
@@ -53,8 +53,10 @@
         state = ~state;
         digitalWrite(LED_BUILTIN, state);
         // Clear alarm state
-        Clock.checkIfAlarm(1);
+        myRTC.checkIfAlarm(1);
     }
+
+    // Loop delay to emulate other running code
     delay(10);
 }