Skip to content

Commit

Permalink
Version 3.6b - 20th June 2021
Browse files Browse the repository at this point in the history
Fixes #51, fixes #52
  • Loading branch information
technoblogy committed Jun 20, 2021
1 parent 8e1bdf8 commit 21c6fc3
Showing 1 changed file with 29 additions and 39 deletions.
68 changes: 29 additions & 39 deletions ulisp-esp.ino
@@ -1,5 +1,5 @@
/* uLisp ESP Version 3.6 - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 4th April 2021
/* uLisp ESP Version 3.6b - www.ulisp.com
David Johnson-Davies - www.technoblogy.com - 20th June 2021
Licensed under the MIT license: https://opensource.org/licenses/MIT
*/
Expand Down Expand Up @@ -226,6 +226,7 @@ object *apply (symbol_t name, object *function, object *args, object *env);
char *lookupsymbol (symbol_t name);
char *cstring (object *form, char *buffer, int buflen);
object *edit (object *fun);
void pfstring (PGM_P s, pfun_t pfun);

// Error handling

Expand Down Expand Up @@ -353,6 +354,13 @@ object *stream (uint8_t streamtype, uint8_t address) {
return ptr;
}

object *newstring () {
object *ptr = myalloc();
ptr->type = STRING;
ptr->chars = 0;
return ptr;
}

// Garbage collection

