using lisp value stack for call frames instead of the C stack
adding the ability to grow the value stack as needed the net effect is that calls use much less space, and stack frames can use all available heap space. the only downside is that C builtins must be aware that the stack can change out from under them if they call lisp code. currently the only example of this is table.foldl. also fixing bug where exceptions failed to unwind the gc handle stack.
This commit is contained in:
JeffBezanson
parent
2f78b407ea
commit
494e439510
|
|
@ -77,9 +77,10 @@ static short builtin_arg_counts[] =
|
|||
ANYARGS, -1, ANYARGS, -1, 2, 2, 2, 2,
|
||||
ANYARGS, 2, 3 };
|
||||
|
||||
#define N_STACK 262144
|
||||
static value_t Stack[N_STACK];
|
||||
static uint32_t N_STACK;
|
||||
static value_t *Stack;
|
||||
static uint32_t SP = 0;
|
||||
static uint32_t curr_frame = 0;
|
||||
#define PUSH(v) (Stack[SP++] = (v))
|
||||
#define POP() (Stack[--SP])
|
||||
#define POPN(n) (SP-=(n))
|
||||
|
|
@ -128,6 +129,8 @@ static uint32_t *consflags;
|
|||
typedef struct _ectx_t {
|
||||
jmp_buf buf;
|
||||
uint32_t sp;
|
||||
uint32_t frame;
|
||||
uint32_t ngchnd;
|
||||
readstate_t *rdst;
|
||||
struct _ectx_t *prev;
|
||||
} exception_context_t;
|
||||
|
|
@ -137,8 +140,8 @@ static value_t lasterror;
|
|||
|
||||
#define FL_TRY \
|
||||
exception_context_t _ctx; int l__tr, l__ca; \
|
||||
_ctx.sp=SP; _ctx.rdst=readstate; _ctx.prev=ctx; \
|
||||
ctx = &_ctx; \
|
||||
_ctx.sp=SP; _ctx.frame=curr_frame; _ctx.rdst=readstate; _ctx.prev=ctx; \
|
||||
_ctx.ngchnd = N_GCHND; ctx = &_ctx; \
|
||||
if (!setjmp(_ctx.buf)) \
|
||||
for (l__tr=1; l__tr; l__tr=0, (void)(ctx->prev && (ctx=ctx->prev)))
|
||||
|
||||
|
|
@ -155,6 +158,8 @@ void raise(value_t e)
|
|||
readstate = readstate->prev;
|
||||
}
|
||||
SP = ctx->sp;
|
||||
curr_frame = ctx->frame;
|
||||
N_GCHND = ctx->ngchnd;
|
||||
exception_context_t *thisctx = ctx;
|
||||
if (ctx->prev) // don't throw past toplevel
|
||||
ctx = ctx->prev;
|
||||
|
|
@ -498,14 +503,21 @@ void gc(int mustgrow)
|
|||
{
|
||||
static int grew = 0;
|
||||
void *temp;
|
||||
uint32_t i;
|
||||
uint32_t i, f, top;
|
||||
readstate_t *rs;
|
||||
|
||||
curheap = tospace;
|
||||
lim = curheap+heapsize-sizeof(cons_t);
|
||||
|
||||
for (i=0; i < SP; i++)
|
||||
Stack[i] = relocate(Stack[i]);
|
||||
top = SP;
|
||||
f = curr_frame;
|
||||
while (1) {
|
||||
for (i=f; i < top; i++)
|
||||
Stack[i] = relocate(Stack[i]);
|
||||
if (f == 0) break;
|
||||
top = f - 4;
|
||||
f = Stack[f-4];
|
||||
}
|
||||
for (i=0; i < N_GCHND; i++)
|
||||
*GCHandleStack[i] = relocate(*GCHandleStack[i]);
|
||||
trace_globals(symtab);
|
||||
|
|
@ -781,6 +793,16 @@ static value_t do_trycatch()
|
|||
#define DISPATCH goto dispatch
|
||||
#endif
|
||||
|
||||
static void grow_stack()
|
||||
{
|
||||
size_t newsz = N_STACK + (N_STACK>>1);
|
||||
value_t *ns = realloc(Stack, newsz*sizeof(value_t));
|
||||
if (ns == NULL)
|
||||
lerror(MemoryError, "stack overflow");
|
||||
Stack = ns;
|
||||
N_STACK = newsz;
|
||||
}
|
||||
|
||||
/*
|
||||
stack on entry: <func> <up to MAX_ARGS args...> <arglist if nargs>MAX_ARGS>
|
||||
caller's responsibility:
|
||||
|
|
@ -797,6 +819,7 @@ static value_t do_trycatch()
|
|||
static value_t apply_cl(uint32_t nargs)
|
||||
{
|
||||
VM_LABELS;
|
||||
uint32_t top_frame = curr_frame;
|
||||
// frame variables
|
||||
uint32_t n, captured;
|
||||
uint32_t bp;
|
||||
|
|
@ -817,12 +840,18 @@ static value_t apply_cl(uint32_t nargs)
|
|||
func = Stack[SP-nargs-1];
|
||||
ip = cv_data((cvalue_t*)ptr(fn_bcode(func)));
|
||||
assert(!ismanaged((uptrint_t)ip));
|
||||
if (SP+GET_INT32(ip) > N_STACK)
|
||||
lerror(MemoryError, "stack overflow");
|
||||
while (SP+GET_INT32(ip) > N_STACK) {
|
||||
grow_stack();
|
||||
}
|
||||
ip += 4;
|
||||
|
||||
bp = SP-nargs;
|
||||
PUSH(fn_env(func));
|
||||
PUSH(curr_frame);
|
||||
PUSH(nargs);
|
||||
PUSH(0); //ip
|
||||
PUSH(0); //captured?
|
||||
curr_frame = SP;
|
||||
|
||||
{
|
||||
#ifdef USE_COMPUTED_GOTO
|
||||
|
|
@ -846,7 +875,6 @@ static value_t apply_cl(uint32_t nargs)
|
|||
OP(OP_VARGC)
|
||||
i = *ip++;
|
||||
s = (fixnum_t)nargs - (fixnum_t)i;
|
||||
v = NIL;
|
||||
if (s > 0) {
|
||||
v = list(&Stack[bp+i], s);
|
||||
if (nargs > MAX_ARGS) {
|
||||
|
|
@ -859,15 +887,28 @@ static value_t apply_cl(uint32_t nargs)
|
|||
}
|
||||
}
|
||||
Stack[bp+i] = v;
|
||||
Stack[bp+i+1] = Stack[bp+nargs];
|
||||
if (s > 1) {
|
||||
Stack[bp+i+1] = Stack[bp+nargs+0];
|
||||
Stack[bp+i+2] = Stack[bp+nargs+1];
|
||||
Stack[bp+i+3] = i+1;
|
||||
Stack[bp+i+4] = 0;
|
||||
Stack[bp+i+5] = 0;
|
||||
SP = bp+i+6;
|
||||
curr_frame = SP;
|
||||
}
|
||||
}
|
||||
else if (s < 0) {
|
||||
lerror(ArgError, "apply: too few arguments");
|
||||
}
|
||||
else {
|
||||
PUSH(NIL);
|
||||
SP++;
|
||||
Stack[SP-1] = Stack[SP-2];
|
||||
Stack[SP-2] = NIL;
|
||||
Stack[SP-2] = Stack[SP-3];
|
||||
Stack[SP-3] = i+1;
|
||||
Stack[SP-4] = Stack[SP-5];
|
||||
Stack[SP-5] = Stack[SP-6];
|
||||
Stack[SP-6] = NIL;
|
||||
curr_frame = SP;
|
||||
}
|
||||
nargs = i+1;
|
||||
NEXT_OP;
|
||||
|
|
@ -875,7 +916,9 @@ static value_t apply_cl(uint32_t nargs)
|
|||
OP(OP_LVARGC)
|
||||
// move extra arguments from list to stack
|
||||
i = GET_INT32(ip); ip+=4;
|
||||
e = POP(); // cloenv
|
||||
e = Stack[curr_frame-5]; // cloenv
|
||||
n = Stack[curr_frame-4]; // prev curr_frame
|
||||
POPN(5);
|
||||
if (nargs > MAX_ARGS) {
|
||||
v = POP(); // list of rest args
|
||||
nargs--;
|
||||
|
|
@ -897,11 +940,19 @@ static value_t apply_cl(uint32_t nargs)
|
|||
lerror(ArgError, "apply: too many arguments");
|
||||
}
|
||||
PUSH(e);
|
||||
PUSH(n);
|
||||
PUSH(nargs);
|
||||
PUSH(0);
|
||||
PUSH(0);
|
||||
curr_frame = SP;
|
||||
NEXT_OP;
|
||||
OP(OP_LET)
|
||||
// last arg is closure environment to use
|
||||
nargs--;
|
||||
Stack[SP-5] = Stack[SP-4];
|
||||
Stack[SP-4] = nargs;
|
||||
POPN(1);
|
||||
curr_frame = SP;
|
||||
NEXT_OP;
|
||||
OP(OP_NOP) NEXT_OP;
|
||||
OP(OP_DUP) SP++; Stack[SP-1] = Stack[SP-2]; NEXT_OP;
|
||||
|
|
@ -910,6 +961,7 @@ static value_t apply_cl(uint32_t nargs)
|
|||
n = *ip++; // nargs
|
||||
do_tcall:
|
||||
if (isfunction(Stack[SP-n-1])) {
|
||||
curr_frame = Stack[curr_frame-4];
|
||||
for(s=-1; s < (fixnum_t)n; s++)
|
||||
Stack[bp+s] = Stack[SP-n+s];
|
||||
SP = bp+n;
|
||||
|
|
@ -924,7 +976,9 @@ static value_t apply_cl(uint32_t nargs)
|
|||
s = SP;
|
||||
if (tag(func) == TAG_FUNCTION) {
|
||||
if (func > (N_BUILTINS<<3)) {
|
||||
v = apply_cl(n);
|
||||
Stack[curr_frame-2] = (uptrint_t)ip;
|
||||
nargs = n;
|
||||
goto apply_cl_top;
|
||||
}
|
||||
else {
|
||||
i = uintval(func);
|
||||
|
|
@ -984,7 +1038,18 @@ static value_t apply_cl(uint32_t nargs)
|
|||
if (v != FL_F) ip += (ptrint_t)GET_INT32(ip);
|
||||
else ip += 4;
|
||||
NEXT_OP;
|
||||
OP(OP_RET) v = POP(); return v;
|
||||
OP(OP_RET)
|
||||
v = POP();
|
||||
SP = curr_frame;
|
||||
curr_frame = Stack[SP-4];
|
||||
if (curr_frame == top_frame) return v;
|
||||
SP -= (5+nargs);
|
||||
captured = Stack[curr_frame-1];
|
||||
ip = (uint8_t*)Stack[curr_frame-2];
|
||||
nargs = Stack[curr_frame-3];
|
||||
bp = curr_frame - 5 - nargs;
|
||||
Stack[SP-1] = v;
|
||||
NEXT_OP;
|
||||
|
||||
OP(OP_EQ)
|
||||
Stack[SP-2] = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F);
|
||||
|
|
@ -1507,6 +1572,7 @@ static value_t apply_cl(uint32_t nargs)
|
|||
// environment representation changed; install
|
||||
// the new representation so everybody can see it
|
||||
captured = 1;
|
||||
Stack[curr_frame-1] = 1;
|
||||
Stack[bp] = Stack[SP-1];
|
||||
}
|
||||
else {
|
||||
|
|
@ -1653,7 +1719,7 @@ static uint32_t compute_maxstack(uint8_t *code, size_t len)
|
|||
break;
|
||||
}
|
||||
}
|
||||
return maxsp+6;
|
||||
return maxsp+5;
|
||||
}
|
||||
|
||||
// builtins -------------------------------------------------------------------
|
||||
|
|
@ -1806,6 +1872,8 @@ static void lisp_init(void)
|
|||
consflags = bitvector_new(heapsize/sizeof(cons_t), 1);
|
||||
htable_new(&printconses, 32);
|
||||
comparehash_init();
|
||||
N_STACK = 262144;
|
||||
Stack = malloc(N_STACK*sizeof(value_t));
|
||||
|
||||
NIL = builtin(OP_THE_EMPTY_LIST);
|
||||
FL_T = builtin(OP_BOOL_CONST_T);
|
||||
|
|
|
|||
|
|
@ -168,23 +168,28 @@ value_t fl_table_del(value_t *args, uint32_t nargs)
|
|||
value_t fl_table_foldl(value_t *args, uint32_t nargs)
|
||||
{
|
||||
argcount("table.foldl", nargs, 3);
|
||||
htable_t *h = totable(args[2], "table.foldl");
|
||||
value_t f=args[0], zero=args[1], t=args[2];
|
||||
htable_t *h = totable(t, "table.foldl");
|
||||
size_t i, n = h->size;
|
||||
void **table = h->table;
|
||||
fl_gc_handle(&f);
|
||||
fl_gc_handle(&zero);
|
||||
fl_gc_handle(&t);
|
||||
for(i=0; i < n; i+=2) {
|
||||
if (table[i+1] != HT_NOTFOUND) {
|
||||
args[1] = applyn(3, args[0],
|
||||
(value_t)table[i],
|
||||
(value_t)table[i+1],
|
||||
args[1]);
|
||||
zero = applyn(3, f,
|
||||
(value_t)table[i],
|
||||
(value_t)table[i+1],
|
||||
zero);
|
||||
// reload pointer
|
||||
h = (htable_t*)cv_data((cvalue_t*)ptr(args[2]));
|
||||
h = (htable_t*)cv_data((cvalue_t*)ptr(t));
|
||||
if (h->size != n)
|
||||
lerror(EnumerationError, "table.foldl: table modified");
|
||||
table = h->table;
|
||||
}
|
||||
}
|
||||
return args[1];
|
||||
fl_free_gc_handles(3);
|
||||
return zero;
|
||||
}
|
||||
|
||||
static builtinspec_t tablefunc_info[] = {
|
||||
|
|
|
|||
|
|
@ -1059,33 +1059,30 @@ arg1
|
|||
argn
|
||||
cloenv |
|
||||
prev |
|
||||
args |
|
||||
nargs |
|
||||
ip |
|
||||
capt? |
|
||||
ip |
|
||||
captured |
|
||||
|
||||
to call:
|
||||
push func and arguments
|
||||
args[nargs+4] = ip // save my state in my frame
|
||||
args[nargs+5] = capt?
|
||||
args[nargs+3] = ip // save my state in my frame
|
||||
assign nargs
|
||||
goto top
|
||||
|
||||
on entry:
|
||||
push cloenv
|
||||
push curr_frame (a global initialized to 0)
|
||||
push args
|
||||
push nargs
|
||||
SP += 2
|
||||
SP += 1
|
||||
curr_frame = SP
|
||||
|
||||
to return:
|
||||
v = POP();
|
||||
SP = curr_frame
|
||||
curr_frame = Stack[SP-5]
|
||||
curr_frame = Stack[SP-4]
|
||||
if (args == top_args) return v;
|
||||
SP -= (6+nargs);
|
||||
move Stack[curr_frame-4] through Stack[curr_frame-1] back into locals
|
||||
SP -= (5+nargs);
|
||||
move Stack[curr_frame-...] back into locals
|
||||
Stack[SP-1] = v
|
||||
goto next_op
|
||||
|
||||
|
|
@ -1097,8 +1094,8 @@ for each segment {
|
|||
for i=f, i<curr_top, i++
|
||||
relocate stack[i]
|
||||
if (f == 0) break;
|
||||
curr_top = f - 6
|
||||
f = stack[f - 5]
|
||||
curr_top = f - 4
|
||||
f = stack[f - 4]
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue