ref: d33305eb8ba0cd5cc806c36881d62514d88f890c
parent: 07b1360acf3d14f651113f9b7113f74fd56c21f5
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Apr 9 14:55:23 EDT 2025
better error reporting, read-stage location for all errors; sl_ios → ios
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -320,10 +320,10 @@
list->vec #fn("n1700}2:" #(vec) list->vec) list-head #fn("n2E1L2;3?040<700=1K~52P:" #(list-head) list-head) list-ref #fn("n2700152<:" #(list-tail) list-ref) list-tail #fn("n2701E523400:710=1K~62:" #(<= list-tail) list-tail) list?- #fn("n10S;J@040B;3904700=61:" #(list?) list?) load #fn("n120021522285>123850>2{:" #(#fn(file)+ #fn("n10S;J@040B;3904700=61:" #(list?) list?) load #fn("n120021522285>12385>1{:" #(#fn(file) :read #fn("n0Ib48420A84>2_484<^1III63:" #(#fn("n320A51JG0F<21A510721514735063:24A514737215161:" #(#fn(io-eof?)- #fn(read) load-process void #fn(io-close))))) #fn("n120A5142122F0e361:" #(#fn(io-close)- #fn(raise) load-error))) load)
+ #fn(read) load-process void #fn(io-close))))) #fn("n120A51421220e261:" #(#fn(io-close)+ #fn(raise) load-error))) load)
load-process #fn("n170061:" #(eval) load-process) lookup-sym #fn("n31J5020:1<2108752883808288P:7201=82KM63:" #(global #fn(assq) lookup-sym) lookup-sym) lower-define #fn("n1I2021?55140H;J804720513400:0<23C<0747505161:0<26CK02726e10Te185051e17805164:2974062:" #(#1#@@ -384,10 +384,13 @@
#fn("n02071A62:" #(#fn(for-each) write)) #fn("n1A50420061:" #(#fn(raise)))) princ) print #fn("z02071062:" #(#fn(for-each) write) print) print-exception- #fn("n10B3e00<20C^0710r3523T072230T2425760515127554787605151@\x0e00B3Z00<29CS0710r3523I0722:760512;534780T51@\xe100B3P00<2<CI0710r2523?0722=0T2>53@\xbe00B3I00<2?CB0722@514720=f2@\xa200B3N00<2ACG07B76051514722C0T52@\x8107D0513m0710r2523c0780<51472275140T2E8551;J60485R37072@40788551^1@>0722F514780514727G61:" #(type-error- length= princ "type error: expected " ", got " #fn(typeof) caddr ": " print bounds-error "index "
- " out of bounds for " unbound-error "eval: variable " " has no value" error "error: " load-error
- print-exception "in file " list? #fn(str?) "*** Unhandled exception: " *linefeed*) print-exception)
+ #fn("n170051;3N04700<51;3C04217205151;35040<853700=@30086;3?0486<R;360486<87;360486=853O0732485<512585T257685512756@30q48728CQ0732988<2:2;88T51275547<88T51@61872=CH0732>88T2?5347<88<51@\x190872@C@0732A88<2B53@\x040872CCB0732D5147388f2@\xed0872EC?07F88<514I:@\xd90872GCB0732H5147388f2@\xc20872ICB0732J5147388f2@\xab0872KC>0732L88<52@\x980872MCR0732N88<513702O@402P5147<88<51@q0872QCB0732R5147388f2@Z0872SQ;J804872TQ3;07388f2@?0732U5147<865147V60:" #(list?+ #fn(io?) caar princ #fn(io-filename) ":" caddr ": " type-error "type error: expected " ", got "
+ #fn(typeof) print bounds-error "index " " out of bounds for " unbound-error "eval: variable " " has no value"
+ error "error: " load-error print-exception parse-error "parsing error: " arg-error "arguments error: "
+ key-error "key not found: " const-error #fn(keyword?)
+ "keywords are read-only: " "tried to modify a constant: " io-error "I/O error: " divide-error
+ memory-error "*** Unhandled exception: " newline) print-exception)
print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_5147374252627505252Eb82829868788>37:05162:" #(#0# #fn("n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(fn-name)#fn(fn-code)
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -612,8 +612,8 @@
}
if(iscvalue(v)){sl_cv *pcv = ptr(v);
- sl_ios *x;
- if(isio(v) && (x = value2c(sl_ios*, v))->bm == bm_mem){+ ios *x;
+ if(isio(v) && (x = value2c(ios*, v))->bm == bm_mem){*pdata = x->buf;
*psz = x->size;
return;
--- a/src/io.c
+++ b/src/io.c
@@ -11,13 +11,13 @@
sl_type *sl_iotype;
static void
-print_io(sl_v v, sl_ios *f)
+print_io(sl_v v, ios *f)
{- sl_ios *s = value2c(sl_ios*, v);
+ ios *s = value2c(ios*, v);
sl_print_str(f, "#<io");
- if(*s->loc.filename){+ if(*s->filename){sl_print_chr(f, ' ');
- sl_print_str(f, s->loc.filename);
+ sl_print_str(f, s->filename);
}
sl_print_chr(f, '>');
}
@@ -25,7 +25,7 @@
static void
free_io(sl_v self)
{- sl_ios *s = value2c(sl_ios*, self);
+ ios *s = value2c(ios*, self);
ios_close(s);
ios_free(s);
}
@@ -33,8 +33,8 @@
static void
relocate_io(sl_v oldv, sl_v newv)
{- sl_ios *olds = value2c(sl_ios*, oldv);
- sl_ios *news = value2c(sl_ios*, newv);
+ ios *olds = value2c(ios*, oldv);
+ ios *news = value2c(ios*, newv);
if(news->buf == &olds->local[0])
news->buf = &news->local[0];
}
@@ -67,12 +67,12 @@
}
sl_purefn
-sl_ios *
+ios *
toio(sl_v v)
{if(sl_unlikely(!isio(v)))
cthrow(type_error("io", v), v);- return value2c(sl_ios*, v);
+ return value2c(ios*, v);
}
BUILTIN("file", file)@@ -94,9 +94,9 @@
}
if(!r && !w && !c && !t && !a)
r = true; // default to reading
- sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
+ sl_v f = cvalue(sl_iotype, sizeof(ios));
char *fname = tostr(args[0]);
- sl_ios *s = value2c(sl_ios*, f);
+ ios *s = value2c(ios*, f);
if(ios_file(s, fname, r, w, c, t) == nil)
bthrow(lerrorf(sl_errio, "could not open \"%s\"", fname));
if(a)
@@ -108,7 +108,7 @@
{if(nargs < 1 || nargs > 2)
argcount(nargs, 1);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
if(nargs == 1){ switch(s->bm){case bm_none: return sl_nonesym;
@@ -137,8 +137,8 @@
{argcount(nargs, 0);
USED(args);
- sl_v f = cvalue(sl_iotype, sizeof(sl_ios));
- sl_ios *s = value2c(sl_ios*, f);
+ sl_v f = cvalue(sl_iotype, sizeof(ios));
+ ios *s = value2c(ios*, f);
if(ios_mem(s, 0) == nil)
bthrow(lerrorf(sl_errmem, "could not allocate in-memory io"));
return f;
@@ -167,7 +167,7 @@
BUILTIN("io-peekrune", io_peekrune) {argcount(nargs, 1);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
Rune r;
int res;
if((res = ios_peekrune(s, &r)) == IOS_EOF)
@@ -181,7 +181,7 @@
BUILTIN("io-getrune", io_getrune) {argcount(nargs, 1);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
Rune r;
int res;
if((res = ios_getrune(s, &r)) == IOS_EOF)
@@ -195,7 +195,7 @@
BUILTIN("io-putrune", io_putrune) {argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
if(!isrune(args[1]))
bthrow(type_error("rune", args[1]));return fixnum(ios_putrune(s, torune(args[1])));
@@ -204,7 +204,7 @@
BUILTIN("io-skip", io_skip) {argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
soffset off = tooffset(args[1]);
soffset res = ios_skip(s, off);
if(res < 0)
@@ -228,7 +228,7 @@
BUILTIN("io-truncate", io_truncate) {argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
if(ios_trunc(s, tooffset(args[1])) < 0)
bthrow(lerrorf(sl_errio, "truncation failed"));
return sl_void;
@@ -251,7 +251,7 @@
BUILTIN("io-seek", io_seek) {argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
usize pos = tosize(args[1]);
soffset res = ios_seek(s, (soffset)pos);
if(res < 0)
@@ -262,7 +262,7 @@
BUILTIN("io-pos", io_pos) {argcount(nargs, 1);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
soffset res = ios_pos(s);
if(res < 0)
return sl_nil;
@@ -273,7 +273,7 @@
{if(nargs < 1 || nargs > 2)
argcount(nargs, 1);
- sl_ios *s;
+ ios *s;
s = nargs == 2 ? toio(args[1]) : toio(sym_value(sl_iooutsym));
sl_print(s, args[0]);
return args[0];
@@ -283,7 +283,7 @@
{if(nargs != 3)
argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
usize n;
sl_type *ft;
if(nargs == 3){@@ -321,7 +321,7 @@
{if(nargs < 2 || nargs > 4)
argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
sl_v v = args[1];
if(isrune(v)){if(nargs > 2)
@@ -358,11 +358,11 @@
sl_v str = cvalue_str(80);
sl_cv *cv = ptr(str);
u8int *data = cv_data(cv);
- sl_ios dest;
+ ios dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, data, 80, 0);
u8int delim = get_delim_arg(args[1]);
- sl_ios *src = toio(args[0]);
+ ios *src = toio(args[0]);
usize n = ios_copyuntil(&dest, src, delim);
cv->len = n;
if(dest.buf != data){@@ -382,8 +382,8 @@
BUILTIN("io-copyuntil", io_copyuntil) {argcount(nargs, 3);
- sl_ios *dest = toio(args[0]);
- sl_ios *src = toio(args[1]);
+ ios *dest = toio(args[0]);
+ ios *src = toio(args[1]);
u8int delim = get_delim_arg(args[2]);
return size_wrap(ios_copyuntil(dest, src, delim));
}
@@ -392,8 +392,8 @@
{if(nargs < 2 || nargs > 3)
argcount(nargs, 2);
- sl_ios *dest = toio(args[0]);
- sl_ios *src = toio(args[1]);
+ ios *dest = toio(args[0]);
+ ios *src = toio(args[1]);
if(nargs == 3)
return size_wrap(ios_copy(dest, src, tosize(args[2])));
return size_wrap(ios_copyall(dest, src));
@@ -402,16 +402,16 @@
BUILTIN("io-filename", io_filename) {argcount(nargs, 1);
- return str_from_cstr(toio(args[0])->loc.filename);
+ return str_from_cstr(toio(args[0])->filename);
}
BUILTIN("io-set-filename!", io_set_filename) {argcount(nargs, 2);
- sl_ios *s = toio(args[0]);
+ ios *s = toio(args[0]);
char *f = tostr(args[1]);
- MEM_FREE(s->loc.filename);
- s->loc.filename = MEM_STRDUP(f);
+ MEM_FREE(s->filename);
+ s->filename = MEM_STRDUP(f);
return args[1];
}
@@ -446,7 +446,7 @@
{sl_v str;
usize n;
- sl_ios *st = value2c(sl_ios*, *ps);
+ ios *st = value2c(ios*, *ps);
if(st->buf == &st->local[0]){n = st->size;
str = cvalue_str(n);
@@ -466,7 +466,7 @@
BUILTIN("io->str", io_tostr) {argcount(nargs, 1);
- sl_ios *src = toio(args[0]);
+ ios *src = toio(args[0]);
if(src->bm != bm_mem)
bthrow(lerrorf(sl_errarg, "requires in-memory io"));
bool eof = ios_eof(src);
@@ -479,7 +479,7 @@
void
io_init(void)
{- sl_iosym = mk_csym("io");+ iosym = mk_csym("io"); sl_rdsym = mk_csym(":read"); sl_wrsym = mk_csym(":write"); sl_apsym = mk_csym(":append");@@ -492,8 +492,8 @@
sl_whitespace = mk_csym(":whitespace"); sl_ioinsym = mk_csym("*io-in*"); sl_iooutsym = mk_csym("*io-out*");- sl_iotype = define_opaque_type(sl_iosym, sizeof(sl_ios), &io_vtable, nil);
- set(mk_csym("*stdout*"), cvalue_from_ref(sl_iotype, ios_stdout, sizeof(sl_ios)));- set(mk_csym("*stderr*"), cvalue_from_ref(sl_iotype, ios_stderr, sizeof(sl_ios)));- set(mk_csym("*stdin*"), cvalue_from_ref(sl_iotype, ios_stdin, sizeof(sl_ios)));+ sl_iotype = define_opaque_type(iosym, sizeof(ios), &io_vtable, nil);
+ set(mk_csym("*stdout*"), cvalue_from_ref(sl_iotype, ios_stdout, sizeof(ios)));+ set(mk_csym("*stderr*"), cvalue_from_ref(sl_iotype, ios_stderr, sizeof(ios)));+ set(mk_csym("*stdin*"), cvalue_from_ref(sl_iotype, ios_stdin, sizeof(ios)));}
--- a/src/io.h
+++ b/src/io.h
@@ -1,4 +1,4 @@
-sl_ios *toio(sl_v v);
+ios *toio(sl_v v);
bool isio(sl_v v) sl_purefn;
sl_v io_to_str(sl_v *ps);
void io_init(void);
--- a/src/ios.c
+++ b/src/ios.c
@@ -3,9 +3,9 @@
#define MOST_OF(x) ((x) - ((x)>>4))
-sl_ios *ios_stdin = nil;
-sl_ios *ios_stdout = nil;
-sl_ios *ios_stderr = nil;
+ios *ios_stdin = nil;
+ios *ios_stdout = nil;
+ios *ios_stderr = nil;
/* OS-level primitive wrappers */
@@ -125,7 +125,7 @@
/* internal utility functions */
static u8int *
-_buf_realloc(sl_ios *s, usize sz)
+_buf_realloc(ios *s, usize sz)
{u8int *temp;
@@ -165,7 +165,7 @@
// write a block of data into the buffer at the current position, resizing
// if necessary. returns # written.
static usize
-_write_grow(sl_ios *s, const void *data, usize n)
+_write_grow(ios *s, const void *data, usize n)
{usize amt;
usize newsize;
@@ -202,7 +202,7 @@
/* interface functions, low level */
static usize
-_ios_read(sl_ios *s, u8int *dest, usize n, bool all)
+_ios_read(ios *s, u8int *dest, usize n, bool all)
{usize tot = 0;
usize got, avail;
@@ -268,7 +268,7 @@
}
usize
-ios_read(sl_ios *s, void *dest, usize n)
+ios_read(ios *s, void *dest, usize n)
{return _ios_read(s, dest, n, 0);
}
@@ -275,7 +275,7 @@
// ensure at least n bytes are buffered if possible. returns # available.
static usize
-ios_readprep(sl_ios *s, usize n)
+ios_readprep(ios *s, usize n)
{ if(s->state == bst_wr && s->bm != bm_mem){ios_flush(s);
@@ -307,7 +307,7 @@
}
static void
-_write_update_pos(sl_ios *s)
+_write_update_pos(ios *s)
{if(s->bpos > s->ndirty)
s->ndirty = s->bpos;
@@ -316,7 +316,7 @@
}
usize
-ios_write(sl_ios *s, const void *data, usize n)
+ios_write(ios *s, const void *data, usize n)
{if(s->readonly || s->state == bst_closed || n == 0)
return 0;
@@ -371,7 +371,7 @@
}
soffset
-ios_seek(sl_ios *s, soffset pos)
+ios_seek(ios *s, soffset pos)
{if(s->state == bst_closed)
return 0;
@@ -391,7 +391,7 @@
}
soffset
-ios_seek_end(sl_ios *s)
+ios_seek_end(ios *s)
{if(s->state == bst_closed)
return 0;
@@ -409,7 +409,7 @@
}
soffset
-ios_skip(sl_ios *s, soffset offs)
+ios_skip(ios *s, soffset offs)
{if(s->state == bst_closed)
return 0;
@@ -446,7 +446,7 @@
}
soffset
-ios_pos(sl_ios *s)
+ios_pos(ios *s)
{if(s->state == bst_closed)
return 0;
@@ -469,7 +469,7 @@
}
int
-ios_trunc(sl_ios *s, soffset size)
+ios_trunc(ios *s, soffset size)
{if(s->state == bst_closed || s->readonly || size < 0)
return -1;
@@ -488,7 +488,7 @@
}
bool
-ios_eof(sl_ios *s)
+ios_eof(ios *s)
{if(s->state == bst_closed)
return true;
@@ -498,7 +498,7 @@
}
int
-ios_flush(sl_ios *s)
+ios_flush(ios *s)
{if(s->ndirty == 0 || s->bm == bm_mem || s->buf == nil)
return 0;
@@ -545,7 +545,7 @@
}
void
-ios_close(sl_ios *s)
+ios_close(ios *s)
{if(s->state == bst_closed)
return;
@@ -561,14 +561,14 @@
}
void
-ios_free(sl_ios *s)
+ios_free(ios *s)
{- MEM_FREE(s->loc.filename);
- s->loc.filename = nil;
+ MEM_FREE(s->filename);
+ s->filename = nil;
}
static void
-_buf_init(sl_ios *s, ios_bm bm)
+_buf_init(ios *s, ios_bm bm)
{s->bm = bm;
if(s->bm == bm_mem || s->bm == bm_none){@@ -582,7 +582,7 @@
}
u8int *
-ios_takebuf(sl_ios *s, usize *psize)
+ios_takebuf(ios *s, usize *psize)
{u8int *buf;
@@ -611,7 +611,7 @@
}
int
-ios_setbuf(sl_ios *s, u8int *buf, usize size, bool own)
+ios_setbuf(ios *s, u8int *buf, usize size, bool own)
{ios_flush(s);
usize nvalid = size < s->size ? size : s->size;
@@ -632,7 +632,7 @@
}
int
-ios_bufmode(sl_ios *s, ios_bm mode)
+ios_bufmode(ios *s, ios_bm mode)
{// no fd; can only do mem-only buffering
if(s->fd == -1 && mode != bm_mem)
@@ -642,7 +642,7 @@
}
void
-ios_set_readonly(sl_ios *s)
+ios_set_readonly(ios *s)
{if(s->readonly)
return;
@@ -652,7 +652,7 @@
}
static usize
-ios_copy_(sl_ios *to, sl_ios *from, usize nbytes, bool all)
+ios_copy_(ios *to, ios *from, usize nbytes, bool all)
{// FIXME(sigrid): ios doesn't really care about errors
// this needs a big fix everywhere
@@ -686,13 +686,13 @@
}
usize
-ios_copy(sl_ios *to, sl_ios *from, usize nbytes)
+ios_copy(ios *to, ios *from, usize nbytes)
{return ios_copy_(to, from, nbytes, 0);
}
usize
-ios_copyall(sl_ios *to, sl_ios *from)
+ios_copyall(ios *to, ios *from)
{return ios_copy_(to, from, 0, true);
}
@@ -700,7 +700,7 @@
#define LINE_CHUNK_SIZE 160
usize
-ios_copyuntil(sl_ios *to, sl_ios *from, u8int delim)
+ios_copyuntil(ios *to, ios *from, u8int delim)
{usize total = 0, avail = from->size - from->bpos;
bool first = true;
@@ -731,7 +731,7 @@
}
static void
-_ios_init(sl_ios *s)
+_ios_init(ios *s)
{// put all fields in a sane initial state
memset(s, 0, sizeof(*s));
@@ -745,8 +745,8 @@
/* io object initializers. we do no allocation. */
-sl_ios *
-ios_file(sl_ios *s, char *fname, bool rd, bool wr, bool creat, bool trunc)
+ios *
+ios_file(ios *s, char *fname, bool rd, bool wr, bool creat, bool trunc)
{int fd;
if(!(rd || wr)) // must specify read and/or write
@@ -774,18 +774,18 @@
return nil;
}
-sl_ios *
-ios_mem(sl_ios *s, usize initsize)
+ios *
+ios_mem(ios *s, usize initsize)
{_ios_init(s);
s->bm = bm_mem;
- s->loc.filename = MEM_STRDUP("");+ s->filename = MEM_STRDUP("");_buf_realloc(s, initsize);
return s;
}
-sl_ios *
-ios_static_buffer(sl_ios *s, const u8int *buf, usize sz)
+ios *
+ios_static_buffer(ios *s, const u8int *buf, usize sz)
{ios_mem(s, 0);
ios_setbuf(s, (u8int*)buf, sz, 0);
@@ -794,8 +794,8 @@
return s;
}
-sl_ios *
-ios_fd(sl_ios *s, int fd, const char *name, bool isfile, bool own)
+ios *
+ios_fd(ios *s, int fd, const char *name, bool isfile, bool own)
{_ios_init(s);
s->fd = fd;
@@ -803,7 +803,7 @@
s->rereadable = true;
_buf_init(s, bm_block);
s->ownfd = own;
- s->loc.filename = MEM_STRDUP(name);
+ s->filename = MEM_STRDUP(name);
return s;
}
@@ -810,14 +810,14 @@
void
ios_init_std(void)
{- ios_stdin = MEM_ALLOC(sizeof(sl_ios));
+ ios_stdin = MEM_ALLOC(sizeof(ios));
ios_fd(ios_stdin, STDIN_FILENO, "*stdin*", false, false);
- ios_stdout = MEM_ALLOC(sizeof(sl_ios));
+ ios_stdout = MEM_ALLOC(sizeof(ios));
ios_fd(ios_stdout, STDOUT_FILENO, "*stdout*", false, false);
ios_stdout->bm = bm_line;
- ios_stderr = MEM_ALLOC(sizeof(sl_ios));
+ ios_stderr = MEM_ALLOC(sizeof(ios));
ios_fd(ios_stderr, STDERR_FILENO, "*stderr*", false, false);
ios_stderr->bm = bm_none;
}
@@ -825,7 +825,7 @@
/* higher level interface */
int
-ios_putc(sl_ios *s, int c)
+ios_putc(ios *s, int c)
{char ch = c;
@@ -840,7 +840,7 @@
}
static void
-ios_loc(sl_ios *s, u8int ch)
+ios_move(ios *s, u8int ch)
{ if(ch == '\n'){s->loc.lineno++;
@@ -862,7 +862,7 @@
}
int
-ios_getc(sl_ios *s)
+ios_getc(ios *s)
{u8int ch;
if(s->state == bst_rd && s->bpos < s->size)
@@ -869,12 +869,12 @@
ch = s->buf[s->bpos++];
else if(s->_eof || ios_read(s, &ch, 1) < 1)
return IOS_EOF;
- ios_loc(s, ch);
+ ios_move(s, ch);
return ch;
}
int
-ios_peekc(sl_ios *s)
+ios_peekc(ios *s)
{if(s->bpos < s->size)
return (u8int)s->buf[s->bpos];
@@ -887,7 +887,7 @@
}
int
-ios_peekrune(sl_ios *s, Rune *r)
+ios_peekrune(ios *s, Rune *r)
{int n = s->bpos+UTFmax <= s->size ? UTFmax : ios_readprep(s, UTFmax);
if(n < UTFmax && !fullrune((char*)s->buf + s->bpos, n))
@@ -903,7 +903,7 @@
}
int
-ios_getrune(sl_ios *s, Rune *r)
+ios_getrune(ios *s, Rune *r)
{int c;
usize i;
@@ -929,7 +929,7 @@
}
int
-ios_putrune(sl_ios *s, Rune r)
+ios_putrune(ios *s, Rune r)
{char buf[UTFmax];
return ios_write(s, buf, runetochar(buf, &r));
@@ -936,16 +936,16 @@
}
void
-ios_purge(sl_ios *s)
+ios_purge(ios *s)
{ if(s->state == bst_rd){for(; s->bpos < s->size; s->bpos++)
- ios_loc(s, s->buf[s->bpos]);
+ ios_move(s, s->buf[s->bpos]);
}
}
int
-ios_vprintf(sl_ios *s, const char *format, va_list args)
+ios_vprintf(ios *s, const char *format, va_list args)
{char buf[256];
char *str;
@@ -976,7 +976,7 @@
}
int
-ios_printf(sl_ios *s, const char *format, ...)
+ios_printf(ios *s, const char *format, ...)
{va_list args;
int c;
--- a/src/ios.h
+++ b/src/ios.h
@@ -19,10 +19,9 @@
#define IOS_BUFSIZE 32768
typedef struct {- char *filename;
- u32int lineno;
- u32int colno;
-}sl_loc;
+ int lineno;
+ int colno;
+}ios_loc;
typedef struct {u8int *buf; // start of buffer
@@ -31,7 +30,8 @@
usize bpos; // current position in buffer
usize ndirty; // # bytes at &buf[0] that need to be written
soffset fpos; // cached file pos
- sl_loc loc;
+ char *filename;
+ ios_loc loc;
ios_bm bm;
int colnowait;
@@ -53,60 +53,60 @@
bool rereadable;
u8int local[IOS_INLSIZE];
-}sl_ios;
+}ios;
void *llt_memrchr(const void *s, int c, usize n) sl_purefn;
/* low-level interface functions */
-usize ios_read(sl_ios *s, void *dest, usize n);
-usize ios_write(sl_ios *s, const void *data, usize n);
-soffset ios_seek(sl_ios *s, soffset pos); // absolute seek
-soffset ios_seek_end(sl_ios *s);
-soffset ios_skip(sl_ios *s, soffset offs); // relative seek
-soffset ios_pos(sl_ios *s); // get current position
-int ios_trunc(sl_ios *s, soffset size);
-bool ios_eof(sl_ios *s) sl_purefn;
-int ios_flush(sl_ios *s);
-void ios_close(sl_ios *s);
-void ios_free(sl_ios *s);
-u8int *ios_takebuf(sl_ios *s, usize *psize); // null-terminate and release buffer to caller
+usize ios_read(ios *s, void *dest, usize n);
+usize ios_write(ios *s, const void *data, usize n);
+soffset ios_seek(ios *s, soffset pos); // absolute seek
+soffset ios_seek_end(ios *s);
+soffset ios_skip(ios *s, soffset offs); // relative seek
+soffset ios_pos(ios *s); // get current position
+int ios_trunc(ios *s, soffset size);
+bool ios_eof(ios *s) sl_purefn;
+int ios_flush(ios *s);
+void ios_close(ios *s);
+void ios_free(ios *s);
+u8int *ios_takebuf(ios *s, usize *psize); // null-terminate and release buffer to caller
// set buffer space to use
-int ios_setbuf(sl_ios *s, u8int *buf, usize size, bool own);
-int ios_bufmode(sl_ios *s, ios_bm mode);
-void ios_set_readonly(sl_ios *s);
-usize ios_copy(sl_ios *to, sl_ios *from, usize nbytes);
-usize ios_copyall(sl_ios *to, sl_ios *from);
-usize ios_copyuntil(sl_ios *to, sl_ios *from, u8int delim);
+int ios_setbuf(ios *s, u8int *buf, usize size, bool own);
+int ios_bufmode(ios *s, ios_bm mode);
+void ios_set_readonly(ios *s);
+usize ios_copy(ios *to, ios *from, usize nbytes);
+usize ios_copyall(ios *to, ios *from);
+usize ios_copyuntil(ios *to, ios *from, u8int delim);
/* io creation */
-sl_ios *ios_file(sl_ios *s, char *fname, bool rd, bool wr, bool create, bool trunc);
-sl_ios *ios_mem(sl_ios *s, usize initsize);
-sl_ios *ios_static_buffer(sl_ios *s, const u8int *buf, usize sz);
-sl_ios *ios_fd(sl_ios *s, int fd, const char *name, bool isfile, bool own);
+ios *ios_file(ios *s, char *fname, bool rd, bool wr, bool create, bool trunc);
+ios *ios_mem(ios *s, usize initsize);
+ios *ios_static_buffer(ios *s, const u8int *buf, usize sz);
+ios *ios_fd(ios *s, int fd, const char *name, bool isfile, bool own);
-extern sl_ios *ios_stdin;
-extern sl_ios *ios_stdout;
-extern sl_ios *ios_stderr;
+extern ios *ios_stdin;
+extern ios *ios_stdout;
+extern ios *ios_stderr;
void ios_init_std(void);
/* high-level functions - output */
-int ios_putrune(sl_ios *s, Rune r);
-int ios_printf(sl_ios *s, const char *format, ...) sl_printfmt(2, 3);
-int ios_vprintf(sl_ios *s, const char *format, va_list args) sl_printfmt(2, 0);
+int ios_putrune(ios *s, Rune r);
+int ios_printf(ios *s, const char *format, ...) sl_printfmt(2, 3);
+int ios_vprintf(ios *s, const char *format, va_list args) sl_printfmt(2, 0);
/* high-level io functions - input */
-int ios_peekrune(sl_ios *s, Rune *r);
-int ios_getrune(sl_ios *s, Rune *r);
+int ios_peekrune(ios *s, Rune *r);
+int ios_getrune(ios *s, Rune *r);
// discard data buffered for reading
-void ios_purge(sl_ios *s);
+void ios_purge(ios *s);
/* stdio-style functions */
#define IOS_EOF (-1)
-int ios_putc(sl_ios *s, int c);
-int ios_getc(sl_ios *s);
-int ios_peekc(sl_ios *s);
+int ios_putc(ios *s, int c);
+int ios_getc(ios *s);
+int ios_peekc(ios *s);
#define ios_puts(s, str) ios_write(s, str, strlen(str))
/*
--- a/src/plan9/lsd.c
+++ b/src/plan9/lsd.c
@@ -9,7 +9,7 @@
static sl_v lsd_gpregsym, lsd_fpregsym, lsd_regsym, lsd_symsym, lsd_framesym;
static Map* coremap;
static Fhdr fhdr;
-static sl_ios *proc_stdin;
+static ios *proc_stdin;
void
lsd_init(void)
@@ -161,7 +161,7 @@
for(i = 0; i < coremap->nsegs; i++)
if(coremap->seg[i].inuse && coremap->seg[i].fd >= 0)
close(coremap->seg[i].fd);
- free(coremap);
+ MEM_FREE(coremap);
coremap = nil;
}
@@ -343,8 +343,8 @@
pid = newproc(argv, &p);
if(proc_stdin != nil){- free(proc_stdin->loc.filename);
- free(proc_stdin);
+ MEM_FREE(proc_stdin->filename);
+ MEM_FREE(proc_stdin);
}
proc_stdin = MEM_ALLOC(sizeof(*proc_stdin));
ios_fd(proc_stdin, p, "proc-stdin", false, false);
--- a/src/print.c
+++ b/src/print.c
@@ -8,7 +8,7 @@
#define LOG2_10 3.321928094887362347870319429489
static inline void
-outc(sl_ios *f, char c)
+outc(ios *f, char c)
{if(ios_putc(f, c) != 1)
lerrorf(sl_errio, "write failed");
@@ -19,7 +19,7 @@
}
static inline void
-outsn(sl_ios *f, const char *s, usize n)
+outsn(ios *f, const char *s, usize n)
{if(ios_write(f, s, n) != n)
lerrorf(sl_errio, "write failed");
@@ -33,7 +33,7 @@
}
static inline void
-outs(sl_ios *f, const char *s)
+outs(ios *f, const char *s)
{outsn(f, s, strlen(s));
}
@@ -44,7 +44,7 @@
}while(0)
static int
-outindent(sl_ios *f, int n)
+outindent(ios *f, int n)
{// move back to left margin if we get too indented
if(n > sl.scr_width-12)
@@ -65,13 +65,13 @@
}
void
-sl_print_chr(sl_ios *f, char c)
+sl_print_chr(ios *f, char c)
{outc(f, c);
}
void
-sl_print_str(sl_ios *f, const char *s)
+sl_print_str(ios *f, const char *s)
{outs(f, s);
}
@@ -123,7 +123,7 @@
}
static void
-print_sym_name(sl_ios *f, const char *name)
+print_sym_name(ios *f, const char *name)
{int i;
bool escape = false, charescape = false;
@@ -289,7 +289,7 @@
}
static void
-print_cons(sl_ios *f, sl_v v)
+print_cons(ios *f, sl_v v)
{sl_v cd;
const char *op;
@@ -383,12 +383,12 @@
}
}
-static void unboxed_print(sl_ios *f, sl_v v);
-static void cvalue_print(sl_ios *f, sl_v v);
-static void rune_print(sl_ios *f, Rune r);
+static void unboxed_print(ios *f, sl_v v);
+static void cvalue_print(ios *f, sl_v v);
+static void rune_print(ios *f, Rune r);
static bool
-print_circle_prefix(sl_ios *f, sl_v v)
+print_circle_prefix(ios *f, sl_v v)
{sl_v label;
if((label = (sl_v)ptrhash_get(&sl.printconses, (void*)v)) != (sl_v)HT_NOTFOUND){@@ -410,7 +410,7 @@
}
void
-sl_print_child(sl_ios *f, sl_v v)
+sl_print_child(ios *f, sl_v v)
{const char *name;
if(sl.print_level >= 0 && sl.p_level >= sl.print_level && (iscons(v) || isvec(v) || isfn(v))){@@ -527,7 +527,7 @@
}
static void
-print_str(sl_ios *f, const char *str, usize sz)
+print_str(ios *f, const char *str, usize sz)
{char buf[64];
u8int c;
@@ -655,7 +655,7 @@
}
static void
-rune_print(sl_ios *f, Rune r)
+rune_print(ios *f, Rune r)
{char seq[UTFmax+1];
int n, nb = runetochar(seq, &r);
@@ -698,7 +698,7 @@
// printing in a context where a type is already implied, e.g. inside
// an array.
static void
-cvalue_printdata(sl_ios *f, void *data, usize len, sl_v type, bool weak)
+cvalue_printdata(ios *f, void *data, usize len, sl_v type, bool weak)
{int n;
if(type == sl_utf8sym){@@ -855,7 +855,7 @@
}
static void
-unboxed_print(sl_ios *f, sl_v v)
+unboxed_print(ios *f, sl_v v)
{ if(isrune(v)){rune_print(f, torune(v));
@@ -870,7 +870,7 @@
}
static void
-cvalue_print(sl_ios *f, sl_v v)
+cvalue_print(ios *f, sl_v v)
{sl_cv *cv = ptr(v);
void *data = cvalue_data(v);
@@ -906,7 +906,7 @@
}
void
-sl_print(sl_ios *f, sl_v v)
+sl_print(ios *f, sl_v v)
{sl.print_pretty = sym_value(sl_printprettysym) != sl_nil;
if(sl.print_pretty)
--- a/src/print.h
+++ b/src/print.h
@@ -1,7 +1,7 @@
#pragma once
-void sl_print(sl_ios *f, sl_v v);
+void sl_print(ios *f, sl_v v);
void print_traverse(sl_v v);
-void sl_print_chr(sl_ios *f, char c);
-void sl_print_str(sl_ios *f, const char *s);
-void sl_print_child(sl_ios *f, sl_v v);
+void sl_print_chr(ios *f, char c);
+void sl_print_str(ios *f, const char *s);
+void sl_print_child(ios *f, sl_v v);
--- a/src/read.c
+++ b/src/read.c
@@ -17,7 +17,9 @@
struct Rctx {sl_v tokval;
- sl_loc loc;
+ sl_v *source;
+ ios_loc loc0;
+ ios_loc loc;
u32int toktype;
bool ws;
char buf[1024];
@@ -25,7 +27,7 @@
static sl_v do_read_sexpr(Rctx *ctx, sl_v label);
-#define RS value2c(sl_ios*, sl.readstate->source)
+#define RS value2c(ios*, sl.readstate->source)
bool
sl_read_numtok(const char *tok, sl_v *pval, int base)
@@ -95,7 +97,7 @@
nextchar(Rctx *ctx)
{int c;
- sl_ios *f = RS;
+ ios *f = RS;
do{c = ios_getc(RS);
@@ -122,21 +124,16 @@
}
static _Noreturn void sl_printfmt(2, 3)
-parse_error(sl_loc *loc, const char *format, ...)
+parse_error(Rctx *ctx, const char *format, ...)
{- char msgbuf[512];
+ char msgbuf[1024];
va_list args;
- int n;
- n = snprintf(msgbuf, sizeof(msgbuf), "%s:%"PRIu64":%"PRIu64": ",
- loc->filename, (u64int)loc->lineno, (u64int)loc->colno);
- if(n >= (int)sizeof(msgbuf))
- n = 0;
va_start(args, format);
- vsnprintf(msgbuf+n, sizeof(msgbuf)-n, format, args);
+ vsnprintf(msgbuf, sizeof(msgbuf), format, args);
sl_v msg = str_from_cstr(msgbuf);
va_end(args);
-
+ sl.readstate->errloc = ctx->loc;
sl_raise(mk_list2(sl_errparse, msg));
}
@@ -144,8 +141,10 @@
accumchar(Rctx *ctx, char c, int *pi)
{ctx->buf[(*pi)++] = c;
- if(*pi >= (int)(sizeof(ctx->buf)-1))
- parse_error(&ctx->loc, "token too long");
+ if(*pi >= (int)(sizeof(ctx->buf)-1)){+ ctx->buf[sizeof(ctx->buf)-64] = 0; // cut down to fit the whole message
+ parse_error(ctx, "token too long: %s…", ctx->buf);
+ }
}
// return: 1 if escaped (forced to be symbol)
@@ -182,7 +181,7 @@
nc++;
}
if(nc == 0)
- parse_error(&ctx->loc, "unexpected char: 0x%x", c);
+ parse_error(ctx, "unexpected char: 0x%x", c);
terminate:
ctx->buf[i++] = '\0';
return issym;
@@ -214,6 +213,7 @@
ctx->ws = false;
return TOK_NONE;
}
+ ctx->loc0 = RS->loc;
if(c == '(')ctx->toktype = TOK_OPEN;
else if(c == ')')
@@ -238,7 +238,7 @@
}else if(c == '#'){c = ch = ios_getc(RS);
if(ch == IOS_EOF)
- parse_error(&ctx->loc, "invalid read macro");
+ parse_error(ctx, "invalid read macro");
if(c == '.')
ctx->toktype = TOK_SHARPDOT;
else if(c == '\'')
@@ -246,12 +246,12 @@
else if(c == '\\'){Rune cval;
if(ios_getrune(RS, &cval) == IOS_EOF)
- parse_error(&ctx->loc, "end of input in character constant");
+ parse_error(ctx, "EOI in character constant");
if(cval == 'u' || cval == 'U' || cval == 'x'){read_token(ctx, 'u', 0);
if(ctx->buf[1] != '\0'){ // not a solitary 'u','U','x'if(!sl_read_numtok(&ctx->buf[1], &ctx->tokval, 16))
- parse_error(&ctx->loc, "invalid hex character constant");
+ parse_error(ctx, "invalid hex character constant: %s", &ctx->buf[1]);
cval = numval(ctx->tokval);
}
}else if(cval >= 'a' && cval <= 'z'){@@ -271,7 +271,7 @@
else if(ctx->tokval == sl_spacesym) cval = 0x20;
else if(ctx->tokval == sl_deletesym) cval = 0x7F;
else
- parse_error(&ctx->loc, "unknown character #\\%s", ctx->buf);
+ parse_error(ctx, "unknown character #\\%s", ctx->buf);
}
ctx->toktype = TOK_NUM;
ctx->tokval = mk_rune(cval);
@@ -278,7 +278,7 @@
}else if(c == '('){ctx->toktype = TOK_SHARPOPEN;
}else if(c == '<'){- parse_error(&ctx->loc, "unreadable object");
+ parse_error(ctx, "unreadable object");
}else if(isdigit(c)){read_token(ctx, c, 1);
c = ios_getc(RS);
@@ -287,10 +287,10 @@
else if(c == '=')
ctx->toktype = TOK_LABEL;
else
- parse_error(&ctx->loc, "invalid label");
+ parse_error(ctx, "invalid label: #%s%c", ctx->buf, c);
x = strtoll(ctx->buf, &end, 10);
if(*end != '\0')
- parse_error(&ctx->loc, "invalid label");
+ parse_error(ctx, "invalid label: #%s%c", ctx->buf, c);
ctx->tokval = fixnum(x);
}else if(c == '!'){// #! single line comment for shbang script support
@@ -305,7 +305,7 @@
ch = ios_getc(RS);
hashpipe_gotc:
if(ch == IOS_EOF)
- parse_error(&ctx->loc, "eof within comment");
+ parse_error(ctx, "eof within comment");
if(ch == '|'){ch = ios_getc(RS);
if(ch == '#'){@@ -337,7 +337,7 @@
read_token(ctx, ch, 0);
x = strtol(ctx->buf, &end, 10);
if(*end != '\0' || ctx->buf[0] == '\0')
- parse_error(&ctx->loc, "invalid gensym label");
+ parse_error(ctx, "invalid gensym label: #%s", ctx->buf);
ctx->toktype = TOK_GENSYM;
ctx->tokval = fixnum(x);
}else if(symchar(c)){@@ -348,7 +348,7 @@
(c == 'd' && (base = 10)) ||
(c == 'x' && (base = 16))) && (isdigit_base(ctx->buf[1], base) || ctx->buf[1] == '-')){if(!sl_read_numtok(&ctx->buf[1], &ctx->tokval, base))
- parse_error(&ctx->loc, "invalid base %d constant", base);
+ parse_error(ctx, "invalid base %d constant: %s", base, &ctx->buf[1]);
ctx->ws = false;
return (ctx->toktype = TOK_NUM);
}
@@ -356,7 +356,7 @@
ctx->toktype = TOK_SHARPSYM;
ctx->tokval = mk_sym(ctx->buf, true);
}else{- parse_error(&ctx->loc, "unknown read macro");
+ parse_error(ctx, "unknown read macro");
}
}else if(c == ','){ctx->toktype = TOK_COMMA;
@@ -433,7 +433,7 @@
ptrhash_put(&sl.readstate->backrefs, (void*)label, (void*)v);
while(peek(ctx) != closer){if(ios_eof(RS))
- parse_error(&ctx->loc, "unexpected end of input");
+ parse_error(ctx, "unexpected EOI");
v = sl.sp[-1]; // reload after possible alloc in peek()
if(i >= vec_size(v)){v = sl.sp[-1] = vec_grow(v, label != UNBOUND);
@@ -470,7 +470,7 @@
if(temp == nil){if(buf == ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "out of memory reading verbatim string");
+ parse_error(ctx, "out of memory reading verbatim string");
}
buf = temp;
}
@@ -478,7 +478,7 @@
if(c == IOS_EOF){if(buf != ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "unexpected end of input in verbatim string");
+ parse_error(ctx, "unexpected EOI in verbatim string");
}
if(c == 0xc2 && ios_peekc(RS) == 0xbb){ // »ios_getc(RS);
@@ -515,7 +515,7 @@
if(temp == nil){if(buf == ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "out of memory reading string");
+ parse_error(ctx, "out of memory reading string");
}
buf = temp;
}
@@ -523,7 +523,7 @@
if(c == IOS_EOF){if(buf != ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "unexpected end of input in string");
+ parse_error(ctx, "unexpected EOI in string");
}
if(c == '"')
break;
@@ -532,7 +532,7 @@
if(c == IOS_EOF){if(buf != ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "end of input in escape sequence");
+ parse_error(ctx, "EOI in escape sequence");
}
j = 0;
if(octal_digit(c)){@@ -561,7 +561,7 @@
if(!j || r > Runemax){if(buf != ctx->buf)
MEM_FREE(buf);
- parse_error(&ctx->loc, "invalid escape sequence");
+ parse_error(ctx, "invalid escape sequence");
}
if(ndig == 2)
buf[i++] = r;
@@ -574,14 +574,7 @@
if(esc == c && !strchr("\\'\"`", esc)){if(buf != ctx->buf)
MEM_FREE(buf);
- sl_loc *l = &RS->loc;
- parse_error(
- &ctx->loc,
- "invalid escape sequence \\%c "PAtLoc,
- c,
- l->lineno,
- l->colno
- );
+ parse_error(ctx, "invalid escape sequence: \\%c", c);
}
buf[i++] = esc;
}
@@ -604,7 +597,7 @@
{sl_v c, *pc, *pval, *ipval, *ipc;
u32int t;
- sl_loc loc0;
+ ios_loc loc0;
loc0 = RS->loc;
loc0.colno--;
@@ -613,8 +606,15 @@
ipc = sl.sp-1; // to keep track of current cons cell
t = peek(ctx);
while(t != closer){- if(ios_eof(RS))
- parse_error(&loc0, "not closed: unexpected EOI "PAtLoc, ctx->loc.lineno, ctx->loc.colno);
+ if(ios_eof(RS)){+ parse_error(
+ ctx,
+ "not closed: unexpected EOI: opened with '%c' "PAtLoc,
+ closer == TOK_CLOSE ? '(' : (closer == TOK_CLOSEB ? '[' : '{'),+ loc0.lineno,
+ loc0.colno
+ );
+ }
c = alloc_cons(); car_(c) = cdr_(c) = sl_nil;
pc = ipc;
if(iscons(*pc))
@@ -638,13 +638,15 @@
cdr_(*pc) = c;
t = peek(ctx);
if(ios_eof(RS))
- parse_error(&ctx->loc, "unexpected end of input");
+ parse_error(ctx, "unexpected EOI");
if(t != closer){take(ctx);
parse_error(
- &ctx->loc,
- "expected '%c'",
- closer == TOK_CLOSEB ? ']' : (closer == TOK_CLOSEC ? '}' : ')')
+ ctx,
+ "expected '%c': opened "PAtLoc,
+ closer == TOK_CLOSEB ? ']' : (closer == TOK_CLOSEC ? '}' : ')'),
+ loc0.lineno,
+ loc0.colno
);
}
}
@@ -658,8 +660,8 @@
static sl_v
do_read_sexpr(Rctx *ctx, sl_v label)
{- sl_v v, sym, oldtokval, *head;
- sl_v *pv;
+ sl_v v, sym, oldtokval, *head, *pv;
+ ios_loc loc0;
u32int t;
char c;
@@ -706,6 +708,7 @@
// StreetLISP doesn't need symbol-function, so #' does nothing
return do_read_sexpr(ctx, label);
case TOK_SHARPSYM:
+ loc0 = ctx->loc0;
sym = ctx->tokval;
// constructor notation
c = nextchar(ctx);
@@ -712,7 +715,7 @@
ctx->loc = RS->loc;
if(c != '(' && c != '[' && c != '{'){take(ctx);
- parse_error(&ctx->loc, "expected argument list for %s", sym_name(ctx->tokval));
+ parse_error(ctx, "expected argument list for %s", sym_name(ctx->tokval));
}
PUSH(sl_nil);
read_list(ctx, UNBOUND, c == '(' ? TOK_CLOSE : (c == '[' ? TOK_CLOSEB : TOK_CLOSEC));@@ -721,6 +724,7 @@
sl.sp[-1] = mk_cons(sl_u8sym, sl.sp[-1]);
}
v = sym_value(sym);
+ sl.readstate->errloc = loc0;
if(v == UNBOUND)
unbound_error(sym);
return sl_apply(v, POP());
@@ -732,11 +736,14 @@
// cannot see pending labels. in other words:
// (... #2=#.#0# ... ) OK
// (... #2=#.(#2#) ... ) DO NOT WANT
+ loc0 = ctx->loc;
sym = do_read_sexpr(ctx, UNBOUND);
if(issym(sym)){v = sym_value(sym);
- if(v == UNBOUND)
+ if(v == UNBOUND){+ sl.readstate->errloc = loc0;
unbound_error(sym);
+ }
return v;
}
return sl_toplevel_eval(sym);
@@ -743,7 +750,7 @@
case TOK_LABEL:
// create backreference label
if(ptrhash_has(&sl.readstate->backrefs, (void*)ctx->tokval))
- parse_error(&ctx->loc, "label %"PRIdPTR" redefined", (intptr)numval(ctx->tokval));
+ parse_error(ctx, "label %"PRIdPTR" redefined", (intptr)numval(ctx->tokval));
oldtokval = ctx->tokval;
v = do_read_sexpr(ctx, ctx->tokval);
ptrhash_put(&sl.readstate->backrefs, (void*)oldtokval, (void*)v);
@@ -752,7 +759,7 @@
// look up backreference
v = (sl_v)ptrhash_get(&sl.readstate->backrefs, (void*)ctx->tokval);
if(v == (sl_v)HT_NOTFOUND)
- parse_error(&ctx->loc, "undefined label %"PRIdPTR, (intptr)numval(ctx->tokval));
+ parse_error(ctx, "undefined label %"PRIdPTR, (intptr)numval(ctx->tokval));
return v;
case TOK_GENSYM:
pv = (sl_v*)ptrhash_bp(&sl.readstate->gensyms, (void*)ctx->tokval);
@@ -764,13 +771,13 @@
case TOK_VERBATIM:
return read_verbatim(ctx);
case TOK_CLOSE:
- parse_error(&ctx->loc, "unexpected ')'");
+ parse_error(ctx, "unexpected ')'");
case TOK_CLOSEB:
- parse_error(&ctx->loc, "unexpected ']'");
+ parse_error(ctx, "unexpected ']'");
case TOK_CLOSEC:
- parse_error(&ctx->loc, "unexpected '}'");
+ parse_error(ctx, "unexpected '}'");
case TOK_DOT:
- parse_error(&ctx->loc, "unexpected '.'");
+ parse_error(ctx, "unexpected '.'");
}
return sl_void;
}
@@ -785,6 +792,7 @@
state.source = f;
sl.readstate = &state;
Rctx ctx;
+ ctx.source = &state.source;
ctx.toktype = TOK_NONE;
ctx.ws = ws;
sl_gc_handle(&ctx.tokval);
--- a/src/sl.c
+++ b/src/sl.c
@@ -25,7 +25,7 @@
sl_v sl_printwidthsym, sl_printreadablysym, sl_printprettysym, sl_printlengthsym;
sl_v sl_printlevelsym;
sl_v sl_tablesym, sl_arrsym;
-sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
+sl_v iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
sl_v sl_s64sym, sl_u64sym, sl_ptrsym, sl_bignumsym;
sl_v sl_utf8sym, sl_runesym, sl_floatsym, sl_doublesym;
@@ -117,6 +117,12 @@
sl.curr_frame = _ctx->frame;
}
+static sl_v
+mk_loc(sl_v io, ios_loc *l)
+{+ return mk_listn(3, io, fixnum(l->lineno), fixnum(l->colno));
+}
+
_Noreturn void
sl_raise(sl_v e)
{@@ -123,6 +129,12 @@
ios_flush(ios_stdout);
ios_flush(ios_stderr);
+ if(sl.readstate != sl.exctx->rdst){+ sl_gc_handle(&e);
+ e = mk_cons(mk_loc(sl.readstate->source, &sl.readstate->errloc), e);
+ sl_free_gc_handles(1);
+ }
+
sl.lasterror = e;
// unwind read state
while(sl.readstate != sl.exctx->rdst){@@ -902,19 +914,20 @@
static sl_v
_stacktrace(sl_v *top)
{- sl_v lst = sl_nil;
+ sl_v lst = sl_nil, v = sl_nil;
sl_v *stack = sl.stack;
sl_gc_handle(&lst);
+ sl_gc_handle(&v);
while(top > stack){const u8int *ip1 = (void*)top[-1];
int sz = top[-2]+1;
sl_v *bp = top-4-sz;
sl_v fn = bp[0];
- sl_v v = alloc_vec(sz+1, 0);
- if(iscbuiltin(fn)){- vec_elt(v, 0) = lst == sl_nil ? mk_ptr(sl.cpc) : fn; mk_ptr((uintptr)ip1);
- }else{+ v = alloc_vec(sz+1, 0);
+ if(iscbuiltin(fn))
+ vec_elt(v, 0) = lst == sl_nil ? mk_ptr(sl.cpc) : fn;
+ else{/* -1: ip1 is *after* the one that was being executed */
intptr ip = ip1 - (const u8int*)cvalue_data(fn_bcode(fn)) - 1;
vec_elt(v, 0) = fixnum(ip);
@@ -929,7 +942,7 @@
lst = mk_cons(v, lst);
top = (sl_v*)top[-3];
}
- sl_free_gc_handles(1);
+ sl_free_gc_handles(2);
return lst;
}
@@ -1199,7 +1212,7 @@
{USED(args);
argcount(nargs, 0);
- sl_ios *io = toio(sym_value(sl_iooutsym));
+ ios *io = toio(sym_value(sl_iooutsym));
ios_printf(io, "heap total %10"PRIuPTR" bytes\n", slg.heapsize);
ios_printf(io, "heap free %10"PRIuPTR" bytes\n", (uintptr)(slg.lim-slg.curheap));
ios_printf(io, "heap used %10"PRIuPTR" bytes\n", (uintptr)(slg.curheap-slg.fromspace));
@@ -1363,7 +1376,7 @@
while(1){sl.sp = saveSP;
sl_v e = sl_read_sexpr(sl.sp[-1], false);
- if(ios_eof(value2c(sl_ios*, sl.sp[-1])))
+ if(ios_eof(value2c(ios*, sl.sp[-1])))
break;
if(isfn(e)){// stage 0 format: series of thunks
--- a/src/sl.h
+++ b/src/sl.h
@@ -250,6 +250,7 @@
sl_htable backrefs;
sl_htable gensyms;
sl_v source;
+ ios_loc errloc;
struct _sl_readstate *prev;
}sl_readstate;
@@ -300,7 +301,7 @@
}while(0)
typedef struct {- void (*print)(sl_v self, sl_ios *f);
+ void (*print)(sl_v self, ios *f);
void (*relocate)(sl_v oldv, sl_v newv);
void (*finalize)(sl_v self);
void (*print_traverse)(sl_v self);
@@ -444,7 +445,7 @@
extern sl_v sl_printwidthsym, sl_printreadablysym, sl_printprettysym, sl_printlengthsym;
extern sl_v sl_printlevelsym;
extern sl_v sl_arrsym;
-extern sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
+extern sl_v iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
extern sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
extern sl_v sl_s64sym, sl_u64sym, sl_ptrsym, sl_bignumsym;
extern sl_v sl_utf8sym, sl_runesym, sl_floatsym, sl_doublesym;
--- a/src/slmain.c
+++ b/src/slmain.c
@@ -116,7 +116,7 @@
boot = unpacked;
bootsz = n;
}
- static sl_ios s;
+ static ios s;
ios_static_buffer(&s, boot, bootsz);
const char *status = nil;
@@ -123,7 +123,7 @@
sl_v args = argv_list(argc, argv);
sl_gc_handle(&args);
SL_TRY_EXTERN{- sl_v f = cvalue_from_ref(sl_iotype, &s, sizeof(sl_ios));
+ sl_v f = cvalue_from_ref(sl_iotype, &s, sizeof(ios));
if(sl_load_system_image(f) == 0){MEM_FREE(unpacked);
ios_close(&s);
--- a/src/str.c
+++ b/src/str.c
@@ -73,7 +73,7 @@
return args[0];
sl_v arg, buf = fn_builtin_buffer(nil, 0);
sl_gc_handle(&buf);
- sl_ios *s = value2c(sl_ios*, buf);
+ ios *s = value2c(ios*, buf);
sl_v oldpr = sym_value(sl_printreadablysym);
sl_v oldpp = sym_value(sl_printprettysym);
set(sl_printreadablysym, sl_nil);
--- a/src/system.sl
+++ b/src/system.sl
@@ -1360,7 +1360,7 @@
(void (load-process E)))))
(λ (e)
(io-close F)
- (raise `(load-error ,filename ,e))))))
+ (raise `(load-error ,e))))))
(def (repl)
(*prompt*)
@@ -1428,47 +1428,62 @@
(reverse! st))))
(def (print-exception e)
- (cond ((and (cons? e)
- (eq? (car e) 'type-error)
- (length= e 3))
- (princ "type error: expected " (cadr e) ", got " (typeof (caddr e)) ": ")
- (print (caddr e)))
+ (let* {[loc (and (list? e)+ (list? (car e))
+ (io? (caar e))
+ (car e))]
+ [e (if loc (cdr e) e)]
+ [k (and e (sym? (car e)) (car e))]
+ [a (and k (cdr e))]}
+ (when loc
+ (princ (io-filename (car loc)) ":" (cadr loc) ":" (caddr loc) ": "))
+ (cond ((eq? k 'type-error)
+ (princ "type error: expected " (car a) ", got " (typeof (cadr a)) ": ")
+ (print (cadr a)))
- ((and (cons? e)
- (eq? (car e) 'bounds-error)
- (length= e 3))
- (princ "index " (caddr e) " out of bounds for ")
- (print (cadr e)))
+ ((eq? k 'bounds-error)
+ (princ "index " (cadr a) " out of bounds for ")
+ (print (car a)))
- ((and (cons? e)
- (eq? (car e) 'unbound-error)
- (length= e 2))
- (princ "eval: variable " (cadr e) " has no value"))
+ ((eq? k 'unbound-error)
+ (princ "eval: variable " (car a) " has no value"))
- ((and (cons? e)
- (eq? (car e) 'error))
- (princ "error: ")
- (apply princ (cdr e)))
+ ((eq? k 'error)
+ (princ "error: ")
+ (apply princ a))
- ((and (cons? e)
- (eq? (car e) 'load-error))
- (print-exception (caddr e))
- (princ "in file " (cadr e)))
+ ((eq? k 'load-error)
+ (print-exception (car a))
+ (return))
- ((and (list? e)
- (length= e 2))
- (print (car e))
- (princ ": ")
- (let ((msg (cadr e)))
- ((if (or (str? msg) (sym? msg))
- princ
- print)
- msg)))
+ ((eq? k 'parse-error)
+ (princ "parsing error: ")
+ (apply princ a))
- (else (princ "*** Unhandled exception: ")
- (print e)))
+ ((eq? k 'arg-error)
+ (princ "arguments error: ")
+ (apply princ a))
- (princ *linefeed*))
+ ((eq? k 'key-error)
+ (princ "key not found: " (car a)))
+
+ ((eq? k 'const-error)
+ (princ (if (keyword? (car a))
+ "keywords are read-only: "
+ "tried to modify a constant: "))
+ (print (car a)))
+
+ ((eq? k 'io-error)
+ (princ "I/O error: ")
+ (apply princ a))
+
+ ((or (eq? k 'divide-error)
+ (eq? k 'memory-error))
+ (apply princ a))
+
+ (else (princ "*** Unhandled exception: ")
+ (print e)))
+ (newline)))
(def (sort l cmp (:key identity))
(if (not (cdr l))
--- a/src/table.c
+++ b/src/table.c
@@ -10,7 +10,7 @@
static sl_type *sl_tabletype;
static void
-print_htable(sl_v v, sl_ios *f)
+print_htable(sl_v v, ios *f)
{sl_htable *h = cvalue_data(v);
int first = 1;
@@ -134,7 +134,7 @@
static void
key_error(sl_v key)
{- lerrorf(mk_list2(sl_errkey, key), "key not found");
+ sl_raise(mk_list2(sl_errkey, key));
}
// (get table key [default])