first version of dynamic stack

ldebug.c

@@ -25,8 +25,7 @@
 
 
 
-static const char *getfuncname (lua_State *L, CallInfo *ci,
-                                  const char **name);
+static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
 
 
 
@@ -57,7 +56,7 @@ LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {
 
 static CallInfo *ci_stack (lua_State *L, StkId obj) {
   CallInfo *ci = L->ci;
-  while (ci->base > obj) ci--;
+  while (ci->base > obj && ci > L->base_ci) ci--;
   return ci;
 }
 
@@ -105,22 +104,22 @@ int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) {
 }
 
 
-static int currentpc (CallInfo *ci) {
+static int currentpc (lua_State *L, CallInfo *ci) {
   lua_assert(isLmark(ci));
-  if (ci->savedpc)
-    return (ci->savedpc - ci_func(ci)->l.p->code) - 1;
-  else if (ci->pc)
+  if (ci->pc == NULL) return 0;  /* function is not active */
+  if (ci == L->ci || ci->pc != (ci+1)->pc)  /* no other function using `pc'? */
     return (*ci->pc - ci_func(ci)->l.p->code) - 1;
-  else return 0;
+  else  /* function's pc is saved */
+    return (ci->savedpc - ci_func(ci)->l.p->code) - 1;
 }
 
 
-static int currentline (CallInfo *ci) {
+static int currentline (lua_State *L, CallInfo *ci) {
   if (!isLmark(ci))
     return -1;  /* only active lua functions have current-line information */
   else {
     int *lineinfo = ci_func(ci)->l.p->lineinfo;
-    return luaG_getline(lineinfo, currentpc(ci), 1, NULL);
+    return luaG_getline(lineinfo, currentpc(L, ci), 1, NULL);
   }
 }
 
@@ -140,7 +139,7 @@ LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
   ci = L->base_ci + ar->_ci;
   fp = getluaproto(ci);
   if (fp) {  /* is a Lua function? */
-    name = luaF_getlocalname(fp, n, currentpc(ci));
+    name = luaF_getlocalname(fp, n, currentpc(L, ci));
     if (name)
       luaA_pushobject(L, ci->base+(n-1));  /* push value */
   }
@@ -159,7 +158,7 @@ LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
   fp = getluaproto(ci);
   L->top--;  /* pop new value */
   if (fp) {  /* is a Lua function? */
-    name = luaF_getlocalname(fp, n, currentpc(ci));
+    name = luaF_getlocalname(fp, n, currentpc(L, ci));
     if (!name || name[0] == '(')  /* `(' starts private locals */
       name = NULL;
     else
@@ -239,7 +238,7 @@ LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
         break;
       }
       case 'l': {
-        ar->currentline = (ci) ? currentline(ci) : -1;
+        ar->currentline = (ci) ? currentline(L, ci) : -1;
         break;
       }
       case 'u': {
@@ -254,13 +253,14 @@ LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
       }
       case 'f': {
         setobj(L->top, f);
-        incr_top;  /* push function */
+        status = 2;
         break;
       }
       default: status = 0;  /* invalid option */
     }
   }
   if (!ci) L->top--;  /* pop function */
+  if (status == 2) incr_top(L);
   lua_unlock(L);
   return status;
 }
