shithub: femtolisp

Download patch

ref: 703d57deb969d9b562ebe74c838e03532999cd1b
parent: e1d94403fed4edc6607a1eebf7fda984d2c79cac
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Mar 27 10:59:23 EDT 2023

import "flisp: do not mutate the system image while loading it" patch by vtjnash from Julia

--- a/cvalues.c
+++ b/cvalues.c
@@ -332,6 +332,17 @@
     type_error(fname, "number", n);
 }
 
+off_t tooffset(value_t n, char *fname)
+{
+    if (isfixnum(n))
+        return numval(n);
+    if (iscprim(n)) {
+        cprim_t *cp = (cprim_t*)ptr(n);
+        return conv_to_int64(cp_data(cp), cp_numtype(cp));
+    }
+    type_error(fname, "number", n);
+}
+
 static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
 {
     int n;
--- a/flisp.h
+++ b/flisp.h
@@ -332,6 +332,7 @@
 size_t cvalue_arraylen(value_t v);
 value_t size_wrap(size_t sz);
 size_t toulong(value_t n, char *fname);
+off_t tooffset(value_t n, char *fname);
 value_t cvalue_string(size_t sz);
 value_t cvalue_static_cstring(const char *str);
 value_t string_from_cstr(char *str);
@@ -353,7 +354,9 @@
 
 value_t mk_double(double n);
 value_t mk_float(float n);
+value_t mk_int32(int32_t n);
 value_t mk_uint32(uint32_t n);
+value_t mk_int64(int64_t n);
 value_t mk_uint64(uint64_t n);
 value_t mk_wchar(int32_t n);
 value_t return_from_uint64(uint64_t Uaccum);
--- a/flmain.c
+++ b/flmain.c
@@ -20,7 +20,7 @@
 int
 main(int argc, char **argv)
 {
-    static char bootraw[] = {
+    static const char bootraw[] = {
 #include "boot.h"
     };
     value_t f;
--- a/iostream.c
+++ b/iostream.c
@@ -150,17 +150,15 @@
     return fixnum(ios_pututf8(s, wc));
 }
 
-value_t fl_ioungetc(value_t *args, uint32_t nargs)
+value_t fl_ioskip(value_t *args, uint32_t nargs)
 {
-    argcount("io.ungetc", nargs, 2);
-    ios_t *s = toiostream(args[0], "io.ungetc");
-    if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
-        type_error("io.ungetc", "wchar", args[1]);
-    uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
-    if (wc >= 0x80) {
-        lerrorf(ArgError, "io_ungetc: unicode not yet supported");
-    }
-    return fixnum(ios_ungetc((int)wc,s));
+    argcount("io.skip", nargs, 2);
+    ios_t *s = toiostream(args[0], "io.skip");
+    off_t off = tooffset(args[1], "io.skip");
+    off_t res = ios_skip(s, off);
+    if (res < 0)
+        return FL_F;
+    return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
 }
 
 value_t fl_ioflush(value_t *args, uint32_t nargs)
@@ -419,7 +417,7 @@
     { "io.seek" , fl_ioseek },
     { "io.pos",   fl_iopos },
     { "io.getc" , fl_iogetc },
-    { "io.ungetc", fl_ioungetc },
+    { "io.skip", fl_ioskip },
     { "io.putc" , fl_ioputc },
     { "io.peekc" , fl_iopeekc },
     { "io.discardbuffer", fl_iopurge },
--- a/llt/ios.c
+++ b/llt/ios.c
@@ -744,10 +744,10 @@
     return s;
 }
 
-ios_t *ios_static_buffer(ios_t *s, char *buf, size_t sz)
+ios_t *ios_static_buffer(ios_t *s, const char *buf, size_t sz)
 {
     ios_mem(s, 0);
-    ios_setbuf(s, buf, sz, 0);
+    ios_setbuf(s, (char*)buf, sz, 0);
     s->size = sz;
     ios_set_readonly(s);
     return s;
@@ -828,9 +828,12 @@
 {
     if (s->state == bst_wr)
         return IOS_EOF;
+    if (c == '\n')
+        s->lineno--;
     if (s->bpos > 0) {
         s->bpos--;
-        s->buf[s->bpos] = (char)c;
+        if (s->buf[s->bpos] != (char)c)
+            s->buf[s->bpos] = (char)c;
         s->_eof = 0;
         return c;
     }
@@ -852,20 +855,23 @@
     char c0;
     char buf[8];
 
-    c = ios_getc(s);
-    if (c == IOS_EOF)
+    c = ios_peekc(s);
+    if (c == IOS_EOF) {
+        s->_eof = 1;
         return IOS_EOF;
+    }
     c0 = (char)c;
     if ((uint8_t)c0 < 0x80) {
+        ios_getc(s);
         *pwc = (uint32_t)(uint8_t)c0;
         return 1;
     }
     sz = u8_seqlen(&c0)-1;
-    if (ios_ungetc(c, s) == IOS_EOF)
+    if (ios_readprep(s, sz) < sz) {
+        // NOTE: this returns EOF even though some bytes are available
+        // so we do not set s->_eof on this code path
         return IOS_EOF;
-    if (ios_readprep(s, sz) < sz)
-        // NOTE: this can return EOF even if some bytes are available
-        return IOS_EOF;
+    }
     size_t i = s->bpos;
     *pwc = u8_nextchar(s->buf, &i);
     ios_read(s, buf, sz+1);
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -81,7 +81,7 @@
 ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int create, int trunc);
 ios_t *ios_mem(ios_t *s, size_t initsize);
 ios_t *ios_str(ios_t *s, char *str);
-ios_t *ios_static_buffer(ios_t *s, char *buf, size_t sz);
+ios_t *ios_static_buffer(ios_t *s, const char *buf, size_t sz);
 ios_t *ios_fd(ios_t *s, long fd, int isfile, int own);
 // todo: ios_socket
 extern ios_t *ios_stdin;
--- a/read.c
+++ b/read.c
@@ -188,16 +188,17 @@
 // return: 1 if escaped (forced to be symbol)
 static int read_token(char c, int digits)
 {
-    int i=0, ch, escaped=0, issym=0, first=1;
+    int i=0, ch, escaped=0, issym=0, nc=0;
 
     while (1) {
-        if (!first) {
-            ch = ios_getc(F);
+        if (nc != 0) {
+            if (nc != 1)
+                ios_getc(F);
+            ch = ios_peekc(F);
             if (ch == IOS_EOF)
                 goto terminate;
             c = (char)ch;
         }
-        first = 0;
         if (c == '|') {
             issym = 1;
             escaped = !escaped;
@@ -204,7 +205,8 @@
         }
         else if (c == '\\') {
             issym = 1;
-            ch = ios_getc(F);
+            ios_getc(F);
+            ch = ios_peekc(F);
             if (ch == IOS_EOF)
                 goto terminate;
             accumchar((char)ch, &i);
@@ -215,8 +217,10 @@
         else {
             accumchar(c, &i);
         }
+        nc++;
     }
-    ios_ungetc(c, F);
+    if (nc == 0)
+        ios_skip(F, -1);
  terminate:
     buf[i++] = '\0';
     return issym;
@@ -400,7 +404,7 @@
     }
     else if (c == ',') {
         toktype = TOK_COMMA;
-        ch = ios_getc(F);
+        ch = ios_peekc(F);
         if (ch == IOS_EOF)
             return toktype;
         if ((char)ch == '@')
@@ -408,7 +412,8 @@
         else if ((char)ch == '.')
             toktype = TOK_COMMADOT;
         else
-            ios_ungetc((char)ch, F);
+            return toktype;
+        ios_getc(F);
     }
     else if (c == '{' || c == '}') {
         lerrorf(ParseError, "invalid character %c", c);
@@ -511,13 +516,15 @@
                 free(buf);
                 lerrorf(ParseError, "read: end of input in escape sequence");
             }
-            j=0;
+            j = 0;
             if (octal_digit(c)) {
-                do {
+                while (1) {
                     eseq[j++] = c;
-                    c = ios_getc(F);
-                } while (octal_digit(c) && j<3 && (c!=IOS_EOF));
-                if (c!=IOS_EOF) ios_ungetc(c, F);
+                    c = ios_peekc(F);
+                    if (c == IOS_EOF || !octal_digit(c) || j >= 3)
+                        break;
+                    ios_getc(F);
+                }
                 eseq[j] = '\0';
                 wc = strtol(eseq, nil, 8);
                 // \DDD and \xXX read bytes, not characters
@@ -526,12 +533,13 @@
             else if ((c=='x' && (ndig=2)) ||
                      (c=='u' && (ndig=4)) ||
                      (c=='U' && (ndig=8))) {
-                c = ios_getc(F);
-                while (hex_digit(c) && j<ndig && (c!=IOS_EOF)) {
+                while (1) {
+                    c = ios_peekc(F);
+                    if (c == IOS_EOF || !hex_digit(c) || j >= ndig)
+                        break;
                     eseq[j++] = c;
-                    c = ios_getc(F);
+                    ios_getc(F);
                 }
-                if (c!=IOS_EOF) ios_ungetc(c, F);
                 eseq[j] = '\0';
                 if (j) wc = strtol(eseq, nil, 16);
                 if (!j || wc > 0x10ffff) {