From 494e439510a50852c1c2cba7e9329c4980b8176b Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Fri, 3 Jul 2009 18:43:15 +0000 Subject: [PATCH] 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. --- femtolisp/flisp.c | 102 ++++++++++++++++++++++++++++++++++++++-------- femtolisp/table.c | 19 +++++---- femtolisp/todo | 21 ++++------ 3 files changed, 106 insertions(+), 36 deletions(-) diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index e029004..e07e54b 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -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: 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); diff --git a/femtolisp/table.c b/femtolisp/table.c index a85539c..7cc6103 100644 --- a/femtolisp/table.c +++ b/femtolisp/table.c @@ -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[] = { diff --git a/femtolisp/todo b/femtolisp/todo index 7402277..796fddf 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -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