first version of stackless Lua

2 files changed, 128 insertions, 78 deletions

diff --git a/ldo.c b/ldo.c
index e46f84a3..ae70d268 100644
--- a/ldo.c
+++ b/ldo.c
@@ -43,8 +43,15 @@ void luaD_init (lua_State *L, int stacksize) {
   stacksize += EXTRA_STACK;
   L->stack = luaM_newvector(L, stacksize, TObject);
   L->stacksize = stacksize;
-  L->top = L->basefunc.base = L->stack + RESERVED_STACK_PREFIX;
+  L->top = L->stack + RESERVED_STACK_PREFIX;
   restore_stack_limit(L);
+  luaM_reallocvector(L, L->base_ci, 0, 20, CallInfo);
+  L->ci = L->base_ci;
+  L->ci->base = L->top;
+  L->ci->savedpc = NULL;
+  L->ci->pc = NULL;
+  L->size_ci = 20;
+  L->end_ci = L->base_ci + L->size_ci;
 }
 
 
@@ -98,35 +105,81 @@ void luaD_lineHook (lua_State *L, int line, lua_Hook linehook) {
   if (L->allowhooks) {
     lua_Debug ar;
     ar.event = "line";
-    ar._ci = L->ci;
+    ar._ci = L->ci - L->base_ci;
     ar.currentline = line;
     dohook(L, &ar, linehook);
   }
 }
 
 
