ref: 7ccaf862417a90af7a04750718c49a5731301fa4
parent: 928a5bb801e95e2c8d1c3153427c74ddf908649b
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Jan 27 14:21:09 EST 2025
reader: don't do OOB access on VM stack Fixes: https://todo.sr.ht/~ft/femtolisp/42
--- a/cvalues.c
+++ b/cvalues.c
@@ -119,7 +119,7 @@
add_finalizer(pcv);
}else{if(FL(malloc_pressure) > ALLOC_LIMIT_TRIGGER)
- gc(0);
+ fl_gc(0);
pcv = alloc_words(CVALUE_NWORDS);
pcv->type = type;
pcv->data = MEM_ALLOC(sz);
--- a/flisp.c
+++ b/flisp.c
@@ -69,7 +69,7 @@
fl_exit(int status)
{FL(exiting) = true;
- gc(0);
+ fl_gc(0);
exit(status);
}
@@ -294,7 +294,7 @@
cons_t *c;
if(fl_unlikely(FL(curheap) > FL(lim)))
- gc(0);
+ fl_gc(0);
c = (cons_t*)FL(curheap);
FL(curheap) += sizeof(cons_t);
return tagptr(c, TAG_CONS);
@@ -308,9 +308,9 @@
assert(n > 0);
n = ALIGNED(n, 2); // only allocate multiples of 2 words
if(fl_unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)+2-n)){- gc(0);
+ fl_gc(0);
while((value_t*)FL(curheap) > ((value_t*)FL(lim))+2-n)
- gc(1);
+ fl_gc(1);
}
first = (value_t*)FL(curheap);
FL(curheap) += n*sizeof(value_t);
@@ -457,7 +457,7 @@
}
void
-gc(int mustgrow)
+fl_gc(int mustgrow)
{void *temp;
uint32_t i, f, top;
@@ -541,12 +541,12 @@
// all data was live; gc again and grow heap.
// but also always leave at least 4 words available, so a closure
// can be allocated without an extra check.
- gc(0);
+ fl_gc(0);
}
}
-static void
-grow_stack(void)
+void
+fl_grow_stack(void)
{size_t newsz = FL(nstack) * 2;
value_t *ns = MEM_REALLOC(FL(stack), newsz*sizeof(value_t));
@@ -591,9 +591,7 @@
PUSH(f);
while(iscons(v)){- if(FL(sp) >= FL(nstack))
- grow_stack();
- PUSH(car_(v));
+ PUSHSAFE(car_(v));
v = cdr_(v);
}
if(v != FL_nil)
@@ -613,7 +611,7 @@
PUSH(f);
while(FL(sp)+n >= FL(nstack))
- grow_stack();
+ fl_grow_stack();
for(i = 0; i < n; i++){value_t a = va_arg(ap, value_t);
PUSH(a);
@@ -633,7 +631,7 @@
size_t i;
while(FL(sp)+n >= FL(nstack))
- grow_stack();
+ fl_grow_stack();
for(i = 0; i < n; i++){value_t a = va_arg(ap, value_t);
PUSH(a);
@@ -901,7 +899,7 @@
assert(!ismanaged((uintptr_t)ip));
i = FL(sp)+GET_INT32(ip);
while(i >= FL(nstack))
- grow_stack();
+ fl_grow_stack();
ip += 4;
PUSH(fn_env(func));
@@ -1005,7 +1003,7 @@
{USED(args);
argcount(nargs, 0);
- gc(0);
+ fl_gc(0);
return FL_void;
}
@@ -1166,7 +1164,7 @@
intptr_t argSP = args-FL(stack);
assert(argSP >= 0 && argSP < (intptr_t)FL(nstack));
while(FL(sp)+2+1+nargs >= FL(nstack))
- grow_stack();
+ fl_grow_stack();
uint32_t k = FL(sp);
PUSH(FL_nil);
PUSH(FL_nil);
@@ -1201,7 +1199,7 @@
intptr_t argSP = args-FL(stack);
assert(argSP >= 0 && argSP < (intptr_t)FL(nstack));
if(FL(sp)+1+2*nargs >= FL(nstack))
- grow_stack();
+ fl_grow_stack();
for(size_t n = 0;; n++){PUSH(FL(stack)[argSP]);
uint32_t pargs = 0;
--- a/flisp.h
+++ b/flisp.h
@@ -168,6 +168,12 @@
do{ \FL(stack)[FL(sp)++] = (v); \
}while(0)
+#define PUSHSAFE(v) \
+ do{ \+ if(FL(sp) >= FL(nstack)) \
+ fl_grow_stack(); \
+ PUSH(v); \
+ }while(0)
#define POPN(n) \
do{ \FL(sp) -= (n); \
@@ -182,7 +188,8 @@
/* collector */
value_t relocate(value_t v) fl_hotfn;
-void gc(int mustgrow);
+void fl_gc(int mustgrow);
+void fl_grow_stack(void);
void fl_gc_handle(value_t *pv);
void fl_free_gc_handles(uint32_t n);
--- a/meson.build
+++ b/meson.build
@@ -361,6 +361,7 @@
tests_dir = join_paths(meson.current_source_dir(), 'test')
+test('100x100.lsp', flisp, args: ['100x100.lsp'], workdir: tests_dir) test('argv.lsp', flisp, args: ['argv.lsp'], workdir: tests_dir) test('bench.lsp', flisp, args: ['bench.lsp'], workdir: tests_dir) test('hashtest.lsp', flisp, args: ['hashtest.lsp'], workdir: tests_dir)--- a/read.c
+++ b/read.c
@@ -383,7 +383,7 @@
{size_t i, s = vector_size(v);
size_t d = vector_grow_amt(s);
- PUSH(v);
+ PUSHSAFE(v);
assert(s+d > s);
value_t newv = alloc_vector(s+d, 1);
v = FL(stack)[FL(sp)-1];
@@ -394,7 +394,7 @@
if(s > 0 && rewrite_refs){((size_t*)ptr(v))[0] |= 0x1;
vector_elt(v, 0) = newv;
- gc(0);
+ fl_gc(0);
}
return POP();
}
@@ -404,7 +404,7 @@
{value_t v = FL(the_empty_vector), elt;
uint32_t i = 0;
- PUSH(v);
+ PUSHSAFE(v);
if(label != UNBOUND)
ptrhash_put(&FL(readstate)->backrefs, (void*)label, (void*)v);
while(peek(ctx) != closer){@@ -536,36 +536,41 @@
// can move whenever a new cons is allocated. we have to refer to every cons
// through a handle to a relocatable pointer (i.e. a pointer on the stack).
static void
-read_list(Rctx *ctx, value_t *pval, value_t label, uint32_t closer)
+read_list(Rctx *ctx, value_t label, uint32_t closer)
{- value_t c, *pc;
- uint32_t t;
+ value_t c, *pc, *pval;
+ uint32_t t, ipval, ipc;
ios_loc_t loc0;
loc0 = RS->loc;
loc0.colno--;
- PUSH(FL_nil);
- pc = &FL(stack)[FL(sp)-1]; // to keep track of current cons cell
+ ipval = FL(sp)-1;
+ PUSHSAFE(FL_nil);
+ ipc = FL(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);
c = mk_cons(); car_(c) = cdr_(c) = FL_nil;
+ pc = &FL(stack)[ipc];
if(iscons(*pc))
cdr_(*pc) = c;
else{+ pval = &FL(stack)[ipval];
*pval = c;
if(label != UNBOUND)
ptrhash_put(&FL(readstate)->backrefs, (void*)label, (void*)c);
}
*pc = c;
- c = do_read_sexpr(ctx, UNBOUND); // must be on separate lines due to
- car_(*pc) = c; // undefined evaluation order
+ c = do_read_sexpr(ctx, UNBOUND);
+ pc = &FL(stack)[ipc];
+ car_(*pc) = c;
t = peek(ctx);
if(t == TOK_DOT){take(ctx);
c = do_read_sexpr(ctx, UNBOUND);
+ pc = &FL(stack)[ipc];
cdr_(*pc) = c;
t = peek(ctx);
if(ios_eof(RS))
@@ -598,19 +603,19 @@
take(ctx);
switch(t){case TOK_OPEN:
- PUSH(FL_nil);
- read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSE);
+ PUSHSAFE(FL_nil);
+ read_list(ctx, label, TOK_CLOSE);
return POP();
case TOK_SYM:
case TOK_NUM:
return ctx->tokval;
case TOK_OPENB:
- PUSH(FL_nil);
- read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEB);
+ PUSHSAFE(FL_nil);
+ read_list(ctx, label, TOK_CLOSEB);
return POP();
case TOK_OPENC:
- PUSH(FL_nil);
- read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEC);
+ PUSHSAFE(FL_nil);
+ read_list(ctx, label, TOK_CLOSEC);
return POP();
case TOK_COMMA:
head = &FL_comma; goto listwith;
@@ -627,7 +632,7 @@
car_(v) = *head;
cdr_(v) = tagptr((cons_t*)ptr(v)+1, TAG_CONS);
car_(cdr_(v)) = cdr_(cdr_(v)) = FL_nil;
- PUSH(v);
+ PUSHSAFE(v);
if(label != UNBOUND)
ptrhash_put(&FL(readstate)->backrefs, (void*)label, (void*)v);
v = do_read_sexpr(ctx, UNBOUND);
@@ -649,8 +654,8 @@
take(ctx);
parse_error(&ctx->loc, "expected argument list for %s", symbol_name(ctx->tokval));
}
- PUSH(FL_nil);
- read_list(ctx, &FL(stack)[FL(sp)-1], UNBOUND, TOK_CLOSE);
+ PUSHSAFE(FL_nil);
+ read_list(ctx, UNBOUND, TOK_CLOSE);
if(sym == FL_vu8sym){sym = FL_arraysym;
FL(stack)[FL(sp)-1] = fl_cons(FL_uint8sym, FL(stack)[FL(sp)-1]);
--- a/test/mkfile
+++ b/test/mkfile
@@ -1,3 +1,17 @@
+TESTS=\
+ 100x100.lsp\
+ unittest.lsp\
+ argv.lsp\
+ bench.lsp\
+ hashtest.lsp\
+ torus.lsp\
+ tme.lsp\
+ mp.lsp\
+ perf.lsp\
+ torture.scm
+
test:QV:
- for(t in unittest.lsp argv.lsp bench.lsp hashtest.lsp torus.lsp tme.lsp mp.lsp perf.lsp torture.scm)
+ for(t in $TESTS){+ echo $t
../$O.out $t
+ }
--- a/vm.inc
+++ b/vm.inc
@@ -204,7 +204,7 @@
POPN(n);
PUSH(v);
if(fl_unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)-2))
- gc(0);
+ fl_gc(0);
pv = (value_t*)FL(curheap);
FL(curheap) += 4*sizeof(value_t);
e = FL(stack)[FL(sp)-2]; // closure to copy
@@ -379,7 +379,7 @@
OP(OP_CONS)
if(FL(curheap) > FL(lim))
- gc(0);
+ fl_gc(0);
c = (cons_t*)FL(curheap);
FL(curheap) += sizeof(cons_t);
c->car = FL(stack)[FL(sp)-2];
@@ -571,9 +571,7 @@
v = POP(); // arglist
n = FL(sp)-(n-2); // n-2 == # leading arguments not in the list
while(iscons(v)){- if(FL(sp) >= FL(nstack))
- grow_stack();
- PUSH(car_(v));
+ PUSHSAFE(car_(v));
v = cdr_(v);
}
if(v != FL_nil){