shithub: femtolisp

Download patch

ref: 494e439510a50852c1c2cba7e9329c4980b8176b
parent: 2f78b407ea3d48be3e7202fc7af2529824366d34
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Fri Jul 3 14:43:15 EDT 2009

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.


--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -77,9 +77,10 @@
       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 @@
 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 @@
 
 #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 @@
         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 @@
 {
     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 @@
 #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 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 @@
     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 @@
         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 @@
                     }
                 }
                 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 @@
         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 @@
                     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 @@
             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 @@
             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 @@
             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 @@
                 // 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 @@
             break;
         }
     }
-    return maxsp+6;
+    return maxsp+5;
 }
 
 // builtins -------------------------------------------------------------------
@@ -1806,6 +1872,8 @@
     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);
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -168,23 +168,28 @@
 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[] = {
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -1059,15 +1059,13 @@
 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
 
@@ -1074,18 +1072,17 @@
 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 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]
   }
 }