threads now are real Lua objects, subject to garbage collection

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.212 2002/08/30 19:09:21 roberto Exp roberto $
+** $Id: lapi.c,v 1.213 2002/09/20 17:01:24 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -115,6 +115,18 @@ LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
 }
 
 
+LUA_API lua_State *lua_newthread (lua_State *L) {
+  lua_State *L1;
+  lua_lock(L);
+  L1 = luaE_newthread(L);
+  setthvalue(L->top, L1);
+  api_incr_top(L);
+  lua_unlock(L);
+  lua_userstateopen(L1);
+  return L1;
+}
+
+
 /*
 ** basic stack manipulation
 */
@@ -322,6 +334,12 @@ LUA_API void *lua_touserdata (lua_State *L, int index) {
 }
 
 
+LUA_API lua_State *lua_tothread (lua_State *L, int index) {
+  StkId o = luaA_indexAcceptable(L, index);
+  return (o == NULL || !ttisthread(o)) ? NULL : thvalue(o);
+}
+
+
 LUA_API const void *lua_topointer (lua_State *L, int index) {
   StkId o = luaA_indexAcceptable(L, index);
   if (o == NULL) return NULL;

lbaselib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.99 2002/09/16 19:49:45 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.100 2002/10/22 19:41:08 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@@ -362,6 +362,9 @@ static int luaB_tostring (lua_State *L) {
     case LUA_TLIGHTUSERDATA:
       sprintf(buff, "userdata: %p", lua_touserdata(L, 1));
       break;
+    case LUA_TTHREAD:
+      sprintf(buff, "thread: %p", (void *)lua_tothread(L, 1));
+      break;
     case LUA_TNIL:
       lua_pushliteral(L, "nil");
       return 1;
@@ -535,26 +538,40 @@ static const luaL_reg base_funcs[] = {
 */
 
 
-static int luaB_resume (lua_State *L) {
-  lua_State *co = (lua_State *)lua_unboxpointer(L, lua_upvalueindex(1));
+static int luaB_auxresume (lua_State *L, lua_State *co) {
   int status;
-  lua_settop(L, 0);
+  int oldtop = lua_gettop(L);
   status = lua_resume(L, co);
-  if (status != 0)
-    return lua_error(L);
-  return lua_gettop(L);
+  return (status != 0) ? -1 : lua_gettop(L) - oldtop;
 }
 
 
+static int luaB_coresume (lua_State *L) {
+  lua_State *co = lua_tothread(L, 1);
+  int r;
+  luaL_arg_check(L, co, 1, "coroutine/thread expected");
+  r = luaB_auxresume(L, co);
+  if (r < 0) {
+    lua_pushboolean(L, 0);
+    lua_insert(L, -2);
+    return 2;  /* return false + error message */
+  }
+  else {
+    lua_pushboolean(L, 1);
+    lua_insert(L, -(r + 1));
+    return r + 1;  /* return true + `resume' returns */
+  }
+}
+
 
-static int gc_coroutine (lua_State *L) {
-  lua_State *co = (lua_State *)lua_unboxpointer(L, 1);
-  lua_closethread(L, co);
-  return 0;
+static int luaB_auxwrap (lua_State *L) {
+  int r = luaB_auxresume(L, lua_tothread(L, lua_upvalueindex(1)));
+  if (r < 0) lua_error(L);
+  return r;
 }
 
 
-static int luaB_coroutine (lua_State *L) {
+static int luaB_cocreate (lua_State *L) {
   lua_State *NL;
   int ref;
   int i;
@@ -562,20 +579,21 @@ static int luaB_coroutine (lua_State *L) {
   luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
     "Lua function expected");
   NL = lua_newthread(L);
-  if (NL == NULL) return luaL_error(L, "unable to create new thread");
   /* move function and arguments from L to NL */
-  for (i=0; i<n; i++) {
+  for (i = 1; i <= n; i++) {
+    lua_pushvalue(L, i);
     ref = lua_ref(L, 1);
     lua_getref(NL, ref);
-    lua_insert(NL, 1);
     lua_unref(L, ref);
   }
   lua_cobegin(NL, n-1);
-  lua_boxpointer(L, NL);
-  lua_pushliteral(L, "Coroutine");
-  lua_rawget(L, LUA_REGISTRYINDEX);
-  lua_setmetatable(L, -2);
-  lua_pushcclosure(L, luaB_resume, 1);
+  return 1;
+}
+
+
+static int luaB_cowrap (lua_State *L) {
+  luaB_cocreate(L);
+  lua_pushcclosure(L, luaB_auxwrap, 1);
   return 1;
 }
 
@@ -585,23 +603,13 @@ static int luaB_yield (lua_State *L) {
 }
 
 static const luaL_reg co_funcs[] = {
-  {"create", luaB_coroutine},
+  {"create", luaB_cocreate},
+  {"wrap", luaB_cowrap},
+  {"resume", luaB_coresume},
   {"yield", luaB_yield},
   {NULL, NULL}
 };
 
-
-static void co_open (lua_State *L) {
-  luaL_opennamedlib(L, LUA_COLIBNAME, co_funcs, 0);
-  /* create metatable for coroutines */
-  lua_pushliteral(L, "Coroutine");
-  lua_newtable(L);
-  lua_pushliteral(L, "__gc");
-  lua_pushcfunction(L, gc_coroutine);
-  lua_rawset(L, -3);
-  lua_rawset(L, LUA_REGISTRYINDEX);
-}
-
 /* }====================================================== */
 
 
@@ -625,7 +633,7 @@ static void base_open (lua_State *L) {
 
 LUALIB_API int lua_baselibopen (lua_State *L) {
   base_open(L);
-  co_open(L);
+  luaL_opennamedlib(L, LUA_COLIBNAME, co_funcs, 0);
   lua_newtable(L);
   lua_setglobal(L, REQTAB);
   return 0;

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.195 2002/10/08 18:46:08 roberto Exp roberto $
+** $Id: ldo.c,v 1.196 2002/10/09 13:42:01 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -343,16 +343,22 @@ LUA_API int lua_resume (lua_State *L, lua_State *co) {
   int status;
   lua_lock(L);
   ci = co->ci;
-  if (ci == co->base_ci)  /* no activation record? ?? */
-    luaG_runerror(L, "cannot resume dead thread");
-  if (co->errorJmp != NULL)  /* ?? */
-    luaG_runerror(L, "cannot resume active thread");
-  status = luaD_rawrunprotected(co, resume, &numres);
-  if (status == 0)  
-    move_results(L, co->top - numres, co->top);
+  if (ci == co->base_ci) {  /* no activation record? ?? */
+    luaO_pushfstring(L, "cannot resume dead thread");
+    status = LUA_ERRRUN;
+  }
+  else if (co->errorJmp != NULL) {  /* ?? */
+    luaO_pushfstring(L, "cannot resume active thread");
+    status = LUA_ERRRUN;
+  }
   else {
-    setobj(L->top++, co->top - 1);  /* move error message to other stack */
-    co->ci = co->base_ci;  /* `kill' thread */
+    status = luaD_rawrunprotected(co, resume, &numres);
+    if (status == 0)  
+      move_results(L, co->top - numres, co->top);
+    else {
+      setobj(L->top++, co->top - 1);  /* move error message to other stack */
+      co->ci = co->base_ci;  /* `kill' thread */
+    }
   }
   lua_unlock(L);
   return status;

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.152 2002/10/08 18:46:08 roberto Exp roberto $
+** $Id: lgc.c,v 1.153 2002/10/22 17:58:14 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -99,6 +99,32 @@ static void markclosure (GCState *st, Closure *cl) {
 }
 
 
+static void checkstacksizes (lua_State *L, StkId max) {
+  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... */
+  used = max - L->stack;  /* part of stack in use */
+  if (4*used < L->stacksize && 2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)
+    luaD_reallocstack(L, L->stacksize/2);  /* still big enough... */
+}
+
+
+static void markstack (GCState *st, lua_State *L1) {
+  StkId o, lim;
+  CallInfo *ci;
+  markobject(st, gt(L1));
+  for (o=L1->stack; o<L1->top; o++)
+    markobject(st, o);
+  lim = o;
+  for (ci = L1->base_ci; ci <= L1->ci; ci++) {
+    lua_assert(ci->top <= L1->stack_last);
+    if (lim < ci->top) lim = ci->top;
+  }
+  for (; o<=lim; o++) setnilvalue(o);
+  checkstacksizes(L1, lim);
+}
+
+
 static void reallymarkobject (GCState *st, GCObject *o) {
   setbit(o->gch.marked, 0);  /* mark object */
   switch (o->gch.tt) {
@@ -115,46 +141,11 @@ static void reallymarkobject (GCState *st, GCObject *o) {
       st->tmark = &o->h;
       break;
     }
-  }
-}
-
-
-static void checkstacksizes (lua_State *L, StkId max) {
-  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... */
-  used = max - L->stack;  /* part of stack in use */
-  if (4*used < L->stacksize && 2*(BASIC_STACK_SIZE+EXTRA_STACK) < L->stacksize)
-    luaD_reallocstack(L, L->stacksize/2);  /* still big enough... */
-}
-
-
-static void traversestacks (GCState *st) {
-  lua_State *L1 = st->L;
-  do {  /* for each thread */
-    StkId o, lim;
-    CallInfo *ci;
-    if (ttisnil(gt(L1))) {  /* incomplete state? */
-      lua_assert(L1 != st->L);
-      L1 = L1->next;
-      luaE_closethread(st->L, L1->previous);  /* collect it */
-      continue;
-    }
-    markobject(st, gt(L1));
-    for (o=L1->stack; o<L1->top; o++)
-      markobject(st, o);
-    lim = o;
-    for (ci = L1->base_ci; ci <= L1->ci; ci++) {
-      lua_assert(ci->top <= L1->stack_last);
-      if (lim < ci->top) lim = ci->top;
+    case LUA_TTHREAD: {
+      markstack(st, &o->th);
+      break;
     }
-    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);
-  markobject(st, defaultmeta(L1));
-  markobject(st, registry(L1));
+  }
 }
 
 
@@ -292,6 +283,11 @@ static void freeobj (lua_State *L, GCObject *o) {
     case LUA_TFUNCTION: luaF_freeclosure(L, &o->cl); break;
     case LUA_TUPVAL: luaM_freelem(L, &o->uv); break;
     case LUA_TTABLE: luaH_free(L, &o->h); break;
+    case LUA_TTHREAD: {
+      lua_assert(&o->th != L && &o->th != G(L)->mainthread);
+      luaE_freethread(L, &o->th);
+      break;
+    }
     case LUA_TSTRING: {
       luaM_free(L, o, sizestring((&o->ts)->tsv.len));
       break;
@@ -389,13 +385,24 @@ void luaC_sweep (lua_State *L, int all) {
 }
 
 
+/* mark root set */
+static void markroot (GCState *st) {
+  lua_State *L = st->L;
+  markobject(st, defaultmeta(L));
+  markobject(st, registry(L));
+  markstack(st, G(L)->mainthread);
+  if (L != G(L)->mainthread)  /* another thread is running? */
+    reallymarkobject(st, cast(GCObject *, L));  /* cannot collect it */
+}
+
+
 static void mark (lua_State *L) {
   GCState st;
   Table *toclear;
   st.L = L;
   st.tmark = NULL;
   st.toclear = NULL;
-  traversestacks(&st); /* mark all stacks */
+  markroot(&st);
   propagatemarks(&st);  /* mark all reachable objects */
   toclear = st.toclear;  /* weak tables; to be cleared */
   st.toclear = NULL;

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.148 2002/10/16 20:40:58 roberto Exp roberto $
+** $Id: lobject.h,v 1.149 2002/10/22 17:18:28 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -13,7 +13,7 @@
 
 
 /* tags for values visible from Lua */
-#define NUM_TAGS	LUA_TUSERDATA
+#define NUM_TAGS	LUA_TTHREAD
 
 
 /*
@@ -23,23 +23,34 @@
 #define LUA_TUPVAL	(NUM_TAGS+2)
 
 
+/*
+** Union of all collectable objects
+*/
+typedef union GCObject GCObject;
+
+
 /*
 ** Common header for all collectable objects
 */
 typedef struct GCheader {
-  union GCObject *next;  /* pointer to next object */
+  GCObject *next;  /* pointer to next object */
   lu_byte tt;  /* object type */
   lu_byte marked;  /* GC informations */
 } GCheader;
 
 
+/*
+** common header in macro form, to be included in other objects
+*/
+#define CommonHeader	GCObject *next; lu_byte tt; lu_byte marked
+
 
 
 /*
 ** Union of all Lua values
 */
 typedef union {
-  union GCObject *gc;
+  GCObject *gc;
   void *p;
   lua_Number n;
   int b;
@@ -63,6 +74,7 @@ typedef struct lua_TObject {
 #define ttisfunction(o)	(ttype(o) == LUA_TFUNCTION)
 #define ttisboolean(o)	(ttype(o) == LUA_TBOOLEAN)
 #define ttisuserdata(o)	(ttype(o) == LUA_TUSERDATA)
+#define ttisthread(o)	(ttype(o) == LUA_TTHREAD)
 #define ttislightuserdata(o)	(ttype(o) == LUA_TLIGHTUSERDATA)
 
 /* Macros to access values */
@@ -75,6 +87,7 @@ typedef struct lua_TObject {
 #define clvalue(o)	check_exp(ttisfunction(o), &(o)->value.gc->cl)
 #define hvalue(o)	check_exp(ttistable(o), &(o)->value.gc->h)
 #define bvalue(o)	check_exp(ttisboolean(o), (o)->value.b)
+#define thvalue(o)	check_exp(ttisthread(o), &(o)->value.gc->th)
 
 #define l_isfalse(o)	(ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
 
@@ -101,6 +114,11 @@ typedef struct lua_TObject {
     i_o->value.gc=cast(GCObject *, (x)); \
     lua_assert(i_o->value.gc->gch.tt == LUA_TUSERDATA); }
 
+#define setthvalue(obj,x) \
+  { TObject *i_o=(obj); i_o->tt=LUA_TTHREAD; \
+    i_o->value.gc=cast(GCObject *, (x)); \
+    lua_assert(i_o->value.gc->gch.tt == LUA_TTHREAD); }
+
 #define setclvalue(obj,x) \
   { TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; \
     i_o->value.gc=cast(GCObject *, (x)); \
@@ -142,9 +160,7 @@ typedef TObject *StkId;  /* index to stack elements */
 typedef union TString {
   L_Umaxalign dummy;  /* ensures maximum alignment for strings */
   struct {
-    union GCObject *next;  /* pointer to next object */
-    lu_byte tt;  /* object type */
-    lu_byte marked;  /* GC informations */
+    CommonHeader;
     lu_byte reserved;
     lu_hash hash;
     size_t len;
@@ -160,9 +176,7 @@ typedef union TString {
 typedef union Udata {
   L_Umaxalign dummy;  /* ensures maximum alignment for `local' udata */
   struct {
-    union GCObject *next;  /* pointer to next object */
-    lu_byte tt;  /* object type */
-    lu_byte marked;  /* GC informations */
+    CommonHeader;
     struct Table *metatable;
     size_t len;
   } uv;
@@ -175,9 +189,7 @@ typedef union Udata {
 ** Function Prototypes
 */
 typedef struct Proto {
-  union GCObject *next;  /* pointer to next object */
-  lu_byte tt;  /* object type */
-  lu_byte marked;  /* GC informations */
+  CommonHeader;
   TObject *k;  /* constants used by the function */
   Instruction *code;
   struct Proto **p;  /* functions defined inside the function */
@@ -210,9 +222,7 @@ typedef struct LocVar {
 */
 
 typedef struct UpVal {
-  union GCObject *next;  /* pointer to next object */
-  lu_byte tt;  /* object type */
-  lu_byte marked;  /* GC informations */
+  CommonHeader;
   TObject *v;  /* points to stack or to its own value */
   TObject value;  /* the value (when closed) */
 } UpVal;
@@ -223,9 +233,7 @@ typedef struct UpVal {
 */
 
 typedef struct CClosure {
-  union GCObject *next;  /* pointer to next object */
-  lu_byte tt;  /* object type */
-  lu_byte marked;  /* GC informations */
+  CommonHeader;
   lu_byte isC;  /* 0 for Lua functions, 1 for C functions */
   lu_byte nupvalues;
   lua_CFunction f;
@@ -234,9 +242,7 @@ typedef struct CClosure {
 
 
 typedef struct LClosure {
-  union GCObject *next;  /* pointer to next object */
-  lu_byte tt;  /* object type */
-  lu_byte marked;  /* GC informations */
+  CommonHeader;
   lu_byte isC;
   lu_byte nupvalues;  /* first five fields must be equal to CClosure!! */
   struct Proto *p;
@@ -267,9 +273,7 @@ typedef struct Node {
 
 
 typedef struct Table {
-  union GCObject *next;  /* pointer to next object */
-  lu_byte tt;  /* object type */
-  lu_byte marked;  /* GC informations */
+  CommonHeader;
   lu_byte flags;  /* 1<<p means tagmethod(p) is not present */ 
   lu_byte mode;
   lu_byte lsizenode;  /* log2 of size of `node' array */
@@ -298,19 +302,6 @@ typedef struct Table {
 #define sizearray(t)	((t)->sizearray)
 
 
-/*
-** Union of all collectable objects
-*/
-typedef union GCObject {
-  GCheader gch;
-  union TString ts;
-  union Udata u;
-  union Closure cl;
-  struct Table h;
-  struct Proto p;
-  struct UpVal uv;
-} GCObject;
-
 
 extern const TObject luaO_nilobject;
 

lstate.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 1.106 2002/10/08 18:46:08 roberto Exp roberto $
+** $Id: lstate.c,v 1.107 2002/10/22 17:58:14 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -19,11 +19,30 @@
 #include "ltm.h"
 
 
+/*
+** macro to allow the inclusion of user information in Lua state
+*/
+#ifndef LUA_USERSTATE
+#define EXTRASPACE	0
+#else
+union UEXTRASPACE {L_Umaxalign a; LUA_USERSTATE b;};
+#define EXTRASPACE (sizeof(UEXTRASPACE))
+#endif
 
 
 static void close_state (lua_State *L);
 
 
+static lua_State *newthread (lua_State *L) {
+  lu_byte *block = (lu_byte *)luaM_malloc(L, sizeof(lua_State) + EXTRASPACE);
+  if (block == NULL) return NULL;
+  else {
+    block += EXTRASPACE;
+    return cast(lua_State *, block);
+  }
+}
+
+
 /*
 ** you can change this function through the official API:
 ** call `lua_setpanicf'
@@ -34,19 +53,19 @@ static int default_panic (lua_State *L) {
 }
 
 
-static void stack_init (lua_State *L, lua_State *OL) {
-  L->stack = luaM_newvector(OL, BASIC_STACK_SIZE + EXTRA_STACK, TObject);
-  L->stacksize = BASIC_STACK_SIZE + EXTRA_STACK;
-  L->top = L->stack;
-  L->stack_last = L->stack+(L->stacksize - EXTRA_STACK)-1;
-  L->base_ci = luaM_newvector(OL, BASIC_CI_SIZE, CallInfo);
-  L->ci = L->base_ci;
-  L->ci->state = CI_C;  /*  not a Lua function */
-  setnilvalue(L->top++);  /* `function' entry for this `ci' */
-  L->ci->base = L->top;
-  L->ci->top = L->top + LUA_MINSTACK;
-  L->size_ci = BASIC_CI_SIZE;
-  L->end_ci = L->base_ci + L->size_ci;
+static void stack_init (lua_State *L1, lua_State *L) {
+  L1->stack = luaM_newvector(L, BASIC_STACK_SIZE + EXTRA_STACK, TObject);
+  L1->stacksize = BASIC_STACK_SIZE + EXTRA_STACK;
+  L1->top = L1->stack;
+  L1->stack_last = L1->stack+(L1->stacksize - EXTRA_STACK)-1;
+  L1->base_ci = luaM_newvector(L, BASIC_CI_SIZE, CallInfo);
+  L1->ci = L1->base_ci;
+  L1->ci->state = CI_C;  /*  not a Lua function */
+  setnilvalue(L1->top++);  /* `function' entry for this `ci' */
+  L1->ci->base = L1->top;
+  L1->ci->top = L1->top + LUA_MINSTACK;
+  L1->size_ci = BASIC_CI_SIZE;
+  L1->end_ci = L1->base_ci + L1->size_ci;
 }
 
 
@@ -57,6 +76,7 @@ static void f_luaopen (lua_State *L, void *ud) {
   UNUSED(ud);
   /* create a new global state */
   L->l_G = luaM_new(L, global_State);
+  G(L)->mainthread = L;
   G(L)->GCthreshold = 0;  /* mark it as unfinished state */
   G(L)->strt.size = 0;
   G(L)->strt.nuse = 0;
@@ -103,31 +123,22 @@ static void preinit_state (lua_State *L) {
 }
 
 
-LUA_API lua_State *lua_newthread (lua_State *OL) {
-  lua_State *L;
-  lua_lock(OL);
-  L = luaM_new(OL, lua_State);
-  preinit_state(L);
-  L->l_G = OL->l_G;
-  OL->next->previous = L;  /* insert L into linked list */
-  L->next = OL->next;
-  OL->next = L;
-  L->previous = OL;
-  stack_init(L, OL);  /* init stack */
-  setobj(gt(L), gt(OL));  /* share table of globals */
-  lua_unlock(OL);
-  lua_userstateopen(L);
-  return L;
+lua_State *luaE_newthread (lua_State *L) {
+  lua_State *L1 = newthread(L);
+  luaC_link(L, cast(GCObject *, L1), LUA_TTHREAD);
+  preinit_state(L1);
+  L1->l_G = L->l_G;
+  stack_init(L1, L);  /* init stack */
+  setobj(gt(L1), gt(L));  /* share table of globals */
+  return L1;
 }
 
 
 LUA_API lua_State *lua_open (void) {
-  lua_State *L;
-  L = luaM_new(NULL, lua_State);
+  lua_State *L = newthread(NULL);
   if (L) {  /* allocation OK? */
     preinit_state(L);
     L->l_G = NULL;
-    L->next = L->previous = L;
     if (luaD_rawrunprotected(L, f_luaopen, NULL) != 0) {
       /* memory allocation error: free partial state */
       close_state(L);
@@ -139,14 +150,13 @@ LUA_API lua_State *lua_open (void) {
 }
 
 
-void luaE_closethread (lua_State *OL, lua_State *L) {
-  luaF_close(L, L->stack);  /* close all upvalues for this thread */
-  lua_assert(L->openupval == NULL);
-  L->previous->next = L->next;
-  L->next->previous = L->previous;
-  luaM_freearray(OL, L->base_ci, L->size_ci, CallInfo);
-  luaM_freearray(OL, L->stack, L->stacksize, TObject);
-  luaM_freelem(OL, L);
+void luaE_freethread (lua_State *L, lua_State *L1) {
+  luaF_close(L1, L1->stack);  /* close all upvalues for this thread */
+  lua_assert(L1->openupval == NULL);
+  luaM_freearray(L, L1->base_ci, L1->size_ci, CallInfo);
+  luaM_freearray(L, L1->stack, L1->stacksize, TObject);
+  luaM_free(L, cast(lu_byte *, L1) - EXTRASPACE,
+                sizeof(lua_State) + EXTRASPACE);
 }
 
 
@@ -160,24 +170,15 @@ static void close_state (lua_State *L) {
     luaZ_freebuffer(L, &G(L)->buff);
     luaM_freelem(NULL, L->l_G);
   }
-  luaE_closethread(NULL, L);
-}
-
-
-LUA_API void lua_closethread (lua_State *L, lua_State *thread) {
-  lua_lock(L);
-  if (L == thread) luaG_runerror(L, "cannot close only thread of a state");
-  luaE_closethread(L, thread);
-  lua_unlock(L);
+  luaE_freethread(NULL, L);
 }
 
 
 LUA_API void lua_close (lua_State *L) {
   lua_lock(L);
+  L = G(L)->mainthread;  /* only the main thread can be closed */
   luaC_callallgcTM(L);  /* call GC tag methods for all udata */
   lua_assert(G(L)->tmudata == NULL);
-  while (L->next != L)  /* then, close all other threads */
-    luaE_closethread(L, L->next);
   close_state(L);
 }
 

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.97 2002/10/08 18:46:08 roberto Exp roberto $
+** $Id: lstate.h,v 1.98 2002/10/22 17:58:14 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -32,12 +32,6 @@
 #define lua_unlock(L)	((void) 0)
 #endif
 
-/*
-** macro to allow the inclusion of user information in Lua state
-*/
-#ifndef LUA_USERSTATE
-#define LUA_USERSTATE
-#endif
 
 #ifndef lua_userstateopen
 #define lua_userstateopen(l)
@@ -124,6 +118,7 @@ typedef struct global_State {
   lua_CFunction panic;  /* to be called in unprotected errors */
   TObject _registry;
   TObject _defaultmeta;
+  struct lua_State *mainthread;
   Node dummynode[1];  /* common node array for all empty tables */
   TString *tmname[TM_N];  /* array with tag-method names */
 } global_State;
@@ -133,7 +128,7 @@ typedef struct global_State {
 ** `per thread' state
 */
 struct lua_State {
-  LUA_USERSTATE
+  CommonHeader;
   StkId top;  /* first free slot in the stack */
   global_State *l_G;
   CallInfo *ci;  /* call info for current function */
@@ -150,15 +145,29 @@ struct lua_State {
   GCObject *openupval;  /* list of open upvalues in this stack */
   struct lua_longjmp *errorJmp;  /* current error recover point */
   ptrdiff_t errfunc;  /* current error handling function (stack index) */
-  lua_State *next;  /* circular double linked list of states */
-  lua_State *previous;
 };
 
 
 #define G(L)	(L->l_G)
 
 
-void luaE_closethread (lua_State *OL, lua_State *L);
+/*
+** Union of all collectable objects
+*/
+union GCObject {
+  GCheader gch;
+  union TString ts;
+  union Udata u;
+  union Closure cl;
+  struct Table h;
+  struct Proto p;
+  struct UpVal uv;
+  struct lua_State th;  /* thread */
+};
+
+
+lua_State *luaE_newthread (lua_State *L);
+void luaE_freethread (lua_State *L, lua_State *L1);
 
 #endif
 

ltests.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.c,v 1.136 2002/10/22 17:18:28 roberto Exp roberto $
+** $Id: ltests.c,v 1.137 2002/10/22 18:07:55 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -403,7 +403,6 @@ static int doonnewstack (lua_State *L) {
   if (status == 0)
     status = lua_pcall(L1, 0, 0, 0);
   lua_pushnumber(L, status);
-  lua_closethread(L, L1);
   return 1;
 }
 
@@ -423,7 +422,7 @@ static int d2s (lua_State *L) {
 static int newstate (lua_State *L) {
   lua_State *L1 = lua_open();
   if (L1) {
-    *cast(int **, L1) = &islocked;  /* initialize the lock */
+    lua_userstateopen(L1);  /* init lock */
     lua_pushnumber(L, (unsigned long)L1);
   }
   else
@@ -724,7 +723,7 @@ static void fim (void) {
 
 
 int luaB_opentests (lua_State *L) {
-  *cast(int **, L) = &islocked;  /* init lock */
+  lua_userstateopen(L);  /* init lock */
   lua_state = L;  /* keep first state to be opened */
   luaL_opennamedlib(L, "T", tests_funcs, 0);
   atexit(fim);

ltests.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.h,v 1.15 2002/07/17 16:25:13 roberto Exp roberto $
+** $Id: ltests.h,v 1.16 2002/10/08 18:45:07 roberto Exp roberto $
 ** Internal Header for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -42,10 +42,11 @@ void *debug_realloc (void *block, size_t oldsize, size_t size);
 
 /* test for lock/unlock */
 extern int islocked;
-#define LUA_USERSTATE	int *lock;
-#define lua_userstateopen(l) if (l != NULL) *cast(int **, l) = &islocked;
-#define lua_lock(L)     lua_assert((**cast(int **, L))++ == 0)
-#define lua_unlock(L)   lua_assert(--(**cast(int **, L)) == 0)
+#define LUA_USERSTATE	int *
+#define getlock(l)	(*(cast(int **, l) - 1))
+#define lua_userstateopen(l) if (l != NULL) getlock(l) = &islocked;
+#define lua_lock(l)     lua_assert((*getlock(l))++ == 0)
+#define lua_unlock(l)   lua_assert(--(*getlock(l)) == 0)
 
 
 int luaB_opentests (lua_State *L);

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.101 2002/08/30 19:09:21 roberto Exp roberto $
+** $Id: ltm.c,v 1.102 2002/09/19 20:12:47 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -19,7 +19,7 @@
 
 const char *const luaT_typenames[] = {
   "nil", "boolean", "userdata", "number",
-  "string", "table", "function", "userdata"
+  "string", "table", "function", "userdata", "thread"
 };
 
 

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.158 2002/10/22 17:18:28 roberto Exp roberto $
+** $Id: lua.h,v 1.159 2002/10/22 17:21:25 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
 ** http://www.lua.org	mailto:[email protected]
@@ -70,6 +70,7 @@ typedef const char * (*lua_Chunkreader) (lua_State *L, void *ud, size_t *sz);
 #define LUA_TTABLE	5
 #define LUA_TFUNCTION	6
 #define LUA_TUSERDATA	7
+#define LUA_TTHREAD	8
 
 
 /* minimum Lua stack available to a C function */
@@ -104,7 +105,6 @@ typedef LUA_NUMBER lua_Number;
 LUA_API lua_State *lua_open (void);
 LUA_API void       lua_close (lua_State *L);
 LUA_API lua_State *lua_newthread (lua_State *L);
-LUA_API void       lua_closethread (lua_State *L, lua_State *t);
 
 LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf);
 
@@ -142,6 +142,7 @@ LUA_API const char     *lua_tostring (lua_State *L, int idx);
 LUA_API size_t          lua_strlen (lua_State *L, int idx);
 LUA_API lua_CFunction   lua_tocfunction (lua_State *L, int idx);
 LUA_API void	       *lua_touserdata (lua_State *L, int idx);
+LUA_API lua_State      *lua_tothread (lua_State *L, int idx);
 LUA_API const void     *lua_topointer (lua_State *L, int idx);
 
 

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.256 2002/09/19 20:12:47 roberto Exp roberto $
+** $Id: lvm.c,v 1.257 2002/10/08 18:46:08 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -263,22 +263,23 @@ int luaV_equalval (lua_State *L, const TObject *t1, const TObject *t2) {
   switch (ttype(t1)) {
     case LUA_TNIL: return 1;
     case LUA_TNUMBER: return nvalue(t1) == nvalue(t2);
-    case LUA_TSTRING: return tsvalue(t1) == tsvalue(t2);
     case LUA_TBOOLEAN: return bvalue(t1) == bvalue(t2);  /* true must be 1 !! */
     case LUA_TLIGHTUSERDATA: return pvalue(t1) == pvalue(t2);
-    case LUA_TFUNCTION: return clvalue(t1) == clvalue(t2);
-    case LUA_TUSERDATA:
+    case LUA_TUSERDATA: {
       if (uvalue(t1) == uvalue(t2)) return 1;
       else if ((tm = fasttm(L, uvalue(t1)->uv.metatable, TM_EQ)) == NULL &&
                (tm = fasttm(L, uvalue(t2)->uv.metatable, TM_EQ)) == NULL)
         return 0;  /* no TM */
       else break;  /* will try TM */
-    case LUA_TTABLE:
+    }
+    case LUA_TTABLE: {
       if (hvalue(t1) == hvalue(t2)) return 1;
       else if ((tm = fasttm(L, hvalue(t1)->metatable, TM_EQ)) == NULL &&
                (tm = fasttm(L, hvalue(t2)->metatable, TM_EQ)) == NULL)
         return 0;  /* no TM */
       else break;  /* will try TM */
+    }
+    default: return gcvalue(t1) == gcvalue(t2);
   }
   callTMres(L, tm, t1, t2);  /* call TM */
   return !l_isfalse(L->top);