void markobject (object *obj) {
Expand Down Expand Up @@ -993,21 +1001,20 @@ void indent (uint8_t spaces, char ch, pfun_t pfun) {
}

object *startstring (symbol_t name) {
object *string = myalloc();
string->type = STRING;
GlobalString = NULL;
object *string = newstring();
GlobalString = string;
GlobalStringIndex = 0;
return string;
}

void buildstring (uint8_t ch, int *chars, object **head) {
void buildstring (uint8_t ch, object *string, int *chars) {
static object* tail;
static uint8_t shift;
if (*chars == 0) {
shift = (sizeof(int)-1)*8;
*chars = ch<<shift;
object *cell = myalloc();
if (*head == NULL) *head = cell; else tail->car = cell;
if (cdr(string) == NULL) cdr(string) = cell; else tail->car = cell;
cell->car = NULL;
cell->chars = *chars;
tail = cell;
Expand All @@ -1020,18 +1027,15 @@ void buildstring (uint8_t ch, int *chars, object **head) {
}

object *readstring (uint8_t delim, gfun_t gfun) {
object *obj = myalloc();
obj->type = STRING;
object *obj = newstring();
int ch = gfun();
if (ch == -1) return nil;
object *head = NULL;
int chars = 0;
while ((ch != delim) && (ch != -1)) {
if (ch == '\\') ch = gfun();
buildstring(ch, &chars, &head);
buildstring(ch, obj, &chars);
ch = gfun();
}
obj->cdr = head;
return obj;
}

Expand Down Expand Up @@ -1073,7 +1077,7 @@ int gstr () {
}

void pstr (char c) {
buildstring(c, &GlobalStringIndex, &GlobalString);
buildstring(c, GlobalString, &GlobalStringIndex);
}

char *cstringbuf (object *arg) {
Expand All @@ -1100,17 +1104,14 @@ char *cstring (object *form, char *buffer, int buflen) {
}

object *lispstring (char *s) {
object *obj = myalloc();
obj->type = STRING;
object *obj = newstring();
char ch = *s++;
object *head = NULL;
int chars = 0;
while (ch) {
if (ch == '\\') ch = *s++;
buildstring(ch, &chars, &head);
buildstring(ch, obj, &chars);
ch = *s++;
}
obj->cdr = head;
return obj;
}

Expand Down Expand Up @@ -1857,10 +1858,10 @@ object *sp_withoutputtostring (object *args, object *env) {
object *pair = cons(var, stream(STRINGSTREAM, 0));
push(pair,env);
object *string = startstring(WITHOUTPUTTOSTRING);
push(string, GCStack);
object *forms = cdr(args);
eval(tf_progn(forms,env), env);
string->cdr = GlobalString;
GlobalString = NULL;
pop(GCStack);
return string;
}

Expand All @@ -1887,7 +1888,7 @@ object *sp_withi2c (object *args, object *env) {
object *var = first(params);
int address = checkinteger(WITHI2C, eval(second(params), env));
params = cddr(params);
if (address == 0) params = cdr(params); // Ignore port
if (address == 0 && params != NULL) params = cdr(params); // Ignore port
int read = 0; // Write
I2CCount = 0;
if (params != NULL) {
Expand Down Expand Up @@ -3066,8 +3067,7 @@ object *fn_stringfn (object *args, object *env) {
object *arg = first(args);
int type = arg->type;
if (type == STRING) return arg;
object *obj = myalloc();
obj->type = STRING;
object *obj = newstring();
if (type == CHARACTER) {
object *cell = myalloc();
cell->car = NULL;
Expand All @@ -3077,14 +3077,12 @@ object *fn_stringfn (object *args, object *env) {
} else if (type == SYMBOL) {
char *s = symbolname(arg->name);
char ch = *s++;
object *head = NULL;
int chars = 0;
while (ch) {
if (ch == '\\') ch = *s++;
buildstring(ch, &chars, &head);
buildstring(ch, arg, &chars);
ch = *s++;
}
obj->cdr = head;
} else error(STRINGFN, PSTR("can't convert to string"), arg);
return obj;
}
Expand All @@ -3094,9 +3092,7 @@ object *fn_concatenate (object *args, object *env) {
object *arg = first(args);
if (arg->name != STRINGFN) error2(CONCATENATE, PSTR("only supports strings"));
args = cdr(args);
object *result = myalloc();
result->type = STRING;
object *head = NULL;
object *result = newstring();
int chars = 0;
while (args != NULL) {
object *obj = first(args);
Expand All @@ -3106,14 +3102,13 @@ object *fn_concatenate (object *args, object *env) {
int quad = obj->chars;
while (quad != 0) {
char ch = quad>>((sizeof(int)-1)*8) & 0xFF;
buildstring(ch, &chars, &head);
buildstring(ch, result, &chars);
quad = quad<<8;
}
obj = car(obj);
}
args = cdr(args);
}
result->cdr = head;
return result;
}

Expand All @@ -3126,16 +3121,13 @@ object *fn_subseq (object *args, object *env) {
int end;
args = cddr(args);
if (args != NULL) end = checkinteger(SUBSEQ, car(args)); else end = stringlength(arg);
object *result = myalloc();
result->type = STRING;
object *head = NULL;
object *result = newstring();
int chars = 0;
for (int i=start; i<end; i++) {
char ch = nthchar(arg, i);
if (ch == 0) error2(SUBSEQ, PSTR("index out of range"));
buildstring(ch, &chars, &head);
buildstring(ch, result, &chars);
}
result->cdr = head;
return result;
}

Expand All @@ -3153,7 +3145,6 @@ object *fn_princtostring (object *args, object *env) {
object *arg = first(args);
object *obj = startstring(PRINCTOSTRING);
prin1object(arg, pstr);
obj->cdr = GlobalString;
return obj;
}

Expand All @@ -3162,7 +3153,6 @@ object *fn_prin1tostring (object *args, object *env) {
object *arg = first(args);
object *obj = startstring(PRIN1TOSTRING);
printobject(arg, pstr);
obj->cdr = GlobalString;
return obj;
}

Expand Down Expand Up @@ -3641,7 +3631,7 @@ object *fn_format (object *args, object *env) {
}
n++;
}
if (output == nil) { obj->cdr = GlobalString; return obj; }
if (output == nil) return obj;
else return nil;
}

Expand Down

0 comments on commit 21c6fc3

Please sign in to comment.