@@ -449,7 +449,7 @@ static const char *getobjname (lua_State *L, StkId obj, const char **name) {
   CallInfo *ci = ci_stack(L, obj);
   if (isLmark(ci)) {  /* an active Lua function? */
     Proto *p = ci_func(ci)->l.p;
-    int pc = currentpc(ci);
+    int pc = currentpc(L, ci);
     int stackpos = obj - ci->base;
     Instruction i;
     *name = luaF_getlocalname(p, stackpos+1, pc);
@@ -486,14 +486,13 @@ static const char *getobjname (lua_State *L, StkId obj, const char **name) {
 }
 
 
-static const char *getfuncname (lua_State *L, CallInfo *ci,
-                                  const char **name) {
+static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
   ci--;  /* calling function */
   if (ci == L->base_ci || !isLmark(ci))
     return NULL;  /* not an active Lua function */
   else {
     Proto *p = ci_func(ci)->l.p;
-    int pc = currentpc(ci);
+    int pc = currentpc(L, ci);
     Instruction i;
     i = p->code[pc];
     return (GET_OPCODE(i) == OP_CALL

ldo.c

@@ -30,22 +30,72 @@
 
 
 
+/* chain list of long jump buffers */
+struct lua_longjmp {
+  jmp_buf b;
+  struct lua_longjmp *previous;
+  CallInfo *ci;  /* index of call info of active function that set protection */
+  StkId top;  /* top stack when protection was set */
+  TObject *stack;  /* active stack for this entry */
+  int allowhooks;  /* `allowhook' state when protection was set */
+  volatile int status;  /* error code */
+};
+
+
+static void correctstack (lua_State *L, TObject *oldstack) {
+  struct lua_longjmp *lj;
+  CallInfo *ci;
+  UpVal *up;
+  L->top = (L->top - oldstack) + L->stack;
+  for (lj = L->errorJmp; lj && lj->stack == oldstack; lj = lj->previous) {
+    lj->top = (lj->top - oldstack) + L->stack;
+    lj->stack = L->stack;
+  }
+  for (up = L->openupval; up != NULL; up = up->next)
+    up->v = (up->v - oldstack) + L->stack;
+  for (ci = L->base_ci; ci <= L->ci; ci++) {
+    ci->base = (ci->base - oldstack) + L->stack;
+    ci->top = (ci->top - oldstack) + L->stack;
+    if (ci->pc) {  /* entry is of an active Lua function? */
+      if (ci->pc != (ci-1)->pc)
+        *ci->pb = (*ci->pb - oldstack) + L->stack;
+    }
+  }
+}
+
+
+void luaD_reallocstack (lua_State *L, int newsize) {
+  TObject *oldstack = L->stack;
+  luaM_reallocvector(L, L->stack, L->stacksize, newsize, TObject);
+  L->stacksize = newsize;
+  L->stack_last = L->stack+(newsize-EXTRA_STACK)-1;
+  correctstack(L, oldstack);
+}
+
+
 static void restore_stack_limit (lua_State *L) {
-  StkId limit = L->stack+(L->stacksize-EXTRA_STACK)-1;
-  if (L->top < limit)
-    L->stack_last = limit;
+  if (L->stacksize > L->maxstacksize) {  /* there was an overflow? */
+    int inuse = (L->top - L->stack);
+    if (inuse + MAXSTACK < L->maxstacksize)  /* can `undo' overflow? */
+      luaD_reallocstack(L, L->maxstacksize);
+  }
 }
 
 
-void luaD_stackerror (lua_State *L) {
-  if (L->stack_last == L->stack+L->stacksize-1) {
-    /* overflow while handling overflow */
+void luaD_growstack (lua_State *L, int n) {
+  if (L->stacksize > L->maxstacksize) {  /* overflow while handling overflow? */
     luaD_breakrun(L, LUA_ERRERR);  /* break run without error message */
   }
   else {
-    L->stack_last += EXTRA_STACK;  /* to be used by error message */
-    lua_assert(L->stack_last == L->stack+L->stacksize-1);
-    luaD_error(L, "stack overflow");
+    if (n <= L->stacksize && 2*L->stacksize < L->maxstacksize)  /* can double? */
+      luaD_reallocstack(L, 2*L->stacksize);
+   else if (L->stacksize+n <= L->maxstacksize)  /* no overflow? */
+      luaD_reallocstack(L, L->maxstacksize);
+   else {
+      /* resize to maximum + some extra space to handle error */
+      luaD_reallocstack(L, L->maxstacksize+4*LUA_MINSTACK);
+      luaD_error(L, "stack overflow");
+    }
   }
 }
 
@@ -56,12 +106,12 @@ void luaD_stackerror (lua_State *L) {
 static void luaD_openstack (lua_State *L, StkId pos) {
   int i = L->top-pos; 
   while (i--) setobj(pos+i+1, pos+i);
-  incr_top;
+  incr_top(L);
 }
 
 
 static void dohook (lua_State *L, lua_Debug *ar, lua_Hook hook) {
-  StkId old_top = L->top;
+  L->ci->top = L->top;
   luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
   L->allowhooks = 0;  /* cannot call hooks inside a hook */
   lua_unlock(L);
@@ -69,7 +119,7 @@ static void dohook (lua_State *L, lua_Debug *ar, lua_Hook hook) {
   lua_lock(L);
   lua_assert(L->allowhooks == 0);
   L->allowhooks = 1;
-  L->top = old_top;
+  L->top = L->ci->top;
 }
 
 
@@ -95,66 +145,82 @@ void luaD_callHook (lua_State *L, lua_Hook callhook, const char *event) {
 }
 
 
-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;
+static void correctCI (lua_State *L, CallInfo *oldci) {
+  struct lua_longjmp *lj;
+  for (lj = L->errorJmp; lj && lj->stack == L->stack; lj = lj->previous) {
+    lj->ci = (lj->ci - oldci) + L->base_ci;
+  }
 }
 
 
-static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
+void luaD_reallocCI (lua_State *L, int newsize) {
+  CallInfo *oldci = L->base_ci;
+  luaM_reallocvector(L, L->base_ci, L->size_ci, newsize, CallInfo);
+  L->size_ci = newsize;
+  if (oldci != L->ci) {
+    L->ci = (L->ci - oldci) + L->base_ci;
+    L->end_ci = L->base_ci + L->size_ci;
+    correctCI(L, oldci);
+  }
+}
+
+
+static void adjust_varargs (lua_State *L, int nfixargs) {
   int i;
   Table *htab;
   TObject n, nname;
-  StkId firstvar = base + nfixargs;  /* position of first vararg */
-  if (L->top < firstvar) {
-    luaD_checkstack(L, firstvar - L->top);
-    while (L->top < firstvar)
+  int actual = L->top - L->ci->base;  /* actual number of arguments */
+  if (actual < nfixargs) {
+    luaD_checkstack(L, nfixargs - actual);
+    for (; actual < nfixargs; ++actual)
       setnilvalue(L->top++);
   }
-  htab = luaH_new(L, 0, 0);
-  for (i=0; firstvar+i<L->top; i++)
-    luaH_setnum(L, htab, i+1, firstvar+i);
+  actual -= nfixargs;  /* number of extra arguments */
+  htab = luaH_new(L, 0, 0);  /* create `arg' table */
+  for (i=0; i<actual; i++)  /* put extra arguments into `arg' table */
+    luaH_setnum(L, htab, i+1, L->top - actual + i);
   /* store counter in field `n' */
-  setnvalue(&n, i);
+  setnvalue(&n, actual);
   setsvalue(&nname, luaS_newliteral(L, "n"));
   luaH_set(L, htab, &nname, &n);
-  L->top = firstvar;  /* remove elements from the stack */
+  L->top -= actual;  /* remove extra elements from the stack */
   sethvalue(L->top, htab);
-  incr_top;
+  incr_top(L);
 }
 
 
 StkId luaD_precall (lua_State *L, StkId func) {
   CallInfo *ci;
   LClosure *cl;
+  if (++L->ci == L->end_ci) luaD_reallocCI(L, 2*L->size_ci);
+  ci = L->ci;
+  ci->base = func+1;
+  ci->pc = NULL;
   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)
+    if (ttype(tm) != LUA_TFUNCTION) {
+      L->ci--;  /* undo increment (no function here) */
       luaG_typeerror(L, func, "call");
+    }
     luaD_openstack(L, func);
+    func = ci->base - 1;  /* previous call may change stack */
     setobj(func, tm);  /* tag method is the new function to be called */
   }
-  ci = ++L->ci;
-  if (L->ci == L->end_ci) ci = growci(L);
-  ci->base = func+1;
-  if (L->callhook)
-    luaD_callHook(L, L->callhook, "call");
   cl = &clvalue(func)->l;
+  if (L->callhook) {
+    luaD_callHook(L, L->callhook, "call");
+    ci = L->ci;  /* previous call may realocate `ci' */
+  }
   if (!cl->isC) {  /* Lua function? prepare its call */
-    StkId base = func+1;
     Proto *p = cl->p;
     ci->savedpc = p->code;  /* starting point */
     if (p->is_vararg)  /* varargs? */
-      adjust_varargs(L, base, p->numparams);
-    if (base > L->stack_last - p->maxstacksize)
-      luaD_stackerror(L);
+      adjust_varargs(L, p->numparams);
+    if (ci->base > L->stack_last - p->maxstacksize)
+      luaD_growstack(L, p->maxstacksize);
     ci->line = 0;
-    ci->top = base + p->maxstacksize;
+    ci->top = ci->base + p->maxstacksize;
     while (L->top < ci->top)
       setnilvalue(L->top++);
     L->top = ci->top;
@@ -162,13 +228,12 @@ StkId luaD_precall (lua_State *L, StkId func) {
   }
   else {  /* if is a C function, call it */
     int n;
-    ci->savedpc = NULL;
     luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
     lua_unlock(L);
 #if LUA_COMPATUPVALUES
     lua_pushupvalues(L);
 #endif
-    n = (*clvalue(func)->c.f)(L);  /* do the actual call */
+    n = (*clvalue(ci->base-1)->c.f)(L);  /* do the actual call */
     lua_lock(L);
     return L->top - n;
   }
@@ -177,9 +242,12 @@ StkId luaD_precall (lua_State *L, StkId func) {
 
 void luaD_poscall (lua_State *L, int wanted, StkId firstResult) { 
   StkId res;
-  if (L->callhook)
+  if (L->callhook) {
+    StkId stack = L->stack;  /* next call may change stack */
     luaD_callHook(L, L->callhook, "return");
-  res = L->ci->base - 1;  /* `func' = final position of 1st result */
+    firstResult = (firstResult - stack) + L->stack;
+  }
+  res = L->ci->base - 1;  /* func == final position of 1st result */
   L->ci--;
   /* move results to correct place */
   while (wanted != 0 && firstResult < L->top) {
@@ -223,7 +291,7 @@ static void resume_results (lua_State *L, lua_State *from, int numresults) {
   while (numresults) {
     setobj(L->top, from->top - numresults);
     numresults--;
-    incr_top;
+    incr_top(L);
   }
 }
 
@@ -231,7 +299,7 @@ static void resume_results (lua_State *L, lua_State *from, int numresults) {
 LUA_API void lua_resume (lua_State *L, lua_State *co) {
   StkId firstResult;
   lua_lock(L);
-  if (co->ci->savedpc == NULL)  /* no activation record? */
+  if (co->ci == co->base_ci)  /* no activation record? ?? */
     luaD_error(L, "thread is dead - cannot be resumed");
   lua_assert(co->errorJmp == NULL);
   co->errorJmp = L->errorJmp;
@@ -253,15 +321,13 @@ LUA_API void lua_resume (lua_State *L, lua_State *co) {
 
 LUA_API int lua_yield (lua_State *L, int nresults) {
   CallInfo *ci;
-  int ibase;
   lua_lock(L);
   ci = L->ci;
   if (ci_func(ci-1)->c.isC)
     luaD_error(L, "cannot `yield' a C function");
-  ci->yield_results = nresults;  /* very dirty trick! */
-  ibase = L->top - (ci-1)->base;
+  ci->yield_results = nresults;
   lua_unlock(L);
-  return ibase;
+  return -1;
 }
 
 
@@ -280,16 +346,15 @@ static void f_call (lua_State *L, void *ud) {
 
 
 LUA_API int lua_call (lua_State *L, int nargs, int nresults) {
-  StkId func;
   struct CallS c;
   int status;
   lua_lock(L);
-  func = L->top - (nargs+1);  /* function to be called */
-  c.func = func; c.nresults = nresults;
+  c.func = L->top - (nargs+1);  /* function to be called */
+  c.nresults = nresults;
   status = luaD_runprotected(L, f_call, &c);
   if (status != 0) {  /* an error occurred? */
-    luaF_close(L, func);  /* close eventual pending closures */
-    L->top = func;  /* remove parameters from the stack */
+    L->top -= nargs+1;  /* remove parameters and func from the stack */
+    luaF_close(L, L->top);  /* close eventual pending closures */
   }
   lua_unlock(L);
   return status;
@@ -310,7 +375,7 @@ static void f_parser (lua_State *L, void *ud) {
   Closure *cl = luaF_newLclosure(L, 0);
   cl->l.p = tf;
   setclvalue(L->top, cl);
-  incr_top;
+  incr_top(L);
 }
 
 
@@ -351,7 +416,7 @@ LUA_API int lua_loadfile (lua_State *L, const char *filename) {
     if (f == NULL) return LUA_ERRFILE;  /* unable to reopen file */
   }
   lua_pushliteral(L, "@");
-  lua_pushstring(L, (filename == NULL) ? "(stdin)" : filename);
+  lua_pushstring(L, (filename == NULL) ? "=stdin" : filename);
   lua_concat(L, 2);
   nlevel = lua_gettop(L);
   filename = lua_tostring(L, -1);  /* filename = `@'..filename */
@@ -380,28 +445,17 @@ LUA_API int lua_loadbuffer (lua_State *L, const char *buff, size_t size,
 ** =======================================================
 */
 
-/* chain list of long jump buffers */
-struct lua_longjmp {
-  jmp_buf b;
-  struct lua_longjmp *previous;
-  volatile int status;  /* error code */
-  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 */
-};
-
 
 static void message (lua_State *L, const char *s) {
   TObject o, m;
   setsvalue(&o, luaS_newliteral(L, LUA_ERRORMESSAGE));
   luaV_gettable(L, gt(L), &o, &m);
   if (ttype(&m) == LUA_TFUNCTION) {
-    StkId top = L->top;
-    setobj(top, &m);
-    incr_top;
-    setsvalue(top+1, luaS_new(L, s));
-    incr_top;
-    luaD_call(L, top, 0);
+    setobj(L->top, &m);
+    incr_top(L);
+    setsvalue(L->top, luaS_new(L, s));
+    incr_top(L);
+    luaD_call(L, L->top-2, 0);
   }
 }
 
@@ -410,13 +464,7 @@ static void message (lua_State *L, const char *s) {
 ** Reports an error, and jumps up to the available recovery label
 */
 void luaD_error (lua_State *L, const char *s) {
-  if (s) {
-    if (L->ci->savedpc) {  /* error in Lua function preamble? */
-      L->ci->savedpc = NULL;  /* pretend function was already running */
-      L->ci->pc = NULL;
-    }
-    message(L, s);
-  }
+  if (s) message(L, s);
   luaD_breakrun(L, LUA_ERRRUN);
 }
 
@@ -436,8 +484,9 @@ 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 - L->base_ci;
+  lj.ci = L->ci;
   lj.top = L->top;
+  lj.stack = L->stack;
   lj.allowhooks = L->allowhooks;
   lj.status = 0;
   lj.previous = L->errorJmp;  /* chain new error handler */
@@ -445,7 +494,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 = L->base_ci + lj.ci;
+    L->ci = lj.ci;
     L->top = lj.top;
     L->allowhooks = lj.allowhooks;
     restore_stack_limit(L);

ldo.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.h,v 1.38 2002/01/11 20:24:39 roberto Exp $
+** $Id: ldo.h,v 1.1 2001/11/29 22:14:34 rieru Exp rieru $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -16,10 +16,10 @@
 ** macro to increment stack top.
 ** There must be always an empty slot at the L->stack.top
 */
-#define incr_top {if (L->top == L->stack_last) luaD_checkstack(L, 1); L->top++;}
+#define incr_top(L) \
+	{if (L->top >= L->stack_last) luaD_growstack(L, 1); L->top++;}
 
-
-#define luaD_checkstack(L,n) if (L->stack_last-(n)<=L->top) luaD_stackerror(L)
+#define luaD_checkstack(L,n) if (L->stack_last-(n)<=L->top) luaD_growstack(L, n)
 
 
 void luaD_lineHook (lua_State *L, int line, lua_Hook linehook);
@@ -27,7 +27,9 @@ void luaD_callHook (lua_State *L, lua_Hook callhook, const char *event);
 StkId luaD_precall (lua_State *L, StkId func);
 void luaD_call (lua_State *L, StkId func, int nResults);
 void luaD_poscall (lua_State *L, int wanted, StkId firstResult);
-void luaD_stackerror (lua_State *L);
+void luaD_reallocCI (lua_State *L, int newsize);
+void luaD_reallocstack (lua_State *L, int newsize);
+void luaD_growstack (lua_State *L, int n);
 
 void luaD_error (lua_State *L, const char *s);
 void luaD_breakrun (lua_State *L, int errcode);

lgc.c

@@ -20,7 +20,6 @@
 #include "ltm.h"
 
 
-
 typedef struct GCState {
   Table *tmark;  /* list of marked tables to be visited */
   Table *toclear;  /* list of visited weak tables (to be cleared after GC) */
@@ -36,13 +35,14 @@ typedef struct GCState {
 /* mark tricks for userdata */
 #define isudmarked(u)	(u->uv.len & 1)
 #define markud(u)	(u->uv.len |= 1)
-#define unmarkud(u)	(u->uv.len--)
+#define unmarkud(u)	(u->uv.len &= (~(size_t)1))
 
 
 /* mark tricks for upvalues (assume that open upvalues are always marked) */
 #define isupvalmarked(uv)	((uv)->v != &(uv)->value)
 
 
+
 static void markobject (GCState *st, TObject *o);
 
 
@@ -122,6 +122,17 @@ static void markobject (GCState *st, TObject *o) {
 }
 
 
+static void checkstacksizes (lua_State *L, StkId lim) {
+  int used = L->ci - L->base_ci;  /* number of `ci' in use */
+  if (4*used < L->size_ci && 2*BASIC_CI_SIZE < L->size_ci)
+    luaD_reallocCI(L, L->size_ci/2);  /* still big enough... */
+  if (lim < L->top) lim = L->top;
+  used = lim - L->stack;  /* part of stack in use */
+  if (3*used < L->stacksize && 2*BASIC_STACK_SIZE < L->stacksize)
+    luaD_reallocstack(L, L->stacksize/2);  /* still big enough... */
+}
+
+
 static void markstacks (GCState *st) {
   lua_State *L1 = st->L;
   do {  /* for each thread */
@@ -137,6 +148,7 @@ static void markstacks (GCState *st) {
     lim = (L1->stack_last - L1->ci->base > MAXSTACK) ? L1->ci->base+MAXSTACK
                                                      : L1->stack_last;
     for (; o<=lim; o++) setnilvalue(o);
+    checkstacksizes(L1, lim);
     lua_assert(L1->previous->next == L1 && L1->next->previous == L1);
     L1 = L1->next;
   } while (L1 != st->L);
@@ -374,11 +386,10 @@ static void checkMbuffer (lua_State *L) {
 static void do1gcTM (lua_State *L, Udata *udata) {
   const TObject *tm = fasttm(L, udata->uv.eventtable, TM_GC);
   if (tm != NULL) {
-    StkId top = L->top;
-    setobj(top, tm);
-    setuvalue(top+1, udata);
+    setobj(L->top, tm);
+    setuvalue(L->top+1, udata);
     L->top += 2;
-    luaD_call(L, top, 0);
+    luaD_call(L, L->top - 2, 0);
   }
 }
 
@@ -396,6 +407,7 @@ static void unprotectedcallGCTM (lua_State *L, void *pu) {
     do1gcTM(L, udata);
     /* mark udata as finalized (default event table) */
     uvalue(L->top-1)->uv.eventtable = hvalue(defaultet(L));
+    unmarkud(uvalue(L->top-1));
   }
   L->top--;
 }

llimits.h

@@ -72,11 +72,6 @@ typedef unsigned char lu_byte;
 
 
 
-#ifndef DEFAULT_STACK_SIZE
-#define DEFAULT_STACK_SIZE      1024
-#endif
-
-
 
 /* type to ensure maximum alignment */
 #ifndef LUSER_ALIGNMENT_T

lstate.c

@@ -20,6 +20,7 @@
 #include "ltm.h"
 
 
+
 struct Sopen {
   int stacksize;
   lua_State *L;
@@ -29,21 +30,21 @@ struct Sopen {
 static void close_state (lua_State *L);
 
 
-static void stack_init (lua_State *L, lua_State *OL, int stacksize) {
-  if (stacksize == 0)
-    stacksize = DEFAULT_STACK_SIZE;
+static void stack_init (lua_State *L, lua_State *OL, int maxstacksize) {
+  if (maxstacksize == 0)
+    maxstacksize = DEFAULT_MAXSTACK;
   else
-    stacksize += LUA_MINSTACK;
-  stacksize += EXTRA_STACK;
-  L->stack = luaM_newvector(OL, stacksize, TObject);
-  L->stacksize = stacksize;
+    maxstacksize += 2*LUA_MINSTACK;
+  L->stack = luaM_newvector(OL, BASIC_STACK_SIZE, TObject);
+  L->maxstacksize = maxstacksize;
+  L->stacksize = BASIC_STACK_SIZE;
   L->top = L->stack + RESERVED_STACK_PREFIX;
-  L->stack_last = L->stack+(L->stacksize-EXTRA_STACK)-1;
-  L->base_ci = luaM_newvector(OL, 10, CallInfo);
+  L->stack_last = L->stack+(BASIC_STACK_SIZE-EXTRA_STACK)-1;
+  L->base_ci = luaM_newvector(OL, BASIC_CI_SIZE, CallInfo);
   L->ci = L->base_ci;
   L->ci->base = L->top;
-  L->ci->savedpc = NULL;
-  L->size_ci = 10;
+  L->ci->pc = NULL;
+  L->size_ci = BASIC_CI_SIZE;
   L->end_ci = L->base_ci + L->size_ci;
 }
 
@@ -84,6 +85,7 @@ static void f_luaopen (lua_State *L, void *ud) {
 static void preinit_state (lua_State *L) {
   L->stack = NULL;
   L->stacksize = 0;
+  L->maxstacksize = 1;
   L->errorJmp = NULL;
   L->callhook = NULL;
   L->linehook = NULL;

lstate.h

@@ -64,8 +64,17 @@ struct lua_longjmp;  /* defined in ldo.c */
 
 #define RESERVED_STACK_PREFIX	3
 
-/* space to handle stack overflow errors */
-#define EXTRA_STACK   (2*LUA_MINSTACK)
+
+/* space to handle TM calls */
+#define EXTRA_STACK   4
+
+
+#define BASIC_CI_SIZE           6
+
+#define BASIC_STACK_SIZE        (2*LUA_MINSTACK)
+
+#define DEFAULT_MAXSTACK        12000
+
 
 
 
@@ -84,6 +93,7 @@ typedef struct CallInfo {
   const Instruction *savedpc;
   StkId	top;  /* top for this function (when it's a Lua function) */
   const Instruction **pc;
+  StkId *pb;
   /* extra information for line tracing */
   int lastpc;  /* last pc traced */
   int line;  /* current line */
@@ -124,6 +134,7 @@ struct lua_State {
   StkId stack_last;  /* last free slot in the stack */
   StkId stack;  /* stack base */
   int stacksize;
+  int maxstacksize;
   CallInfo *end_ci;  /* points after end of ci array*/
   CallInfo *base_ci;  /* array of CallInfo's */
   int size_ci;  /* size of array `base_ci' */

ltests.c

@@ -254,10 +254,14 @@ static int hash_query (lua_State *L) {
 }
 
 
-static int Cstacklevel (lua_State *L) {
+static int stacklevel (lua_State *L) {
   unsigned long a = 0;
+  lua_pushnumber(L, (int)(L->top - L->stack));
+  lua_pushnumber(L, (int)(L->stack_last - L->stack));
+  lua_pushnumber(L, (int)(L->ci - L->base_ci));
+  lua_pushnumber(L, (int)(L->end_ci - L->base_ci));
   lua_pushnumber(L, (unsigned long)&a);
-  return 1;
+  return 5;
 }
 
 
@@ -307,7 +311,7 @@ static int string_query (lua_State *L) {
     int n = 0;
     for (ts = tb->hash[s]; ts; ts = ts->tsv.nexthash) {
       setsvalue(L->top, ts);
-      incr_top;
+      incr_top(L);
       n++;
     }
     return n;
@@ -629,7 +633,7 @@ static const struct luaL_reg tests_funcs[] = {
   {"listk", listk},
   {"listlocals", listlocals},
   {"loadlib", loadlib},
-  {"Cstacklevel", Cstacklevel},
+  {"stacklevel", stacklevel},
   {"querystr", string_query},
   {"querytab", table_query},
   {"testC", testC},

lvm.c

@@ -29,10 +29,9 @@
 
 static void luaV_checkGC (lua_State *L, StkId top) {
   if (G(L)->nblocks >= G(L)->GCthreshold) {
-    StkId temp = L->top;
-    L->top = top;
+    L->top = top;  /* limit for active registers */
     luaC_collectgarbage(L);
-    L->top = temp;  /* restore old top position */
+    L->top = L->ci->top;  /* restore old top position */
   }
 }
 
@@ -83,32 +82,37 @@ static void traceexec (lua_State *L, lua_Hook linehook) {
   if (newline != ci->line || pc <= ci->lastpc) {
     ci->line = newline;
     luaD_lineHook(L, newline, linehook);
+    ci = L->ci;  /* previous call may realocate `ci' */
   }
   ci->lastpc = pc;
 }
 
 
+static void callTMres (lua_State *L, const TObject *f,
+                       const TObject *p1, const TObject *p2, TObject *result ) {
+  StkId stack = L->stack;
+  setobj(L->top, f);  /* push function */
+  setobj(L->top+1, p1);  /* 1st argument */
+  setobj(L->top+2, p2);  /* 2nd argument */
+  luaD_checkstack(L, 3);  /* cannot check before (could invalidate p1, p2) */
+  L->top += 3;
+  luaD_call(L, L->top - 3, 1);
+  if (stack != L->stack)  /* stack changed? */
+    result = (result - stack) + L->stack;  /* correct pointer */
+  setobj(result, --L->top);  /* get result */
+}
+
 
-/* maximum stack used by a call to a tag method (func + args) */
-#define MAXSTACK_TM	4
 
 static void callTM (lua_State *L, const TObject *f,
-     const TObject *p1, const TObject *p2, const TObject *p3, TObject *result ) {
-  StkId base = L->top;
-  luaD_checkstack(L, MAXSTACK_TM);
-  setobj(base, f);  /* push function */
-  setobj(base+1, p1);  /* 1st argument */
-  setobj(base+2, p2);  /* 2nd argument */
-  L->top += 3;
-  if (p3) {
-    setobj(base+3, p3);  /* 3th argument */
-    L->top++;
-  }
-  luaD_call(L, base, 1);
-  if (result) {  /* need a result? */
-    setobj(result, base);  /* get it */
-  }
-  L->top = base;  /* restore top */
+                    const TObject *p1, const TObject *p2, const TObject *p3) {
+  setobj(L->top, f);  /* push function */
+  setobj(L->top+1, p1);  /* 1st argument */
+  setobj(L->top+2, p2);  /* 2nd argument */
+  setobj(L->top+3, p3);  /* 3th argument */
+  luaD_checkstack(L, 4);  /* cannot check before (could invalidate p1...p3) */
+  L->top += 4;
+  luaD_call(L, L->top - 4, 0);
 }
 
 
@@ -139,7 +143,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);
+    callTMres(L, tm, t, key, res);
   else {
     t = (StkId)tm;  /* ?? */
     goto init;  /* return luaV_gettable(L, tm, key, res); */
@@ -167,7 +171,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);
+    callTM(L, tm, t, key, val);
   else {
     t = (StkId)tm;  /* ?? */
     goto init;  /* luaV_settable(L, tm, key, val); */
@@ -181,7 +185,7 @@ static int call_binTM (lua_State *L, const TObject *p1, const TObject *p2,
   if (ttype(tm) == LUA_TNIL)
     tm = luaT_gettmbyobj(L, p2, event);  /* try second operand */
   if (ttype(tm) != LUA_TFUNCTION) return 0;
-  callTM(L, tm, p1, p2, NULL, res);
+  callTMres(L, tm, p1, p2, res);
   return 1;
 }
 
@@ -229,7 +233,6 @@ int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r) {
 
 
 void luaV_strconc (lua_State *L, int total, int last) {
-  luaV_checkGC(L, L->ci->base + last + 1);
   do {
     StkId top = L->ci->base + last + 1;
     int n = 2;  /* number of elements handled in this pass (at least 2) */
@@ -273,7 +276,7 @@ static void powOp (lua_State *L, StkId ra, StkId rb, StkId rc) {
     luaV_gettable(L, gt(L), &o, &f);
     if (ttype(&f) != LUA_TFUNCTION)
       luaD_error(L, "`pow' (for `^' operator) is not a function");
-    callTM(L, &f, b, c, NULL, ra);
+    callTMres(L, &f, b, c, ra);
   }
   else
     call_arith(L, rb, rc, ra, TM_POW);
@@ -324,17 +327,18 @@ StkId luaV_execute (lua_State *L) {
   k = cl->p->k;
   linehook = L->linehook;
   L->ci->pc = &pc;
+  L->ci->pb = &base;
   pc = L->ci->savedpc;
-  L->ci->savedpc = NULL;
   /* main loop of interpreter */
   for (;;) {
     const Instruction i = *pc++;
-    const StkId ra = RA(i);
+    StkId ra;
     if (linehook)
       traceexec(L, linehook);
+    ra = RA(i);
+    lua_assert(L->top <= L->stack + L->stacksize && L->top >= L->ci->base);
     lua_assert(L->top == L->ci->top || GET_OPCODE(i) == OP_CALL ||
          GET_OPCODE(i) == OP_RETURN || GET_OPCODE(i) == OP_SETLISTO);
-    lua_assert(L->ci->savedpc == NULL);
     switch (GET_OPCODE(i)) {
       case OP_MOVE: {
         setobj(ra, RB(i));
@@ -344,10 +348,6 @@ StkId luaV_execute (lua_State *L) {
         setobj(ra, KBc(i));
         break;
       }
-      case OP_LOADINT: {
-        setnvalue(ra, (lua_Number)GETARG_sBc(i));
-        break;
-      }
       case OP_LOADBOOL: {
         setbvalue(ra, GETARG_B(i));
         if (GETARG_C(i)) pc++;  /* skip next instruction (if C) */
@@ -441,8 +441,9 @@ StkId luaV_execute (lua_State *L) {
       case OP_CONCAT: {
         int b = GETARG_B(i);
         int c = GETARG_C(i);
-        luaV_strconc(L, c-b+1, c);
-        setobj(ra, base+b);
+        luaV_strconc(L, c-b+1, c);  /* this call may change `base' (and `ra') */
+        setobj(base+GETARG_A(i), base+b);
+        luaV_checkGC(L, base+c+1);
         break;
       }
       case OP_JMP: {
@@ -493,7 +494,7 @@ StkId luaV_execute (lua_State *L) {
         nresults = GETARG_C(i) - 1;
         firstResult = luaD_precall(L, ra);
         if (firstResult) {
-          if (firstResult == base) {  /* yield?? */
+          if (firstResult > L->top) {  /* yield? */
             (L->ci-1)->savedpc = pc;
             return NULL;
           }
@@ -514,16 +515,16 @@ StkId luaV_execute (lua_State *L) {
         b = GETARG_B(i);
         if (b != 0) L->top = ra+b-1;
         ci = L->ci - 1;
-        if (ci->savedpc == NULL)
-          return ra;
-        else {  /* previous function is Lua: continue its execution */
+        lua_assert((ci+1)->pc == &pc);
+        if (ci->pc != &pc)  /* previous function was running `here'? */
+          return ra;  /* no: return */
+        else {  /* yes: continue its execution */
           int nresults;
           lua_assert(ttype(ci->base-1) == LUA_TFUNCTION);
           base = ci->base;  /* restore previous values */
           cl = &clvalue(base - 1)->l;
           k = cl->p->k;
           pc = ci->savedpc;
-          ci->savedpc = NULL;
           lua_assert(GET_OPCODE(*(pc-1)) == OP_CALL);
           nresults = GETARG_C(*(pc-1)) - 1;
           luaD_poscall(L, nresults, ra);
@@ -607,7 +608,6 @@ StkId luaV_execute (lua_State *L) {
         Proto *p;
         Closure *ncl;
         int nup, j;
-        luaV_checkGC(L, L->top);
         p = cl->p->p[GETARG_Bc(i)];
         nup = p->nupvalues;
         ncl = luaF_newLclosure(L, nup);
@@ -621,6 +621,7 @@ StkId luaV_execute (lua_State *L) {
           }
         }
         setclvalue(ra, ncl);
+        luaV_checkGC(L, L->top);
         break;
       }
     }