-static void luaD_callHook (lua_State *L, lua_Hook callhook,
-                           const char *event) {
+void luaD_callHook (lua_State *L, lua_Hook callhook, const char *event) {
   if (L->allowhooks) {
     lua_Debug ar;
     ar.event = event;
-    ar._ci = L->ci;
-    L->ci->pc = NULL;  /* function is not active */
+    ar._ci = L->ci - L->base_ci;
     dohook(L, &ar, callhook);
   }
 }
 
 
-static StkId callCclosure (lua_State *L, const struct CClosure *cl) {
+#define newci(L)        ((++L->ci == L->end_ci) ? growci(L) : L->ci)
+
+static CallInfo *growci (lua_State *L) {
+  lua_assert(L->ci == L->end_ci);
+  luaM_reallocvector(L, L->base_ci, L->size_ci, 2*L->size_ci, CallInfo);
+  L->ci = L->base_ci + L->size_ci;
+  L->size_ci *= 2;
+  L->end_ci = L->base_ci + L->size_ci;
+  return L->ci;
+}
+
+
+StkId luaD_precall (lua_State *L, StkId func) {
+  CallInfo *ci;
   int n;
+  if (ttype(func) != LUA_TFUNCTION) {
+    /* `func' is not a function; check the `function' tag method */
+    const TObject *tm = luaT_gettmbyobj(L, func, TM_CALL);
+    if (ttype(tm) != LUA_TFUNCTION)
+      luaG_typeerror(L, func, "call");
+    luaD_openstack(L, func);
+    setobj(func, tm);  /* tag method is the new function to be called */
+  }
+  lua_assert(ttype(func) == LUA_TFUNCTION);
+  ci = newci(L);
+  ci->base = func+1;
+  ci->savedpc = NULL;
+  ci->pc = NULL;
+  if (L->callhook)
+    luaD_callHook(L, L->callhook, "call");
+  if (!clvalue(func)->c.isC) return NULL;
+  /* if is a C function, call it */
   luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
   lua_unlock(L);
 #if LUA_COMPATUPVALUES
   lua_pushupvalues(L);
 #endif
-  n = (*cl->f)(L);  /* do the actual call */
+  n = (*clvalue(func)->c.f)(L);  /* do the actual call */
   lua_lock(L);
-  return L->top - n;  /* return index of first result */
+  return L->top - n;
+}
+
+
+void luaD_poscall (lua_State *L, int wanted, StkId firstResult) { 
+  StkId res;
+  if (L->callhook)
+    luaD_callHook(L, L->callhook, "return");
+  res = L->ci->base - 1;  /* `func' = final position of 1st result */
+  L->ci--;
+  /* move results to correct place */
+  while (wanted != 0 && firstResult < L->top) {
+    setobj(res++, firstResult++);
+    wanted--;
+  }
+  while (wanted-- > 0)
+    setnilvalue(res++);
+  L->top = res;
+  luaC_checkGC(L);
 }
 
 
@@ -136,36 +189,11 @@ static StkId callCclosure (lua_State *L, const struct CClosure *cl) {
 ** When returns, all the results are on the stack, starting at the original
 ** function position.
 */ 
-void luaD_call (lua_State *L, StkId func) {
-  lua_Hook callhook;
-  StkId firstResult;
-  CallInfo ci;
-  if (ttype(func) != LUA_TFUNCTION) {
-    /* `func' is not a function; check the `function' tag method */
-    const TObject *tm = luaT_gettmbyobj(L, func, TM_CALL);
-    if (ttype(tm) != LUA_TFUNCTION)
-      luaG_typeerror(L, func, "call");
-    luaD_openstack(L, func);
-    setobj(func, tm);  /* tag method is the new function to be called */
-  }
-  lua_assert(ttype(func) == LUA_TFUNCTION);
-  ci.prev = L->ci;  /* chain new callinfo */
-  L->ci = &ci;
-  ci.base = func+1;
-  callhook = L->callhook;
-  if (callhook)
-    luaD_callHook(L, callhook, "call");
-  firstResult = (clvalue(func)->c.isC ?
-                        callCclosure(L, &clvalue(func)->c) :
-                        luaV_execute(L, &clvalue(func)->l, func+1));
-  if (callhook)  /* same hook that was active at entry */
-    luaD_callHook(L, callhook, "return");
-  L->ci = ci.prev;  /* unchain callinfo */
-  /* move results to `func' (to erase parameters and function) */
-  while (firstResult < L->top)
-    setobj(func++, firstResult++);
-  L->top = func;
-  luaC_checkGC(L);
+void luaD_call (lua_State *L, StkId func, int nResults) {
+  StkId firstResult = luaD_precall(L, func);
+  if (firstResult == NULL)  /* is a Lua function? */
+    firstResult = luaV_execute(L, &clvalue(func)->l, func+1);  /* call it */
+  luaD_poscall(L, nResults, firstResult);
 }
 
 
@@ -179,9 +207,7 @@ struct CallS {  /* data to `f_call' */
 
 static void f_call (lua_State *L, void *ud) {
   struct CallS *c = cast(struct CallS *, ud);
-  luaD_call(L, c->func);
-  if (c->nresults != LUA_MULTRET)
-    luaD_adjusttop(L, c->func + c->nresults);
+  luaD_call(L, c->func, c->nresults);
 }
 
 
@@ -291,7 +317,7 @@ struct lua_longjmp {
   jmp_buf b;
   struct lua_longjmp *previous;
   volatile int status;  /* error code */
-  CallInfo *ci;  /* call info of active function that set protection */
+  int ci;  /* index of call info of active function that set protection */
   StkId top;  /* top stack when protection was set */
   int allowhooks;  /* `allowhook' state when protection was set */
 };
@@ -307,8 +333,7 @@ static void message (lua_State *L, const char *s) {
     incr_top;
     setsvalue(top+1, luaS_new(L, s));
     incr_top;
-    luaD_call(L, top);
-    L->top = top;
+    luaD_call(L, top, 0);
   }
 }
 
@@ -337,7 +362,7 @@ void luaD_breakrun (lua_State *L, int errcode) {
 
 int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
   struct lua_longjmp lj;
-  lj.ci = L->ci;
+  lj.ci = L->ci - L->base_ci;
   lj.top = L->top;
   lj.allowhooks = L->allowhooks;
   lj.status = 0;
@@ -346,7 +371,7 @@ int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
   if (setjmp(lj.b) == 0)
     (*f)(L, ud);
   else {  /* an error occurred: restore the state */
-    L->ci = lj.ci;
+    L->ci = L->base_ci + lj.ci;
     L->top = lj.top;
     L->allowhooks = lj.allowhooks;
     restore_stack_limit(L);
diff --git a/lvm.c b/lvm.c
index 85746e03..435229a0 100644
--- a/lvm.c
+++ b/lvm.c
@@ -97,14 +97,9 @@ static void callTM (lua_State *L, const TObject *f,
     setobj(base+3, p3);  /* 3th argument */
     L->top++;
   }
-  luaD_call(L, base);
+  luaD_call(L, base, (result ? 1 : 0));
   if (result) {  /* need a result? */
-    if (L->top == base) {  /* are there valid results? */
-      setnilvalue(result);  /* function had no results */
-    }
-    else {
-      setobj(result, base);  /* get first result */
-    }
+    setobj(result, base);  /* get it */
   }
   L->top = base;  /* restore top */
 }
@@ -140,7 +135,7 @@ void luaV_gettable (lua_State *L, StkId t, TObject *key, StkId res) {
   if (ttype(tm) == LUA_TFUNCTION)
     callTM(L, tm, t, key, NULL, res);
   else {
-    t = tm;
+    t = (StkId)tm;  /* ?? */
     goto init;  /* return luaV_gettable(L, tm, key, res); */
   }
 }
@@ -169,7 +164,7 @@ void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val) {
   if (ttype(tm) == LUA_TFUNCTION)
     callTM(L, tm, t, key, val, NULL);
   else {
-    t = tm;
+    t = (StkId)tm;  /* ?? */
     goto init;  /* luaV_settable(L, tm, key, val); */
   }
 }
@@ -311,15 +306,15 @@ static void powOp (lua_State *L, StkId ra, StkId rb, StkId rc) {
 ** some macros for common tasks in `luaV_execute'
 */
 
-#define runtime_check(L, c)     { if (!(c)) return L->top; }
+#define runtime_check(L, c)     { if (!(c)) return 0; }
 
 #define RA(i)   (base+GETARG_A(i))
 #define RB(i)   (base+GETARG_B(i))
 #define RC(i)   (base+GETARG_C(i))
 #define RKC(i)  ((GETARG_C(i) < MAXSTACK) ? \
                         base+GETARG_C(i) : \
-                        tf->k+GETARG_C(i)-MAXSTACK)
-#define KBc(i)  (tf->k+GETARG_Bc(i))
+                        cl->p->k+GETARG_C(i)-MAXSTACK)
+#define KBc(i)  (cl->p->k+GETARG_Bc(i))
 
 #define Arith(op, optm) { \
   const TObject *b = RB(i); const TObject *c = RKC(i);          \
@@ -332,6 +327,16 @@ static void powOp (lua_State *L, StkId ra, StkId rb, StkId rc) {
 }
 
 
+#define luaV_poscall(L,c,f) \
+  if (c != NO_REG) { \
+    luaD_poscall(L, c, f); \
+    L->top = base + cl->p->maxstacksize; \
+  } \
+  else { \
+    luaD_poscall(L, LUA_MULTRET, f); \
+  }
+
+
 #define dojump(pc, i)   ((pc) += GETARG_sBc(i))
 
 /*
@@ -339,17 +344,18 @@ static void powOp (lua_State *L, StkId ra, StkId rb, StkId rc) {
 ** Returns n such that the results are between [n,top).
 */
 StkId luaV_execute (lua_State *L, const LClosure *cl, StkId base) {
-  const Proto *const tf = cl->p;
   const Instruction *pc;
   lua_Hook linehook;
-  if (tf->is_vararg)  /* varargs? */
-    adjust_varargs(L, base, tf->numparams);
-  if (base > L->stack_last - tf->maxstacksize)
+ reinit:
+  lua_assert(L->ci->savedpc == NULL);
+  if (cl->p->is_vararg)  /* varargs? */
+    adjust_varargs(L, base, cl->p->numparams);
+  if (base > L->stack_last - cl->p->maxstacksize)
     luaD_stackerror(L);
-  luaD_adjusttop(L, base + tf->maxstacksize);
-  pc = tf->code;
+  luaD_adjusttop(L, base + cl->p->maxstacksize);
   L->ci->pc = &pc;
-  linehook = L->linehook;
+  linehook = L->ci->linehook = L->linehook;
+  pc = cl->p->code;
   /* main loop of interpreter */
   for (;;) {
     const Instruction i = *pc++;
@@ -528,25 +534,44 @@ StkId luaV_execute (lua_State *L, const LClosure *cl, StkId base) {
         break;
       }
       case OP_CALL: {
-        int c;
+        StkId firstResult;
         int b = GETARG_B(i);
-        if (b != NO_REG)
-          L->top = ra+b+1;
-        luaD_call(L, ra);
-        c = GETARG_C(i);
-        if (c != NO_REG) {
-          while (L->top < ra+c) setnilvalue(L->top++);
-          L->top = base + tf->maxstacksize;
+        if (b != NO_REG) L->top = ra+b+1;
+        /* else previous instruction set top */
+        firstResult = luaD_precall(L, ra);
+        if (firstResult) {
+          /* it was a C function (`precall' called it); adjust results */
+          luaV_poscall(L, GETARG_C(i), firstResult);
+        }
+        else {  /* it is a Lua function: `call' it */
+          CallInfo *ci = L->ci;
+          (ci-1)->savedpc = pc;
+          base = ci->base;
+          cl = &clvalue(base - 1)->l;
+          goto reinit;
         }
         break;
       }
       case OP_RETURN: {
+        CallInfo *ci;
         int b;
         luaF_close(L, base);
         b = GETARG_B(i);
-        if (b != NO_REG)
-          L->top = ra+b;
-        return ra;
+        if (b != NO_REG) L->top = ra+b;
+        ci = L->ci - 1;
+        if (ci->savedpc == NULL)
+          return ra;
+        else {  /* previous function is Lua: continue its execution */
+          lua_assert(ttype(ci->base-1) == LUA_TFUNCTION);
+          base = ci->base;  /* restore previous values */
+          linehook = ci->linehook;
+          cl = &clvalue(base - 1)->l;
+          pc = ci->savedpc;
+          ci->savedpc = NULL;
+          lua_assert(GET_OPCODE(*(pc-1)) == OP_CALL);
+          luaV_poscall(L, GETARG_C(*(pc-1)), ra);
+        }
+        break;
       }
       case OP_FORPREP: {
         if (luaV_tonumber(ra, ra) == NULL)
@@ -623,7 +648,7 @@ StkId luaV_execute (lua_State *L, const LClosure *cl, StkId base) {
         Closure *ncl;
         int nup, j;
         luaV_checkGC(L, L->top);
-        p = tf->p[GETARG_Bc(i)];
+        p = cl->p->p[GETARG_Bc(i)];
         nup = p->nupvalues;
         ncl = luaF_newLclosure(L, nup);
         ncl->l.p = p;