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) {