new version is beta.

to new way to handle growing vectors (previous modification).

bugs

@@ -2,3 +2,76 @@
 Tue Dec  2 10:45:48 EDT 1997
 >> BUG: "lastline" was not reset on function entry, so debug information
 >> started only in the 2nd line of a function.
+
+
+--- Version 3.1 alpha
+
+** lua.c
+Thu Jan 15 14:34:58 EDT 1998
+>> must include "stdlib.h" (for "exit()").
+
+** lbuiltin.c / lobject.h
+Thu Jan 15 14:34:58 EDT 1998
+>> MAX_WORD may be bigger than MAX_INT
+
+
+** llex.c
+Mon Jan 19 18:17:18 EDT 1998
+>> wrong line number (+1) in error report when file starts with "#..."
+
+** lstrlib.c
+Tue Jan 27 15:27:49 EDT 1998
+>> formats like "%020d" were considered too big (3 digits); moreover,
+>> some sistems limit printf to at most 500 chars, so we can limit sizes
+>> to 2 digits (99).
+
+** lapi.c
+Tue Jan 27 17:12:36 EDT 1998
+>> "lua_getstring" may create a new string, so should check GC
+
+** lstring.c / ltable.c
+Wed Jan 28 14:48:12 EDT 1998
+>> tables can become full of "empty" slots, and keep growing without limits.
+
+** lstrlib.c
+Mon Mar  9 15:26:09 EST 1998
+>> gsub('a', '(b?)%1*' ...) loops (because the capture is empty).
+
+** lstrlib.c
+Mon May 18 19:20:00 EST 1998
+>> arguments for "format" 'x', 'X', 'o' and 'u' must be unsigned int.
+
+
+--- Version 3.1
+
+** liolib.c / lauxlib.c
+Mon Sep  7 15:57:02 EST 1998
+>> function "luaL_argerror" prints wrong argument number (from a user's point
+of view) when functions have upvalues.
+
+** lstrlib.c
+Tue Nov 10 17:29:36 EDT 1998
+>> gsub/strfind do not check whether captures are properly finished.
+
+** lbuiltin.c
+Fri Dec 18 11:22:55 EDT 1998
+>> "tonumber" goes crazy with negative numbers in other bases (not 10),
+because "strtol" returns long, not unsigned long.
+
+** lstrlib.c
+Mon Jan  4 10:41:40 EDT 1999
+>> "format" does not check size of format item (such as "%00000...00000d").
+
+** lapi.c
+Wed Feb  3 14:40:21 EDT 1999
+>> getlocal cannot return the local itself, since lua_isstring and
+lua_isnumber can modify it.
+
+** lstrlib.c
+Thu Feb  4 17:08:50 EDT 1999
+>> format "%s" may break limit of "sprintf" on some machines.
+
+
+** lzio.c
+Thu Mar  4 11:49:37 EST 1999
+>> file stream cannot call fread after EOF.

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.18 1998/01/07 16:26:48 roberto Exp roberto $
+** $Id: lapi.c,v 1.41 1999/03/04 21:17:26 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -25,17 +25,16 @@
 
 
 char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
-                   "$Autores:  " LUA_AUTHORS " $";
+                   "$Authors:  " LUA_AUTHORS " $";
 
 
 
-TObject *luaA_Address (lua_Object o)
-{
-  return Address(o);
+TObject *luaA_Address (lua_Object o) {
+  return (o != LUA_NOOBJECT) ?  Address(o) : NULL;
 }
 
 
-static int normalized_type (TObject *o)
+static lua_Type normalized_type (TObject *o)
 {
   int t = ttype(o);
   switch (t) {
@@ -71,12 +70,8 @@ void luaA_packresults (void)
 }
 
 
-int luaA_passresults (void)
-{
-  luaD_checkstack(L->Cstack.num);
-  memcpy(L->stack.top, L->Cstack.lua2C+L->stack.stack,
-         L->Cstack.num*sizeof(TObject));
-  L->stack.top += L->Cstack.num;
+int luaA_passresults (void) {
+  L->Cstack.base = L->Cstack.lua2C;  /* position of first result */
   return L->Cstack.num;
 }
 
@@ -88,24 +83,29 @@ static void checkCparams (int nParams)
 }
 
 
-static lua_Object put_luaObject (TObject *o)
-{
+static lua_Object put_luaObject (TObject *o) {
   luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
   L->stack.stack[L->Cstack.base++] = *o;
   return L->Cstack.base;  /* this is +1 real position (see Ref) */
 }
 
 
-static lua_Object put_luaObjectonTop (void)
-{
+static lua_Object put_luaObjectonTop (void) {
   luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
   L->stack.stack[L->Cstack.base++] = *(--L->stack.top);
   return L->Cstack.base;  /* this is +1 real position (see Ref) */
 }
 
 
-lua_Object lua_pop (void)
-{
+static void top2LC (int n) {
+  /* Put the 'n' elements on the top as the Lua2C contents */
+  L->Cstack.base = (L->stack.top-L->stack.stack);  /* new base */
+  L->Cstack.lua2C = L->Cstack.base-n;  /* position of the new results */
+  L->Cstack.num = n;  /* number of results */
+}
+
+
+lua_Object lua_pop (void) {
   checkCparams(1);
   return put_luaObjectonTop();
 }
@@ -150,12 +150,12 @@ lua_Object lua_settagmethod (int tag, char *event)
 }
 
 
-lua_Object lua_seterrormethod (void)
-{
-  TObject temp = L->errorim;
+lua_Object lua_seterrormethod (void) {
+  lua_Object temp;
   checkCparams(1);
-  L->errorim = *(--L->stack.top);
-  return put_luaObject(&temp);
+  temp = lua_getglobal("_ERRORMESSAGE");
+  lua_setglobal("_ERRORMESSAGE");
+  return temp;
 }
 
 
@@ -173,28 +173,23 @@ lua_Object lua_rawgettable (void)
   if (ttype(L->stack.top-2) != LUA_T_ARRAY)
     lua_error("indexed expression not a table in rawgettable");
   else {
-    TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1);
+    *(L->stack.top-2) = *luaH_get(avalue(L->stack.top-2), L->stack.top-1);
     --L->stack.top;
-    if (h != NULL)
-      *(L->stack.top-1) = *h;
-    else
-      ttype(L->stack.top-1) = LUA_T_NIL;
   }
   return put_luaObjectonTop();
 }
 
 
-void lua_settable (void)
-{
+void lua_settable (void) {
   checkCparams(3);
-  luaV_settable(L->stack.top-3, 1);
+  luaV_settable(L->stack.top-3);
+  L->stack.top -= 2;  /* pop table and index */
 }
 
 
-void lua_rawsettable (void)
-{
+void lua_rawsettable (void) {
   checkCparams(3);
-  luaV_settable(L->stack.top-3, 0);
+  luaV_rawsettable(L->stack.top-3);
 }
 
 
@@ -219,7 +214,7 @@ lua_Object lua_getglobal (char *name)
 lua_Object lua_rawgetglobal (char *name)
 {
   TaggedString *ts = luaS_new(name);
-  return put_luaObject(&ts->u.globalval);
+  return put_luaObject(&ts->u.s.globalval);
 }
 
 
@@ -287,11 +282,20 @@ double lua_getnumber (lua_Object object)
 
 char *lua_getstring (lua_Object object)
 {
+  luaC_checkGC();  /* "tostring" may create a new string */
   if (object == LUA_NOOBJECT || tostring(Address(object)))
     return NULL;
   else return (svalue(Address(object)));
 }
 
+long lua_strlen (lua_Object object)
+{
+  luaC_checkGC();  /* "tostring" may create a new string */
+  if (object == LUA_NOOBJECT || tostring(Address(object)))
+    return 0L;
+  else return (tsvalue(Address(object))->u.s.len);
+}
+
 void *lua_getuserdata (lua_Object object)
 {
   if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
@@ -320,19 +324,23 @@ void lua_pushnumber (double n)
   incr_top;
 }
 
-void lua_pushstring (char *s)
+void lua_pushlstring (char *s, long len)
 {
-  if (s == NULL)
-    ttype(L->stack.top) = LUA_T_NIL;
-  else {
-    tsvalue(L->stack.top) = luaS_new(s);
-    ttype(L->stack.top) = LUA_T_STRING;
-  }
+  tsvalue(L->stack.top) = luaS_newlstr(s, len);
+  ttype(L->stack.top) = LUA_T_STRING;
   incr_top;
   luaC_checkGC();
 }
 
-void lua_pushCclosure (lua_CFunction fn, int n)
+void lua_pushstring (char *s)
+{
+  if (s == NULL)
+    lua_pushnil();
+  else
+    lua_pushlstring(s, strlen(s));
+}
+
+void lua_pushcclosure (lua_CFunction fn, int n)
 {
   if (fn == NULL)
     lua_error("API error - attempt to push a NULL Cfunction");
@@ -341,6 +349,7 @@ void lua_pushCclosure (lua_CFunction fn, int n)
   fvalue(L->stack.top) = fn;
   incr_top;
   luaV_closure(n);
+  luaC_checkGC();
 }
 
 void lua_pushusertag (void *u, int tag)
@@ -390,7 +399,7 @@ int lua_tag (lua_Object lo)
         return o->value.cl->consts[0].ttype;
 #ifdef DEBUG
       case LUA_T_LINE:
-        lua_error("internal error");
+        LUA_INTERNALERROR("invalid type");
 #endif
       default:
         return t;
@@ -412,22 +421,108 @@ void lua_settag (int tag)
       break;
     default:
       luaL_verror("cannot change the tag of a %.20s",
-                  luaO_typenames[-ttype((L->stack.top-1))]);
+                  luaO_typename(L->stack.top-1));
   }
   L->stack.top--;
 }
 
 
+TaggedString *luaA_nextvar (TaggedString *g) {
+  if (g == NULL)
+    g = (TaggedString *)L->rootglobal.next;  /* first variable */
+  else {
+    /* check whether name is in global var list */
+    luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
+    g = (TaggedString *)g->head.next;  /* get next */
+  }
+  while (g && g->u.s.globalval.ttype == LUA_T_NIL)  /* skip globals with nil */
+    g = (TaggedString *)g->head.next;
+  if (g) {
+    ttype(L->stack.top) = LUA_T_STRING; tsvalue(L->stack.top) = g;
+    incr_top;
+    luaA_pushobject(&g->u.s.globalval);
+  }
+  return g;
+}
+
+
+char *lua_nextvar (char *varname) {
+  TaggedString *g = (varname == NULL) ? NULL : luaS_new(varname);
+  g = luaA_nextvar(g);
+  if (g) {
+    top2LC(2);
+    return g->str;
+  }
+  else {
+    top2LC(0);
+    return NULL;
+  }
+}
+
+
+int luaA_next (Hash *t, int i) {
+  int tsize = nhash(t);
+  for (; i<tsize; i++) {
+    Node *n = node(t, i);
+    if (ttype(val(n)) != LUA_T_NIL) {
+      luaA_pushobject(ref(n));
+      luaA_pushobject(val(n));
+      return i+1;  /* index to be used next time */
+    }
+  }
+  return 0;  /* no more elements */
+}
+
+
+int lua_next (lua_Object o, int i) {
+  TObject *t = Address(o);
+  if (ttype(t) != LUA_T_ARRAY)
+    lua_error("API error - object is not a table in `lua_next'"); 
+  i = luaA_next(avalue(t), i);
+  top2LC((i==0) ? 0 : 2);
+  return i;
+}
+
+
+
 /*
-** =======================================================
-** Debug interface
+** {======================================================
+** To manipulate some state information
 ** =======================================================
 */
 
+lua_State *lua_setstate (lua_State *st) {
+  lua_State *old = lua_state;
+  lua_state = st;
+  return old;
+}
 
-/* Hooks */
-lua_CHFunction lua_callhook = NULL;
-lua_LHFunction lua_linehook = NULL;
+lua_LHFunction lua_setlinehook (lua_LHFunction func) {
+  lua_LHFunction old = L->linehook;
+  L->linehook = func;
+  return old;
+}
+
+lua_CHFunction lua_setcallhook (lua_CHFunction func) {
+  lua_CHFunction old = L->callhook;
+  L->callhook = func;
+  return old;
+}
+
+int lua_setdebug (int debug) {
+  int old = L->debug;
+  L->debug = debug;
+  return old;
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Debug interface
+** =======================================================
+*/
 
 
 lua_Function lua_stackedfunction (int level)
@@ -443,6 +538,12 @@ lua_Function lua_stackedfunction (int level)
 }
 
 
+int lua_nups (lua_Function func) {
+  TObject *o = luaA_Address(func);
+  return (!o || normalized_type(o) != LUA_T_CLOSURE) ? 0 : o->value.cl->nelems;
+}
+
+
 int lua_currentline (lua_Function func)
 {
   TObject *f = Address(func);
@@ -451,8 +552,7 @@ int lua_currentline (lua_Function func)
 }
 
 
-lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
-{
+lua_Object lua_getlocal (lua_Function func, int local_number, char **name) {
   /* check whether func is a Lua function */
   if (lua_tag(func) != LUA_T_PROTO)
     return LUA_NOOBJECT;
@@ -463,7 +563,7 @@ lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
     if (*name) {
       /* if "*name", there must be a LUA_T_LINE */
       /* therefore, f+2 points to function base */
-      return Ref((f+2)+(local_number-1));
+      return put_luaObject((f+2)+(local_number-1));
     }
     else
       return LUA_NOOBJECT;
@@ -494,18 +594,17 @@ int lua_setlocal (lua_Function func, int local_number)
 }
 
 
-void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
-{
+void lua_funcinfo (lua_Object func, char **source, int *linedefined) {
   if (!lua_isfunction(func))
     lua_error("API - `funcinfo' called with a non-function value");
   else {
     TObject *f = luaA_protovalue(Address(func));
     if (normalized_type(f) == LUA_T_PROTO) {
-      *filename = tfvalue(f)->fileName->str;
+      *source = tfvalue(f)->source->str;
       *linedefined = tfvalue(f)->lineDefined;
     }
     else {
-      *filename = "(C)";
+      *source = "(C)";
       *linedefined = -1;
     }
   }
@@ -520,16 +619,19 @@ static int checkfunc (TObject *o)
 
 char *lua_getobjname (lua_Object o, char **name)
 { /* try to find a name for given function */
-  set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */
-  if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
-    return "tag-method";
-  else if ((*name = luaS_travsymbol(checkfunc)) != NULL)
+  set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc" */
+  if ((*name = luaS_travsymbol(checkfunc)) != NULL)
     return "global";
+  else if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
+    return "tag-method";
   else return "";
 }
 
+/* }====================================================== */
+
+
 /*
-** =======================================================
+** {======================================================
 ** BLOCK mechanism
 ** =======================================================
 */
@@ -569,6 +671,8 @@ lua_Object lua_getref (int ref)
   return (o ? put_luaObject(o) : LUA_NOOBJECT);
 }
 
+/* }====================================================== */
+
 
 
 #ifdef LUA_COMPAT2_5

lapi.h

@@ -1,6 +1,6 @@
 /*
-** $Id: $
-** auxiliar functions from Lua API
+** $Id: lapi.h,v 1.3 1999/02/22 19:13:12 roberto Exp roberto $
+** Auxiliary functions from Lua API
 ** See Copyright Notice in lua.h
 */
 
@@ -16,5 +16,7 @@ TObject *luaA_Address (lua_Object o);
 void luaA_pushobject (TObject *o);
 void luaA_packresults (void);
 int luaA_passresults (void);
+TaggedString *luaA_nextvar (TaggedString *g);
+int luaA_next (Hash *t, int i);
 
 #endif

lauxlib.c

@@ -1,29 +1,40 @@
 /*
-** $Id: lauxlib.c,v 1.8 1998/01/09 15:06:07 roberto Exp $
-** Auxiliar functions for building Lua libraries
+** $Id: lauxlib.c,v 1.16 1999/03/10 14:19:41 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
 ** See Copyright Notice in lua.h
 */
 
 
 #include <stdarg.h>
 #include <stdio.h>
+#include <string.h>
 
-/* Please Notice: This file uses only the oficial API of Lua
-** Any function declared here could be written as an application
-** function. With care, these functions can be used by other libraries.
+/* Please Notice: This file uses only the official API of Lua
+** Any function declared here could be written as an application function.
+** With care, these functions can be used by other libraries.
 */
+
 #include "lauxlib.h"
 #include "lua.h"
 #include "luadebug.h"
 
 
 
-void luaL_argerror (int numarg, char *extramsg)
-{
+int luaL_findstring (char *name, char *list[]) {
+  int i;
+  for (i=0; list[i]; i++)
+    if (strcmp(list[i], name) == 0)
+      return i;
+  return -1;  /* name not found */
+}
+
+void luaL_argerror (int numarg, char *extramsg) {
+  lua_Function f = lua_stackedfunction(0);
   char *funcname;
-  lua_getobjname(lua_stackedfunction(0), &funcname);
+  lua_getobjname(f, &funcname);
+  numarg -= lua_nups(f);
   if (funcname == NULL)
-    funcname = "???";
+    funcname = "?";
   if (extramsg == NULL)
     luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
   else
@@ -31,17 +42,18 @@ void luaL_argerror (int numarg, char *extramsg)
                     numarg, funcname, extramsg);
 }
 
-char *luaL_check_string (int numArg)
+char *luaL_check_lstr (int numArg, long *len)
 {
   lua_Object o = lua_getparam(numArg);
   luaL_arg_check(lua_isstring(o), numArg, "string expected");
+  if (len) *len = lua_strlen(o);
   return lua_getstring(o);
 }
 
-char *luaL_opt_string (int numArg, char *def)
+char *luaL_opt_lstr (int numArg, char *def, long *len)
 {
   return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
-                              luaL_check_string(numArg);
+                              luaL_check_lstr(numArg, len);
 }
 
 double luaL_check_number (int numArg)
@@ -99,3 +111,23 @@ void luaL_verror (char *fmt, ...)
   lua_error(buff);
 }
 
+
+void luaL_chunkid (char *out, char *source, int len) {
+  len -= 13;  /* 13 = strlen("string ''...\0") */
+  if (*source == '@')
+    sprintf(out, "file `%.*s'", len, source+1);
+  else if (*source == '(')
+    strcpy(out, "(C code)");
+  else {
+    char *b = strchr(source , '\n');  /* stop string at first new line */
+    int lim = (b && (b-source)<len) ? b-source : len;
+    sprintf(out, "string `%.*s'", lim, source);
+    strcpy(out+lim+(13-5), "...'");  /* 5 = strlen("...'\0") */
+  }
+}
+
+
+void luaL_filesource (char *out, char *filename, int len) {
+  if (filename == NULL) filename = "(stdin)";
+  sprintf(out, "@%.*s", len-2, filename);  /* -2 for '@' and '\0' */
+}

lauxlib.h

@@ -1,6 +1,6 @@
 /*
-** $Id: lauxlib.h,v 1.5 1997/12/17 20:48:58 roberto Exp roberto $
-** Auxiliar functions for building Lua libraries
+** $Id: lauxlib.h,v 1.11 1999/03/04 21:17:26 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
 ** See Copyright Notice in lua.h
 */
 
@@ -23,10 +23,16 @@ struct luaL_reg {
 
 void luaL_openlib (struct luaL_reg *l, int n);
 void luaL_argerror (int numarg, char *extramsg);
-char *luaL_check_string (int numArg);
-char *luaL_opt_string (int numArg, char *def);
+#define luaL_check_string(n)  (luaL_check_lstr((n), NULL))
+char *luaL_check_lstr (int numArg, long *len);
+#define luaL_opt_string(n, d) (luaL_opt_lstr((n), (d), NULL))
+char *luaL_opt_lstr (int numArg, char *def, long *len);
 double luaL_check_number (int numArg);
+#define luaL_check_int(n)	((int)luaL_check_number(n))
+#define luaL_check_long(n)	((long)luaL_check_number(n))
 double luaL_opt_number (int numArg, double def);
+#define luaL_opt_int(n,d)	((int)luaL_opt_number(n,d))
+#define luaL_opt_long(n,d)	((long)luaL_opt_number(n,d))
 lua_Object luaL_functionarg (int arg);
 lua_Object luaL_tablearg (int arg);
 lua_Object luaL_nonnullarg (int numArg);
@@ -34,10 +40,14 @@ void luaL_verror (char *fmt, ...);
 char *luaL_openspace (int size);
 void luaL_resetbuffer (void);
 void luaL_addchar (int c);
+int luaL_getsize (void);
 void luaL_addsize (int n);
 int luaL_newbuffer (int size);
 void luaL_oldbuffer (int old);
 char *luaL_buffer (void);
+int luaL_findstring (char *name, char *list[]);
+void luaL_chunkid (char *out, char *source, int len);
+void luaL_filesource (char *out, char *filename, int len);
 
 
 #endif

lbuffer.c

@@ -1,6 +1,6 @@
 /*
-** $Id: $
-** Auxiliar functions for building Lua libraries
+** $Id: lbuffer.c,v 1.8 1999/02/25 19:20:40 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
 ** See Copyright Notice in lua.h
 */
 
@@ -13,69 +13,63 @@
 
 
 /*-------------------------------------------------------
-**  Auxiliar buffer
+**  Auxiliary buffer
 -------------------------------------------------------*/
 
-#define BUFF_STEP	32
+
+#define EXTRABUFF	32
+
 
 #define openspace(size)  if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size)
 
-static void Openspace (int size)
-{
-  LState *l = L;  /* to optimize */
-  int base = l->Mbuffbase-l->Mbuffer;
-  l->Mbuffsize *= 2;
-  if (l->Mbuffnext+size > l->Mbuffsize)  /* still not big enough? */
-    l->Mbuffsize = l->Mbuffnext+size;
-  l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize);
-  l->Mbuffbase = l->Mbuffer+base;
+static void Openspace (int size) {
+  lua_State *l = L;  /* to optimize */
+  size += EXTRABUFF;
+  l->Mbuffsize = l->Mbuffnext+size;
+  luaM_growvector(l->Mbuffer, l->Mbuffnext, size, char, arrEM, MAX_INT);
 }
 
 
-char *luaL_openspace (int size)
-{
+char *luaL_openspace (int size) {
   openspace(size);
   return L->Mbuffer+L->Mbuffnext;
 }
 
 
-void luaL_addchar (int c)
-{
-  openspace(BUFF_STEP);
-  L->Mbuffer[L->Mbuffnext++] = c;
+void luaL_addchar (int c) {
+  openspace(1);
+  L->Mbuffer[L->Mbuffnext++] = (char)c;
 }
 
 
-void luaL_resetbuffer (void)
-{
-  L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
+void luaL_resetbuffer (void) {
+  L->Mbuffnext = L->Mbuffbase;
 }
 
 
-void luaL_addsize (int n)
-{
+void luaL_addsize (int n) {
   L->Mbuffnext += n;
 }
 
+int luaL_getsize (void) {
+  return L->Mbuffnext-L->Mbuffbase;
+}
 
-int luaL_newbuffer (int size)
-{
-  int old = L->Mbuffbase-L->Mbuffer;
+int luaL_newbuffer (int size) {
+  int old = L->Mbuffbase;
   openspace(size);
-  L->Mbuffbase = L->Mbuffer+L->Mbuffnext;
+  L->Mbuffbase = L->Mbuffnext;
   return old;
 }
 
 
-void luaL_oldbuffer (int old)
-{
-  L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
-  L->Mbuffbase = L->Mbuffer+old;
+void luaL_oldbuffer (int old) {
+  L->Mbuffnext = L->Mbuffbase;
+  L->Mbuffbase = old;
 }
 
 
-char *luaL_buffer (void)
-{
-  return L->Mbuffbase;
+char *luaL_buffer (void) {
+  return L->Mbuffer+L->Mbuffbase;
 }
 

lbuiltin.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbuiltin.c,v 1.21 1998/01/02 17:46:32 roberto Exp roberto $
+** $Id: lbuiltin.c,v 1.55 1999/03/01 20:22:16 roberto Exp roberto $
 ** Built-in functions
 ** See Copyright Notice in lua.h
 */
@@ -22,11 +22,19 @@
 #include "ltable.h"
 #include "ltm.h"
 #include "lua.h"
+#include "lundump.h"
+#include "lvm.h"
 
 
 
-static void pushstring (TaggedString *s)
-{
+/*
+** {======================================================
+** Auxiliary functions
+** =======================================================
+*/
+
+
+static void pushtagstring (TaggedString *s) {
   TObject o;
   o.ttype = LUA_T_STRING;
   o.value.ts = s;
@@ -34,198 +42,123 @@ static void pushstring (TaggedString *s)
 }
 
 
-static void nextvar (void)
-{
-  TObject *o = luaA_Address(luaL_nonnullarg(1));
-  TaggedString *g;
-  if (ttype(o) == LUA_T_NIL)
-    g = (TaggedString *)L->rootglobal.next;
-  else {
-    luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
-    g = tsvalue(o);
-    /* check whether name is in global var list */
-    luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
-    g = (TaggedString *)g->head.next;
-  }
-  while (g && g->u.globalval.ttype == LUA_T_NIL)  /* skip globals with nil */
-    g = (TaggedString *)g->head.next;
-  if (g) {
-    pushstring(g);
-    luaA_pushobject(&g->u.globalval);
-  }
-}
-
-
-static void foreachvar (void)
-{
-  TObject f = *luaA_Address(luaL_functionarg(1));
-  GCnode *g;
-  StkId name = L->Cstack.base++;  /* place to keep var name (to avoid GC) */
-  ttype(L->stack.stack+name) = LUA_T_NIL;
-  L->stack.top++;
-  for (g = L->rootglobal.next; g; g = g->next) {
-    TaggedString *s = (TaggedString *)g;
-    if (s->u.globalval.ttype != LUA_T_NIL) {
-      ttype(L->stack.stack+name) = LUA_T_STRING;
-      tsvalue(L->stack.stack+name) = s;  /* keep s on stack to avoid GC */
-      luaA_pushobject(&f);
-      pushstring(s);
-      luaA_pushobject(&s->u.globalval);
-      luaD_call((L->stack.top-L->stack.stack)-2, 1);
-      if (ttype(L->stack.top-1) != LUA_T_NIL)
-        return;
-      L->stack.top--;
-    }
-  }
-}
-
-
-static void next (void)
-{
-  lua_Object o = luaL_tablearg(1);
-  lua_Object r = luaL_nonnullarg(2);
-  Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
-  if (n) {
-    luaA_pushobject(&n->ref);
-    luaA_pushobject(&n->val);
-  }
-}
-
-
-static void foreach (void)
-{
-  TObject t = *luaA_Address(luaL_tablearg(1));
-  TObject f = *luaA_Address(luaL_functionarg(2));
+static real getsize (Hash *h) {
+  real max = 0;
   int i;
-  for (i=0; i<avalue(&t)->nhash; i++) {
-    Node *nd = &(avalue(&t)->node[i]);
-    if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
-      luaA_pushobject(&f);
-      luaA_pushobject(ref(nd));
-      luaA_pushobject(val(nd));
-      luaD_call((L->stack.top-L->stack.stack)-2, 1);
-      if (ttype(L->stack.top-1) != LUA_T_NIL)
-        return;
-      L->stack.top--;
-    }
+  for (i = 0; i<nhash(h); i++) {
+    Node *n = h->node+i;
+    if (ttype(ref(n)) == LUA_T_NUMBER && 
+        ttype(val(n)) != LUA_T_NIL &&
+        nvalue(ref(n)) > max)
+      max = nvalue(ref(n));
+  }
+  return max;
+}
+
+
+static real getnarg (Hash *a) {
+  TObject index;
+  TObject *value;
+  /* value = table.n */
+  ttype(&index) = LUA_T_STRING;
+  tsvalue(&index) = luaS_new("n");
+  value = luaH_get(a, &index);
+  return (ttype(value) == LUA_T_NUMBER) ? nvalue(value) : getsize(a);
+}
+
+
+static Hash *gethash (int arg) {
+  return avalue(luaA_Address(luaL_tablearg(arg)));
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Functions that use only the official API
+** =======================================================
+*/
+
+
+/*
+** If your system does not support "stderr", redefine this function, or
+** redefine _ERRORMESSAGE so that it won't need _ALERT.
+*/
+static void luaB_alert (void) {
+  fputs(luaL_check_string(1), stderr);
+}
+
+
+/*
+** Standard implementation of _ERRORMESSAGE.
+** The library "iolib" redefines _ERRORMESSAGE for better error information.
+*/
+static void error_message (void) {
+  lua_Object al = lua_rawgetglobal("_ALERT");
+  if (lua_isfunction(al)) {  /* avoid error loop if _ALERT is not defined */
+    char buff[600];
+    sprintf(buff, "lua error: %.500s\n", luaL_check_string(1));
+    lua_pushstring(buff);
+    lua_callfunction(al);
   }
 }
 
 
-static void internaldostring (void)
-{
-  if (lua_getparam(2) != LUA_NOOBJECT)
-    lua_error("invalid 2nd argument (probably obsolete code)");
-  if (lua_dostring(luaL_check_string(1)) == 0)
-    if (luaA_passresults() == 0)
-      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
-}
-
-
-static void internaldofile (void)
-{
-  char *fname = luaL_opt_string(1, NULL);
-  if (lua_dofile(fname) == 0)
-    if (luaA_passresults() == 0)
-      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
-}
-
-
-static char *to_string (lua_Object obj)
-{
-  char *buff = luaL_openspace(30);
-  TObject *o = luaA_Address(obj);
-  switch (ttype(o)) {
-    case LUA_T_NUMBER:  case LUA_T_STRING:
-      return lua_getstring(obj);
-    case LUA_T_ARRAY: {
-      sprintf(buff, "table: %p", (void *)o->value.a);
-      return buff;
-    }
-    case LUA_T_CLOSURE: {
-      sprintf(buff, "function: %p", (void *)o->value.cl);
-      return buff;
-    }
-    case LUA_T_PROTO: {
-      sprintf(buff, "function: %p", (void *)o->value.tf);
-      return buff;
-    }
-    case LUA_T_CPROTO: {
-      sprintf(buff, "function: %p", (void *)o->value.f);
-      return buff;
-    }
-    case LUA_T_USERDATA: {
-      sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
-      return buff;
-    }
-    case LUA_T_NIL:
-      return "nil";
-    default: 
-      lua_error("internal error");
-      return NULL;  /* to avoid warnings */
-  }
-}
-
-static void bi_tostring (void)
-{
-  lua_pushstring(to_string(lua_getparam(1)));
-}
-
-
-static void luaI_print (void)
-{
-  int i = 1;
+/*
+** If your system does not support "stdout", just remove this function.
+** If you need, you can define your own "print" function, following this
+** model but changing "fputs" to put the strings at a proper place
+** (a console window or a log file, for instance).
+*/
+#define MAXPRINT	40
+static void luaB_print (void) {
+  lua_Object args[MAXPRINT];
   lua_Object obj;
-  while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
-    printf("%s\t", to_string(obj));
-  printf("\n");
+  int n = 0;
+  int i;
+  while ((obj = lua_getparam(n+1)) != LUA_NOOBJECT) {
+    luaL_arg_check(n < MAXPRINT, n+1, "too many arguments");
+    args[n++] = obj;
+  }
+  for (i=0; i<n; i++) {
+    lua_pushobject(args[i]);
+    if (lua_call("tostring"))
+      lua_error("error in `tostring' called by `print'");
+    obj = lua_getresult(1);
+    if (!lua_isstring(obj))
+      lua_error("`tostring' must return a string to `print'");
+    if (i>0) fputs("\t", stdout);
+    fputs(lua_getstring(obj), stdout);
+  }
+  fputs("\n", stdout);
 }
 
 
-static void luaI_type (void)
-{
-  lua_Object o = luaL_nonnullarg(1);
-  lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
-  lua_pushnumber(lua_tag(o));
-}
-
-
-static void tonumber (void)
-{
-  int base = luaL_opt_number(2, 10);
-  if (base == 10) {  /* standard convertion */
+static void luaB_tonumber (void) {
+  int base = luaL_opt_int(2, 10);
+  if (base == 10) {  /* standard conversion */
     lua_Object o = lua_getparam(1);
-    if (lua_isnumber(o))
-      lua_pushnumber(lua_getnumber(o));
+    if (lua_isnumber(o)) lua_pushnumber(lua_getnumber(o));
+    else lua_pushnil();  /* not a number */
   }
   else {
     char *s = luaL_check_string(1);
-    unsigned long n;
+    long n;
     luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
     n = strtol(s, &s, base);
-    while (isspace(*s)) s++;  /* skip trailing spaces */
-    if (*s) return;  /* invalid format: return nil */
-    lua_pushnumber(n);
+    while (isspace((unsigned char)*s)) s++;  /* skip trailing spaces */
+    if (*s) lua_pushnil();  /* invalid format: return nil */
+    else lua_pushnumber(n);
   }
 }
 
 
-static void luaI_error (void)
-{
+static void luaB_error (void) {
   lua_error(lua_getstring(lua_getparam(1)));
 }
 
-
-static void luaI_assert (void)
-{
-  lua_Object p = lua_getparam(1);
-  if (p == LUA_NOOBJECT || lua_isnil(p))
-    luaL_verror("assertion failed!  %.100s", luaL_opt_string(2, ""));
-}
-
-
-static void setglobal (void)
-{
+static void luaB_setglobal (void) {
   char *n = luaL_check_string(1);
   lua_Object value = luaL_nonnullarg(2);
   lua_pushobject(value);
@@ -233,8 +166,7 @@ static void setglobal (void)
   lua_pushobject(value);  /* return given value */
 }
 
-static void rawsetglobal (void)
-{
+static void luaB_rawsetglobal (void) {
   char *n = luaL_check_string(1);
   lua_Object value = luaL_nonnullarg(2);
   lua_pushobject(value);
@@ -242,63 +174,125 @@ static void rawsetglobal (void)
   lua_pushobject(value);  /* return given value */
 }
 
-static void getglobal (void)
-{
+static void luaB_getglobal (void) {
   lua_pushobject(lua_getglobal(luaL_check_string(1)));
 }
 
-static void rawgetglobal (void)
-{
+static void luaB_rawgetglobal (void) {
   lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
 }
 
-static void luatag (void)
-{
+static void luaB_luatag (void) {
   lua_pushnumber(lua_tag(lua_getparam(1)));
 }
 
-
-static int getnarg (lua_Object table)
-{
-  lua_Object temp;
-  /* temp = table.n */
-  lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
-  return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_WORD);
+static void luaB_settag (void) {
+  lua_Object o = luaL_tablearg(1);
+  lua_pushobject(o);
+  lua_settag(luaL_check_int(2));
+  lua_pushobject(o);  /* return first argument */
 }
 
-static void luaI_call (void)
-{
+static void luaB_newtag (void) {
+  lua_pushnumber(lua_newtag());
+}
+
+static void luaB_copytagmethods (void) {
+  lua_pushnumber(lua_copytagmethods(luaL_check_int(1),
+                                    luaL_check_int(2)));
+}
+
+static void luaB_rawgettable (void) {
+  lua_pushobject(luaL_nonnullarg(1));
+  lua_pushobject(luaL_nonnullarg(2));
+  lua_pushobject(lua_rawgettable());
+}
+
+static void luaB_rawsettable (void) {
+  lua_pushobject(luaL_nonnullarg(1));
+  lua_pushobject(luaL_nonnullarg(2));
+  lua_pushobject(luaL_nonnullarg(3));
+  lua_rawsettable();
+}
+
+static void luaB_settagmethod (void) {
+  lua_Object nf = luaL_nonnullarg(3);
+  lua_pushobject(nf);
+  lua_pushobject(lua_settagmethod(luaL_check_int(1), luaL_check_string(2)));
+}
+
+static void luaB_gettagmethod (void) {
+  lua_pushobject(lua_gettagmethod(luaL_check_int(1), luaL_check_string(2)));
+}
+
+static void luaB_seterrormethod (void) {
+  lua_Object nf = luaL_functionarg(1);
+  lua_pushobject(nf);
+  lua_pushobject(lua_seterrormethod());
+}
+
+static void luaB_collectgarbage (void) {
+  lua_pushnumber(lua_collectgarbage(luaL_opt_int(1, 0)));
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Functions that could use only the official API but
+** do not, for efficiency.
+** =======================================================
+*/
+
+static void luaB_dostring (void) {
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  if (*s == ID_CHUNK)
+    lua_error("`dostring' cannot run pre-compiled code");
+  if (lua_dobuffer(s, l, luaL_opt_string(2, s)) == 0)
+    if (luaA_passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
+}
+
+
+static void luaB_dofile (void) {
+  char *fname = luaL_opt_string(1, NULL);
+  if (lua_dofile(fname) == 0)
+    if (luaA_passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
+}
+
+
+static void luaB_call (void) {
   lua_Object f = luaL_nonnullarg(1);
-  lua_Object arg = luaL_tablearg(2);
+  Hash *arg = gethash(2);
   char *options = luaL_opt_string(3, "");
   lua_Object err = lua_getparam(4);
-  int narg = getnarg(arg);
+  int narg = (int)getnarg(arg);
   int i, status;
   if (err != LUA_NOOBJECT) {  /* set new error method */
     lua_pushobject(err);
     err = lua_seterrormethod();
   }
   /* push arg[1...n] */
-  for (i=0; i<narg; i++) {
-    lua_Object temp;
-    /* temp = arg[i+1] */
-    lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
-    if (narg == MAX_WORD && lua_isnil(temp))
-      break;
-    lua_pushobject(temp);
-  }
+  luaD_checkstack(narg);
+  for (i=0; i<narg; i++)
+    *(L->stack.top++) = *luaH_getint(arg, i+1);
   status = lua_callfunction(f);
   if (err != LUA_NOOBJECT) {  /* restore old error method */
     lua_pushobject(err);
     lua_seterrormethod();
   }
   if (status != 0) {  /* error in call? */
-    if (strchr(options, 'x'))
+    if (strchr(options, 'x')) {
+      lua_pushnil();
       return;  /* return nil to signal the error */
+    }
     else
       lua_error(NULL);
   }
-  else { /* no errors */
+  else {  /* no errors */
     if (strchr(options, 'p'))
       luaA_packresults();
     else
@@ -307,95 +301,299 @@ static void luaI_call (void)
 }
 
 
-static void settag (void)
-{
-  lua_Object o = luaL_tablearg(1);
-  lua_pushobject(o);
-  lua_settag(luaL_check_number(2));
+static void luaB_nextvar (void) {
+  TObject *o = luaA_Address(luaL_nonnullarg(1));
+  TaggedString *g;
+  if (ttype(o) == LUA_T_NIL)
+    g = NULL;
+  else {
+    luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
+    g = tsvalue(o);
+  }
+  if (!luaA_nextvar(g))
+    lua_pushnil();
 }
 
 
-static void newtag (void)
-{
-  lua_pushnumber(lua_newtag());
+static void luaB_next (void) {
+  Hash *a = gethash(1);
+  TObject *k = luaA_Address(luaL_nonnullarg(2));
+  int i = (ttype(k) == LUA_T_NIL) ? 0 : luaH_pos(a, k)+1;
+  if (luaA_next(a, i) == 0)
+    lua_pushnil();
 }
 
 
-static void copytagmethods (void)
-{
-  lua_pushnumber(lua_copytagmethods(luaL_check_number(1),
-                                    luaL_check_number(2)));
+static void luaB_tostring (void) {
+  lua_Object obj = lua_getparam(1);
+  TObject *o = luaA_Address(obj);
+  char buff[64];
+  switch (ttype(o)) {
+    case LUA_T_NUMBER:
+      lua_pushstring(lua_getstring(obj));
+      return;
+    case LUA_T_STRING:
+      lua_pushobject(obj);
+      return;
+    case LUA_T_ARRAY:
+      sprintf(buff, "table: %p", (void *)o->value.a);
+      break;
+    case LUA_T_CLOSURE:
+      sprintf(buff, "function: %p", (void *)o->value.cl);
+      break;
+    case LUA_T_PROTO:
+      sprintf(buff, "function: %p", (void *)o->value.tf);
+      break;
+    case LUA_T_CPROTO:
+      sprintf(buff, "function: %p", (void *)o->value.f);
+      break;
+    case LUA_T_USERDATA:
+      sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
+      break;
+    case LUA_T_NIL:
+      lua_pushstring("nil");
+      return;
+    default:
+      LUA_INTERNALERROR("invalid type");
+  }
+  lua_pushstring(buff);
 }
 
 
-static void rawgettable (void)
-{
-  lua_Object t = luaL_nonnullarg(1);
-  lua_Object i = luaL_nonnullarg(2);
-  lua_pushobject(t);
-  lua_pushobject(i);
-  lua_pushobject(lua_rawgettable());
+static void luaB_type (void) {
+  lua_Object o = luaL_nonnullarg(1);
+  lua_pushstring(luaO_typename(luaA_Address(o)));
+  lua_pushnumber(lua_tag(o));
 }
 
+/* }====================================================== */
 
-static void rawsettable (void)
-{
-  lua_Object t = luaL_nonnullarg(1);
-  lua_Object i = luaL_nonnullarg(2);
-  lua_Object v = luaL_nonnullarg(3);
-  lua_pushobject(t);
-  lua_pushobject(i);
-  lua_pushobject(v);
-  lua_rawsettable();
-}
-
-
-static void settagmethod (void)
-{
-  lua_Object nf = luaL_nonnullarg(3);
-  lua_pushobject(nf);
-  lua_pushobject(lua_settagmethod((int)luaL_check_number(1),
-                                  luaL_check_string(2)));
-}
-
-
-static void gettagmethod (void)
-{
-  lua_pushobject(lua_gettagmethod((int)luaL_check_number(1),
-                                  luaL_check_string(2)));
-}
-
-
-static void seterrormethod (void)
-{
-  lua_Object nf = luaL_functionarg(1);
-  lua_pushobject(nf);
-  lua_pushobject(lua_seterrormethod());
-}
-
-
-static void luaI_collectgarbage (void)
-{
-  lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
-}
 
 
 /*
+** {======================================================
+** "Extra" functions
+** These functions can be written in Lua, so you can
+**  delete them if you need a tiny Lua implementation.
+** If you delete them, remove their entries in array
+** "builtin_funcs".
 ** =======================================================
+*/
+
+static void luaB_assert (void) {
+  lua_Object p = lua_getparam(1);
+  if (p == LUA_NOOBJECT || lua_isnil(p))
+    luaL_verror("assertion failed!  %.100s", luaL_opt_string(2, ""));
+}
+
+
+static void luaB_foreachi (void) {
+  Hash *t = gethash(1);
+  TObject *f = luaA_Address(luaL_functionarg(2));
+  int i;
+  int n = (int)getnarg(t);
+  luaD_checkstack(3);  /* for f, ref, and val */
+  for (i=1; i<=n; i++) {
+    *(L->stack.top++) = *f;
+    ttype(L->stack.top) = LUA_T_NUMBER; nvalue(L->stack.top++) = i;
+    *(L->stack.top++) = *luaH_getint(t, i);
+    luaD_calln(2, 1);
+    if (ttype(L->stack.top-1) != LUA_T_NIL)
+      return;
+    L->stack.top--;
+  }
+}
+
+
+static void luaB_foreach (void) {
+  Hash *a = gethash(1);
+  TObject *f = luaA_Address(luaL_functionarg(2));
+  int i;
+  luaD_checkstack(3);  /* for f, ref, and val */
+  for (i=0; i<a->nhash; i++) {
+    Node *nd = &(a->node[i]);
+    if (ttype(val(nd)) != LUA_T_NIL) {
+      *(L->stack.top++) = *f;
+      *(L->stack.top++) = *ref(nd);
+      *(L->stack.top++) = *val(nd);
+      luaD_calln(2, 1);
+      if (ttype(L->stack.top-1) != LUA_T_NIL)
+        return;
+      L->stack.top--;  /* remove result */
+    }
+  }
+}
+
+
+static void luaB_foreachvar (void) {
+  TObject *f = luaA_Address(luaL_functionarg(1));
+  GCnode *g;
+  luaD_checkstack(4);  /* for extra var name, f, var name, and globalval */
+  for (g = L->rootglobal.next; g; g = g->next) {
+    TaggedString *s = (TaggedString *)g;
+    if (s->u.s.globalval.ttype != LUA_T_NIL) {
+      pushtagstring(s);  /* keep (extra) s on stack to avoid GC */
+      *(L->stack.top++) = *f;
+      pushtagstring(s);
+      *(L->stack.top++) = s->u.s.globalval;
+      luaD_calln(2, 1);
+      if (ttype(L->stack.top-1) != LUA_T_NIL) {
+        L->stack.top--;
+        *(L->stack.top-1) = *L->stack.top;  /* remove extra s */
+        return;
+      }
+      L->stack.top-=2;  /* remove result and extra s */
+    }
+  }
+}
+
+
+static void luaB_getn (void) {
+  lua_pushnumber(getnarg(gethash(1)));
+}
+
+
+static void luaB_tinsert (void) {
+  Hash *a = gethash(1);
+  lua_Object v = lua_getparam(3);
+  int n = (int)getnarg(a);
+  int pos;
+  if (v != LUA_NOOBJECT)
+    pos = luaL_check_int(2);
+  else {  /* called with only 2 arguments */
+    v = luaL_nonnullarg(2);
+    pos = n+1;
+  }
+  luaV_setn(a, n+1);  /* increment field "n" */
+  for ( ;n>=pos; n--)
+    luaH_move(a, n, n+1);
+  luaH_setint(a, pos, luaA_Address(v));
+}
+
+
+static void luaB_tremove (void) {
+  Hash *a = gethash(1);
+  int n = (int)getnarg(a);
+  int pos = luaL_opt_int(2, n);
+  if (n <= 0) return;  /* table is "empty" */
+  luaA_pushobject(luaH_getint(a, pos));  /* push result */
+  luaV_setn(a, n-1);  /* decrement field "n" */
+  for ( ;pos<n; pos++)
+    luaH_move(a, pos+1, pos);
+}
+
+
+/* {
+** Quicksort
+*/
+
+static void swap (Hash *a, int i, int j) {
+  TObject temp;
+  temp = *luaH_getint(a, i);
+  luaH_move(a, j, i);
+  luaH_setint(a, j, &temp);
+}
+
+static int sort_comp (TObject *f, TObject *a, TObject *b) {
+  /* notice: the caller (auxsort) must check stack space */
+  if (f) {
+    *(L->stack.top) = *f;
+    *(L->stack.top+1) = *a;
+    *(L->stack.top+2) = *b;
+    L->stack.top += 3;
+    luaD_calln(2, 1);
+  }
+  else {  /* a < b? */
+    *(L->stack.top) = *a;
+    *(L->stack.top+1) = *b;
+    L->stack.top += 2;
+    luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
+  }
+  return ttype(--(L->stack.top)) != LUA_T_NIL;
+}
+
+static void auxsort (Hash *a, int l, int u, TObject *f) {
+  while (l < u) {  /* for tail recursion */
+    TObject *P;
+    int i, j;
+    /* sort elements a[l], a[(l+u)/2] and a[u] */
+    if (sort_comp(f, luaH_getint(a, u), luaH_getint(a, l)))  /* a[l]>a[u]? */
+      swap(a, l, u);
+    if (u-l == 1) break;  /* only 2 elements */
+    i = (l+u)/2;
+    P = luaH_getint(a, i);
+    if (sort_comp(f, P, luaH_getint(a, l)))  /* a[l]>a[i]? */
+      swap(a, l, i);
+    else if (sort_comp(f, luaH_getint(a, u), P))  /* a[i]>a[u]? */
+      swap(a, i, u);
+    if (u-l == 2) break;  /* only 3 elements */
+    P = L->stack.top++;
+    *P = *luaH_getint(a, i);  /* save pivot on stack (for GC) */
+    swap(a, i, u-1);  /* put median element as pivot (a[u-1]) */
+    /* a[l] <= P == a[u-1] <= a[u], only needs to sort from l+1 to u-2 */
+    i = l; j = u-1;
+    for  (;;) {
+      /* invariant: a[l..i] <= P <= a[j..u] */
+      while (sort_comp(f, luaH_getint(a, ++i), P))  /* stop when a[i] >= P */
+        if (i>u) lua_error("invalid order function for sorting");
+      while (sort_comp(f, P, luaH_getint(a, --j)))  /* stop when a[j] <= P */
+        if (j<l) lua_error("invalid order function for sorting");
+      if (j<i) break;
+      swap(a, i, j);
+    }
+    swap(a, u-1, i);  /* swap pivot (a[u-1]) with a[i] */
+    L->stack.top--;  /* remove pivot from stack */
+    /* a[l..i-1] <= a[i] == P <= a[i+1..u] */
+    /* adjust so that smaller "half" is in [j..i] and larger one in [l..u] */
+    if (i-l < u-i) {
+      j=l; i=i-1; l=i+2;
+    }
+    else {
+      j=i+1; i=u; u=j-2;
+    }
+    auxsort(a, j, i, f);  /* call recursively the smaller one */
+  }  /* repeat the routine for the larger one */
+}
+
+static void luaB_sort (void) {
+  lua_Object t = lua_getparam(1);
+  Hash *a = gethash(1);
+  int n = (int)getnarg(a);
+  lua_Object func = lua_getparam(2);
+  TObject *f = luaA_Address(func);
+  luaL_arg_check(!f || lua_isfunction(func), 2, "function expected");
+  luaD_checkstack(4);  /* for Pivot, f, a, b (sort_comp) */
+  auxsort(a, 1, n, f);
+  lua_pushobject(t);
+}
+
+/* }}===================================================== */
+
+
+/*
+** ====================================================== */
+
+
+
+#ifdef DEBUG
+/*
+** {======================================================
 ** some DEBUG functions
 ** =======================================================
 */
-#ifdef DEBUG
 
-static void mem_query (void)
-{
+static void mem_query (void) {
   lua_pushnumber(totalmem);
   lua_pushnumber(numblocks);
 }
 
 
-static void countlist (void)
-{
+static void query_strings (void) {
+  lua_pushnumber(L->string_root[luaL_check_int(1)].nuse);
+}
+
+
+static void countlist (void) {
   char *s = luaL_check_string(1);
   GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
               (s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
@@ -408,8 +606,7 @@ static void countlist (void)
 }
 
 
-static void testC (void)
-{
+static void testC (void) {
 #define getnum(s)	((*s++) - '0')
 #define getname(s)	(nome[0] = *s++, nome)
 
@@ -418,7 +615,7 @@ static void testC (void)
   char nome[2];
   char *s = luaL_check_string(1);
   nome[1] = 0;
-  while (1) {
+  for (;;) {
     switch (*s++) {
       case '0': case '1': case '2': case '3': case '4':
       case '5': case '6': case '7': case '8': case '9':
@@ -427,7 +624,7 @@ static void testC (void)
 
       case 'c': reg[getnum(s)] = lua_createtable(); break;
       case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
-                  lua_pushCclosure(f, getnum(s));
+                  lua_pushcclosure(f, getnum(s));
                   break;
                 }
       case 'P': reg[getnum(s)] = lua_pop(); break;
@@ -449,6 +646,12 @@ static void testC (void)
       case 'I': reg[getnum(s)] = lua_rawgettable(); break;
       case 't': lua_settable(); break;
       case 'T': lua_rawsettable(); break;
+      case 'N' : lua_pushstring(lua_nextvar(lua_getstring(reg[getnum(s)])));
+                 break;
+      case 'n' : { int n=getnum(s);
+                   n=lua_next(reg[n], (int)lua_getnumber(reg[getnum(s)]));
+                   lua_pushnumber(n); break;
+                 }
       default: luaL_verror("unknown command in `testC': %c", *(s-1));
     }
   if (*s == 0) return;
@@ -456,13 +659,12 @@ static void testC (void)
   }
 }
 
+/* }====================================================== */
 #endif
 
 
-/*
-** Internal functions
-*/
-static struct luaL_reg int_funcs[] = {
+
+static struct luaL_reg builtin_funcs[] = {
 #ifdef LUA_COMPAT2_5
   {"setfallback", luaT_setfallback},
 #endif
@@ -470,46 +672,54 @@ static struct luaL_reg int_funcs[] = {
   {"testC", testC},
   {"totalmem", mem_query},
   {"count", countlist},
+  {"querystr", query_strings},
 #endif
-  {"assert", luaI_assert},
-  {"call", luaI_call},
-  {"collectgarbage", luaI_collectgarbage},
-  {"dofile", internaldofile},
-  {"copytagmethods", copytagmethods},
-  {"dostring", internaldostring},
-  {"error", luaI_error},
-  {"foreach", foreach},
-  {"foreachvar", foreachvar},
-  {"getglobal", getglobal},
-  {"newtag", newtag},
-  {"next", next},
-  {"nextvar", nextvar},
-  {"print", luaI_print},
-  {"rawgetglobal", rawgetglobal},
-  {"rawgettable", rawgettable},
-  {"rawsetglobal", rawsetglobal},
-  {"rawsettable", rawsettable},
-  {"seterrormethod", seterrormethod},
-  {"setglobal", setglobal},
-  {"settagmethod", settagmethod},
-  {"gettagmethod", gettagmethod},
-  {"settag", settag},
-  {"tonumber", tonumber},
-  {"tostring", bi_tostring},
-  {"tag", luatag},
-  {"type", luaI_type}
+  {"_ALERT", luaB_alert},
+  {"_ERRORMESSAGE", error_message},
+  {"call", luaB_call},
+  {"collectgarbage", luaB_collectgarbage},
+  {"copytagmethods", luaB_copytagmethods},
+  {"dofile", luaB_dofile},
+  {"dostring", luaB_dostring},
+  {"error", luaB_error},
+  {"getglobal", luaB_getglobal},
+  {"gettagmethod", luaB_gettagmethod},
+  {"newtag", luaB_newtag},
+  {"next", luaB_next},
+  {"nextvar", luaB_nextvar},
+  {"print", luaB_print},
+  {"rawgetglobal", luaB_rawgetglobal},
+  {"rawgettable", luaB_rawgettable},
+  {"rawsetglobal", luaB_rawsetglobal},
+  {"rawsettable", luaB_rawsettable},
+  {"seterrormethod", luaB_seterrormethod},
+  {"setglobal", luaB_setglobal},
+  {"settag", luaB_settag},
+  {"settagmethod", luaB_settagmethod},
+  {"tag", luaB_luatag},
+  {"tonumber", luaB_tonumber},
+  {"tostring", luaB_tostring},
+  {"type", luaB_type},
+  /* "Extra" functions */
+  {"assert", luaB_assert},
+  {"foreach", luaB_foreach},
+  {"foreachi", luaB_foreachi},
+  {"foreachvar", luaB_foreachvar},
+  {"getn", luaB_getn},
+  {"sort", luaB_sort},
+  {"tinsert", luaB_tinsert},
+  {"tremove", luaB_tremove}
 };
 
 
-#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+#define INTFUNCSIZE (sizeof(builtin_funcs)/sizeof(builtin_funcs[0]))
 
 
-void luaB_predefine (void)
-{
+void luaB_predefine (void) {
   /* pre-register mem error messages, to avoid loop when error arises */
   luaS_newfixedstring(tableEM);
   luaS_newfixedstring(memEM);
-  luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0])));
+  luaL_openlib(builtin_funcs, (sizeof(builtin_funcs)/sizeof(builtin_funcs[0])));
   lua_pushstring(LUA_VERSION);
   lua_setglobal("_VERSION");
 }

ldblib.c

@@ -0,0 +1,217 @@
+/*
+** $Id: ldblib.c,v 1.4 1999/02/04 17:47:59 roberto Exp roberto $
+** Interface from Lua to its debug API
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "lua.h"
+#include "luadebug.h"
+#include "lualib.h"
+
+
+
+static void settabss (lua_Object t, char *i, char *v) {
+  lua_pushobject(t);
+  lua_pushstring(i);
+  lua_pushstring(v);
+  lua_settable();
+}
+
+
+static void settabsi (lua_Object t, char *i, int v) {
+  lua_pushobject(t);
+  lua_pushstring(i);
+  lua_pushnumber(v);
+  lua_settable();
+}
+
+
+static lua_Object getfuncinfo (lua_Object func) {
+  lua_Object result = lua_createtable();
+  char *str;
+  int line;
+  lua_funcinfo(func, &str, &line);
+  if (line == -1)  /* C function? */
+    settabss(result, "kind", "C");
+  else if (line == 0) {  /* "main"? */
+      settabss(result, "kind", "chunk");
+      settabss(result, "source", str);
+    }
+  else {  /* Lua function */
+    settabss(result, "kind", "Lua");
+    settabsi(result, "def_line", line);
+    settabss(result, "source", str);
+  }
+  if (line != 0) {  /* is it not a "main"? */
+    char *kind = lua_getobjname(func, &str);
+    if (*kind) {
+      settabss(result, "name", str);
+      settabss(result, "where", kind);
+    }
+  }
+  return result;
+}
+
+
+static void getstack (void) {
+  lua_Object func = lua_stackedfunction(luaL_check_int(1));
+  if (func == LUA_NOOBJECT)  /* level out of range? */
+    return;
+  else {
+    lua_Object result = getfuncinfo(func);
+    int currline = lua_currentline(func);
+    if (currline > 0)
+      settabsi(result, "current", currline);
+    lua_pushobject(result);
+    lua_pushstring("func");
+    lua_pushobject(func);
+    lua_settable();  /* result.func = func */
+    lua_pushobject(result);
+  }
+}
+
+
+static void funcinfo (void) {
+  lua_pushobject(getfuncinfo(luaL_functionarg(1)));
+}
+
+
+static int findlocal (lua_Object func, int arg) {
+  lua_Object v = lua_getparam(arg);
+  if (lua_isnumber(v))
+    return (int)lua_getnumber(v);
+  else {
+    char *name = luaL_check_string(arg);
+    int i = 0;
+    int result = -1;
+    char *vname;
+    while (lua_getlocal(func, ++i, &vname) != LUA_NOOBJECT) {
+      if (strcmp(name, vname) == 0)
+        result = i;  /* keep looping to get the last var with this name */
+    }
+    if (result == -1)
+      luaL_verror("no local variable `%.50s' at given level", name);
+    return result;
+  }
+}
+
+
+static void getlocal (void) {
+  lua_Object func = lua_stackedfunction(luaL_check_int(1));
+  lua_Object val;
+  char *name;
+  if (func == LUA_NOOBJECT)  /* level out of range? */
+    return;  /* return nil */
+  else if (lua_getparam(2) != LUA_NOOBJECT) {  /* 2nd argument? */
+    if ((val = lua_getlocal(func, findlocal(func, 2), &name)) != LUA_NOOBJECT) {
+      lua_pushobject(val);
+      lua_pushstring(name);
+    }
+    /* else return nil */
+  }
+  else {  /* collect all locals in a table */
+    lua_Object result = lua_createtable();
+    int i;
+    for (i=1; ;i++) {
+      if ((val = lua_getlocal(func, i, &name)) == LUA_NOOBJECT)
+        break;
+      lua_pushobject(result);
+      lua_pushstring(name);
+      lua_pushobject(val);
+      lua_settable();  /* result[name] = value */
+    }
+    lua_pushobject(result);
+  }
+}
+
+
+static void setlocal (void) {
+  lua_Object func = lua_stackedfunction(luaL_check_int(1));
+  int numvar;
+  luaL_arg_check(func != LUA_NOOBJECT, 1, "level out of range");
+  numvar = findlocal(func, 2);
+  lua_pushobject(luaL_nonnullarg(3));
+  if (!lua_setlocal(func, numvar))
+    lua_error("no such local variable");
+}
+
+
+
+static int linehook = -1;  /* Lua reference to line hook function */
+static int callhook = -1;  /* Lua reference to call hook function */
+
+
+static void dohook (int ref) {
+  lua_LHFunction oldlinehook = lua_setlinehook(NULL);
+  lua_CHFunction oldcallhook = lua_setcallhook(NULL);
+  lua_callfunction(lua_getref(ref));
+  lua_setlinehook(oldlinehook);
+  lua_setcallhook(oldcallhook);
+}
+
+
+static void linef (int line) {
+  lua_pushnumber(line);
+  dohook(linehook);
+}
+
+
+static void callf (lua_Function func, char *file, int line) {
+  if (func != LUA_NOOBJECT) {
+    lua_pushobject(func);
+    lua_pushstring(file);
+    lua_pushnumber(line);
+  }
+  dohook(callhook);
+}
+
+
+static void setcallhook (void) {
+  lua_Object f = lua_getparam(1);
+  lua_unref(callhook);
+  if (f == LUA_NOOBJECT) {
+    callhook = -1;
+    lua_setcallhook(NULL);
+  }
+  else {
+    lua_pushobject(f);
+    callhook = lua_ref(1);
+    lua_setcallhook(callf);
+  }
+}
+
+
+static void setlinehook (void) {
+  lua_Object f = lua_getparam(1);
+  lua_unref(linehook);
+  if (f == LUA_NOOBJECT) {
+    linehook = -1;
+    lua_setlinehook(NULL);
+  }
+  else {
+    lua_pushobject(f);
+    linehook = lua_ref(1);
+    lua_setlinehook(linef);
+  }
+}
+
+
+static struct luaL_reg dblib[] = {
+  {"funcinfo", funcinfo},
+  {"getlocal", getlocal},
+  {"getstack", getstack},
+  {"setcallhook", setcallhook},
+  {"setlinehook", setlinehook},
+  {"setlocal", setlocal}
+};
+
+
+void lua_dblibopen (void) {
+  luaL_openlib(dblib, (sizeof(dblib)/sizeof(dblib[0])));
+}
+

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.20 1997/12/26 18:38:16 roberto Exp roberto $
+** $Id: ldo.c,v 1.40 1999/03/10 14:23:07 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -10,6 +10,7 @@
 #include <stdlib.h>
 #include <string.h>
 
+#include "lauxlib.h"
 #include "ldo.h"
 #include "lfunc.h"
 #include "lgc.h"
@@ -17,6 +18,7 @@
 #include "lobject.h"
 #include "lparser.h"
 #include "lstate.h"
+#include "lstring.h"
 #include "ltm.h"
 #include "lua.h"
 #include "luadebug.h"
@@ -32,37 +34,22 @@
 
 
 
-/*
-** Error messages
-*/
-
-static void stderrorim (void)
-{
-  fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1)));
-}
-
-
-
 #define STACK_UNIT	128
 
 
-void luaD_init (void)
-{
+void luaD_init (void) {
   L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
   L->stack.top = L->stack.stack;
   L->stack.last = L->stack.stack+(STACK_UNIT-1);
-  ttype(&L->errorim) = LUA_T_CPROTO;
-  fvalue(&L->errorim) = stderrorim;
 }
 
 
-void luaD_checkstack (int n)
-{
+void luaD_checkstack (int n) {
   struct Stack *S = &L->stack;
   if (S->last-S->top <= n) {
     StkId top = S->top-S->stack;
-    int stacksize = (S->last-S->stack)+1+STACK_UNIT+n;
-    S->stack = luaM_reallocvector(S->stack, stacksize, TObject);
+    int stacksize = (S->last-S->stack)+STACK_UNIT+n;
+    luaM_reallocvector(S->stack, stacksize, TObject);
     S->last = S->stack+(stacksize-1);
     S->top = S->stack + top;
     if (stacksize >= STACK_LIMIT) {  /* stack overflow? */
@@ -78,8 +65,7 @@ void luaD_checkstack (int n)
 /*
 ** Adjust stack. Set top to the given value, pushing NILs if needed.
 */
-void luaD_adjusttop (StkId newtop)
-{
+void luaD_adjusttop (StkId newtop) {
   int diff = newtop-(L->stack.top-L->stack.stack);
   if (diff <= 0)
     L->stack.top += diff;
@@ -107,7 +93,7 @@ void luaD_lineHook (int line)
   struct C_Lua_Stack oldCLS = L->Cstack;
   StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
   L->Cstack.num = 0;
-  (*lua_linehook)(line);
+  (*L->linehook)(line);
   L->stack.top = L->stack.stack+old_top;
   L->Cstack = oldCLS;
 }
@@ -119,13 +105,13 @@ void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn)
   StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
   L->Cstack.num = 0;
   if (isreturn)
-    (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
+    (*L->callhook)(LUA_NOOBJECT, "(return)", 0);
   else {
     TObject *f = L->stack.stack+base-1;
     if (tf)
-      (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
+      (*L->callhook)(Ref(f), tf->source->str, tf->lineDefined);
     else
-      (*lua_callhook)(Ref(f), "(C)", -1);
+      (*L->callhook)(Ref(f), "(C)", -1);
   }
   L->stack.top = L->stack.stack+old_top;
   L->Cstack = oldCLS;
@@ -146,10 +132,10 @@ static StkId callC (lua_CFunction f, StkId base)
   CS->num = numarg;
   CS->lua2C = base;
   CS->base = base+numarg;  /* == top-stack */
-  if (lua_callhook)
+  if (L->callhook)
     luaD_callHook(base, NULL, 0);
   (*f)();  /* do the actual call */
-  if (lua_callhook)  /* func may have changed lua_callhook */
+  if (L->callhook)  /* func may have changed callhook */
     luaD_callHook(base, NULL, 1);
   firstResult = CS->base;
   *CS = oldCLS;
@@ -172,11 +158,10 @@ static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base)
 }
 
 
-void luaD_callTM (TObject *f, int nParams, int nResults)
-{
+void luaD_callTM (TObject *f, int nParams, int nResults) {
   luaD_openstack(nParams);
   *(L->stack.top-nParams-1) = *f;
-  luaD_call((L->stack.top-L->stack.stack)-nParams, nResults);
+  luaD_calln(nParams, nResults);
 }
 
 
@@ -230,6 +215,10 @@ void luaD_call (StkId base, int nResults)
 }
 
 
+void luaD_calln (int nArgs, int nResults) {
+    luaD_call((L->stack.top-L->stack.stack)-nArgs, nResults);
+}
+
 
 /*
 ** Traverse all objects on L->stack.stack
@@ -243,25 +232,26 @@ void luaD_travstack (int (*fn)(TObject *))
 
 
 
-static void message (char *s)
-{
-  TObject im = L->errorim;
-  if (ttype(&im) != LUA_T_NIL) {
+static void message (char *s) {
+  TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval);
+  if (ttype(em) == LUA_T_PROTO || ttype(em) == LUA_T_CPROTO ||
+      ttype(em) == LUA_T_CLOSURE) {
+    *L->stack.top = *em;
+    incr_top;
     lua_pushstring(s);
-    luaD_callTM(&im, 1, 0);
+    luaD_calln(1, 0);
   }
 }
 
 /*
 ** Reports an error, and jumps up to the available recover label
 */
-void lua_error (char *s)
-{
+void lua_error (char *s) {
   if (s) message(s);
   if (L->errorJmp)
     longjmp(*((jmp_buf *)L->errorJmp), 1);
   else {
-    fprintf (stderr, "lua: exit(1). Unable to recover\n");
+    message("exit(1). Unable to recover.\n");
     exit(1);
   }
 }
@@ -274,9 +264,9 @@ static void do_callinc (int nResults)
 {
   StkId base = L->Cstack.base;
   luaD_call(base+1, nResults);
-  L->Cstack.lua2C = base;  /* position of the luaM_new results */
+  L->Cstack.lua2C = base;  /* position of the new results */
   L->Cstack.num = (L->stack.top-L->stack.stack) - base;  /* number of results */
-  L->Cstack.base = base + L->Cstack.num;  /* incorporate results on L->stack.stack */
+  L->Cstack.base = base + L->Cstack.num;  /* incorporate results on stack */
 }
 
 
@@ -284,18 +274,17 @@ static void do_callinc (int nResults)
 ** Execute a protected call. Assumes that function is at L->Cstack.base and
 ** parameters are on top of it. Leave nResults on the stack.
 */
-int luaD_protectedrun (int nResults)
-{
+int luaD_protectedrun (int nResults) {
+  volatile struct C_Lua_Stack oldCLS = L->Cstack;
   jmp_buf myErrorJmp;
-  int status;
-  struct C_Lua_Stack oldCLS = L->Cstack;
-  jmp_buf *oldErr = L->errorJmp;
+  volatile int status;
+  jmp_buf *volatile oldErr = L->errorJmp;
   L->errorJmp = &myErrorJmp;
   if (setjmp(myErrorJmp) == 0) {
     do_callinc(nResults);
     status = 0;
   }
-  else { /* an error occurred: restore L->Cstack and L->stack.top */
+  else {  /* an error occurred: restore L->Cstack and L->stack.top */
     L->Cstack = oldCLS;
     L->stack.top = L->stack.stack+L->Cstack.base;
     status = 1;
@@ -308,18 +297,20 @@ int luaD_protectedrun (int nResults)
 /*
 ** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
 */
-static int protectedparser (ZIO *z, int bin)
-{
-  int status;
-  TProtoFunc *tf;
+static int protectedparser (ZIO *z, int bin) {
+  volatile struct C_Lua_Stack oldCLS = L->Cstack;
   jmp_buf myErrorJmp;
-  jmp_buf *oldErr = L->errorJmp;
+  volatile int status;
+  TProtoFunc *volatile tf;
+  jmp_buf *volatile oldErr = L->errorJmp;
   L->errorJmp = &myErrorJmp;
   if (setjmp(myErrorJmp) == 0) {
     tf = bin ? luaU_undump1(z) : luaY_parser(z);
     status = 0;
   }
-  else {
+  else {  /* an error occurred: restore L->Cstack and L->stack.top */
+    L->Cstack = oldCLS;
+    L->stack.top = L->stack.stack+L->Cstack.base;
     tf = NULL;
     status = 1;
   }
@@ -334,9 +325,9 @@ static int protectedparser (ZIO *z, int bin)
 }
 
 
-static int do_main (ZIO *z, int bin)
-{
+static int do_main (ZIO *z, int bin) {
   int status;
+  int debug = L->debug;  /* save debug status */
   do {
     long old_blocks = (luaC_checkGC(), L->nblocks);
     status = protectedparser(z, bin);
@@ -349,6 +340,7 @@ static int do_main (ZIO *z, int bin)
       L->GCthreshold -= newelems2;
     }
   } while (bin && status == 0);
+  L->debug = debug;  /* restore debug status */
   return status;
 }
 
@@ -364,23 +356,24 @@ void luaD_gcIM (TObject *o)
 }
 
 
-int lua_dofile (char *filename)
-{
+#define	MAXFILENAME	260	/* maximum part of a file name kept */
+
+int lua_dofile (char *filename) {
   ZIO z;
   int status;
   int c;
   int bin;
+  char source[MAXFILENAME];
   FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
   if (f == NULL)
     return 2;
-  if (filename == NULL)
-    filename = "(stdin)";
   c = fgetc(f);
   ungetc(c, f);
   bin = (c == ID_CHUNK);
   if (bin)
     f = freopen(filename, "rb", f);  /* set binary mode */
-  luaZ_Fopen(&z, f, filename);
+  luaL_filesource(source, filename, sizeof(source));
+  luaZ_Fopen(&z, f, source);
   status = do_main(&z, bin);
   if (f != stdin)
     fclose(f);
@@ -388,33 +381,15 @@ int lua_dofile (char *filename)
 }
 
 
-#define SIZE_PREF 20  /* size of string prefix to appear in error messages */
-#define SSIZE_PREF "20"
-
-
-int lua_dostring (char *str)
-{
-  int status;
-  char name[SIZE_PREF+25];
-  char *temp;
-  ZIO z;
-  if (str == NULL) return 1;
-  sprintf(name, "(dostring) >> %." SSIZE_PREF "s", str);
-  temp = strchr(name, '\n');
-  if (temp) *temp = 0;  /* end string after first line */
-  luaZ_sopen(&z, str, name);
-  status = do_main(&z, 0);
-  return status;
+int lua_dostring (char *str) {
+  return lua_dobuffer(str, strlen(str), str);
 }
 
 
-#if 0
-int lua_dobuffer (char *buff, int size)
-{
-  int status;
+int lua_dobuffer (char *buff, int size, char *name) {
   ZIO z;
-  luaZ_mopen(&z, buff, size, "(buffer)");
-  status = do_main(&z, 1);
-  return status;
+  if (!name) name = "?";
+  luaZ_mopen(&z, buff, size, name);
+  return do_main(&z, buff[0]==ID_CHUNK);
 }
-#endif
+

ldo.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
+** $Id: ldo.h,v 1.4 1997/12/15 16:17:20 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -36,6 +36,7 @@ void luaD_openstack (int nelems);
 void luaD_lineHook (int line);
 void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn);
 void luaD_call (StkId base, int nResults);
+void luaD_calln (int nArgs, int nResults);
 void luaD_callTM (TObject *f, int nParams, int nResults);
 int luaD_protectedrun (int nResults);
 void luaD_gcIM (TObject *o);

lfunc.c

@@ -1,6 +1,6 @@
 /*
-** $Id: lfunc.c,v 1.7 1997/12/09 13:35:19 roberto Exp roberto $
-** Auxiliar functions to manipulate prototypes and closures
+** $Id: lfunc.c,v 1.9 1998/06/19 16:14:09 roberto Exp roberto $
+** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
 
@@ -31,7 +31,7 @@ TProtoFunc *luaF_newproto (void)
   TProtoFunc *f = luaM_new(TProtoFunc);
   f->code = NULL;
   f->lineDefined = 0;
-  f->fileName = NULL;
+  f->source = NULL;
   f->consts = NULL;
   f->nconsts = 0;
   f->locvars = NULL;

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.14 1997/12/17 20:48:58 roberto Exp roberto $
+** $Id: lgc.c,v 1.22 1999/02/26 15:48:55 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -29,23 +29,18 @@ static int markobject (TObject *o);
 */
 
 
-int luaC_ref (TObject *o, int lock)
-{
+int luaC_ref (TObject *o, int lock) {
   int ref;
   if (ttype(o) == LUA_T_NIL)
     ref = -1;   /* special ref for nil */
   else {
     for (ref=0; ref<L->refSize; ref++)
       if (L->refArray[ref].status == FREE)
-        goto found;
-    /* no more empty spaces */ {
-      int oldSize = L->refSize;
-      L->refSize = luaM_growvector(&L->refArray, L->refSize, struct ref,
-                                   refEM, MAX_WORD);
-      for (ref=oldSize; ref<L->refSize; ref++)
-        L->refArray[ref].status = FREE;
-      ref = oldSize;
-    } found:
+        break;
+    if (ref == L->refSize) {  /* no more empty spaces? */
+      luaM_growvector(L->refArray, L->refSize, 1, struct ref, refEM, MAX_INT);
+      L->refSize++;
+    }
     L->refArray[ref].o = *o;
     L->refArray[ref].status = lock ? LOCK : HOLD;
   }
@@ -96,7 +91,7 @@ static int ismarked (TObject *o)
 #ifdef DEBUG
     case LUA_T_LINE: case LUA_T_CLMARK:
     case LUA_T_CMARK: case LUA_T_PMARK:
-      lua_error("internal error");
+      LUA_INTERNALERROR("invalid type");
 #endif
     default:  /* nil, number or cproto */
       return 1;
@@ -163,21 +158,13 @@ static void strmark (TaggedString *s)
 }
 
 
-static void protomark (TProtoFunc *f)
-{
+static void protomark (TProtoFunc *f) {
   if (!f->head.marked) {
-    LocVar *v = f->locvars;
     int i;
     f->head.marked = 1;
-    if (f->fileName)
-      strmark(f->fileName);
+    strmark(f->source);
     for (i=0; i<f->nconsts; i++)
       markobject(&f->consts[i]);
-    if (v) {
-      for (; v->line != -1; v++)
-        if (v->varname)
-          strmark(v->varname);
-    }
   }
 }
 
@@ -212,11 +199,13 @@ static void hashmark (Hash *h)
 static void globalmark (void)
 {
   TaggedString *g;
-  for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
-    if (g->u.globalval.ttype != LUA_T_NIL) {
-      markobject(&g->u.globalval);
+  for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next){
+    LUA_ASSERT(g->constindex >= 0, "userdata in global list");
+    if (g->u.s.globalval.ttype != LUA_T_NIL) {
+      markobject(&g->u.s.globalval);
       strmark(g);  /* cannot collect non nil global variables */
     }
+  }
 }
 
 

linit.c

@@ -0,0 +1,17 @@
+/*
+** $Id: linit.c,v 1.1 1999/01/08 16:47:44 roberto Exp $
+** Initialization of libraries for lua.c
+** See Copyright Notice in lua.h
+*/
+
+#include "lua.h"
+#include "lualib.h"
+
+
+void lua_userinit (void) {
+  lua_iolibopen();
+  lua_strlibopen();
+  lua_mathlibopen();
+  lua_dblibopen();
+}
+

liolib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: liolib.c,v 1.13 1997/12/26 18:38:16 roberto Exp roberto $
+** $Id: liolib.c,v 1.37 1999/04/05 19:47:05 roberto Exp roberto $
 ** Standard I/O (and system) library
 ** See Copyright Notice in lua.h
 */
@@ -20,6 +20,7 @@
 #ifndef OLD_ANSI
 #include <locale.h>
 #else
+/* no support for locale and for strerror: fake them */
 #define setlocale(a,b)	0
 #define LC_ALL		0
 #define LC_COLLATE	0
@@ -31,10 +32,12 @@
 #endif
 
 
-#define CLOSEDTAG	2
-#define IOTAG		1
+#define IOTAG	1
+
+#define FIRSTARG	2  /* 1st is upvalue */
+
+#define CLOSEDTAG(tag)	((tag)-1)  /* assume that CLOSEDTAG = iotag-1 */
 
-#define FIRSTARG      3  /* 1st and 2nd are upvalues */
 
 #define FINPUT		"_INPUT"
 #define FOUTPUT		"_OUTPUT"
@@ -43,95 +46,131 @@
 #ifdef POPEN
 FILE *popen();
 int pclose();
+#define CLOSEFILE(f)    {if (pclose(f) == -1) fclose(f);}
 #else
+/* no support for popen */
 #define popen(x,y) NULL  /* that is, popen always fails */
-#define pclose(x)  (-1)
+#define CLOSEFILE(f)    {fclose(f);}
 #endif
 
 
-static int gettag (int i)
-{
-  return lua_getnumber(lua_getparam(i));
-}
 
-
-static void pushresult (int i)
-{
+static void pushresult (int i) {
   if (i)
     lua_pushuserdata(NULL);
   else {
     lua_pushnil();
     lua_pushstring(strerror(errno));
+    lua_pushnumber(errno);
   }
 }
 
 
-static int ishandler (lua_Object f)
-{
+/*
+** {======================================================
+** FILE Operations
+** =======================================================
+*/
+
+static int gettag (void) {
+  return (int)lua_getnumber(lua_getparam(IOTAG));
+}
+
+
+static int ishandle (lua_Object f) {
   if (lua_isuserdata(f)) {
-    if (lua_tag(f) == gettag(CLOSEDTAG))
+    int tag = gettag();
+    if (lua_tag(f) == CLOSEDTAG(tag))
       lua_error("cannot access a closed file");
-    return lua_tag(f) == gettag(IOTAG);
+    return lua_tag(f) == tag;
   }
   else return 0;
 }
 
-static FILE *getfile (char *name)
-{
+
+static FILE *getfilebyname (char *name) {
   lua_Object f = lua_getglobal(name);
-  if (!ishandler(f))
+  if (!ishandle(f))
       luaL_verror("global variable `%.50s' is not a file handle", name);
   return lua_getuserdata(f);
 }
 
 
-static FILE *getfileparam (char *name, int *arg)
-{
-  lua_Object f = lua_getparam(*arg);
-  if (ishandler(f)) {
+static FILE *getfile (int arg) {
+  lua_Object f = lua_getparam(arg);
+  return (ishandle(f)) ? lua_getuserdata(f) : NULL;
+}
+
+
+static FILE *getnonullfile (int arg) {
+  FILE *f = getfile(arg);
+  luaL_arg_check(f, arg, "invalid file handle");
+  return f;
+}
+
+
+static FILE *getfileparam (char *name, int *arg) {
+  FILE *f = getfile(*arg);
+  if (f) {
     (*arg)++;
-    return lua_getuserdata(f);
+    return f;
   }
   else
-    return getfile(name);
+    return getfilebyname(name);
 }
 
 
-static void closefile (char *name)
-{
-  FILE *f = getfile(name);
-  if (f == stdin || f == stdout) return;
-  if (pclose(f) == -1)
-    fclose(f);
-  lua_pushobject(lua_getglobal(name));
-  lua_settag(gettag(CLOSEDTAG));
+static void closefile (FILE *f) {
+  if (f != stdin && f != stdout) {
+    int tag = gettag();
+    CLOSEFILE(f);
+    lua_pushusertag(f, tag);
+    lua_settag(CLOSEDTAG(tag));
+  }
 }
 
 
-static void setfile (FILE *f, char *name, int tag)
-{
+static void io_close (void) {
+  closefile(getnonullfile(FIRSTARG));
+}
+
+
+static void gc_close (void) {
+  FILE *f = getnonullfile(FIRSTARG);
+  if (f != stdin && f != stdout && f != stderr) {
+    CLOSEFILE(f);
+  }
+}
+
+
+static void io_open (void) {
+  FILE *f = fopen(luaL_check_string(FIRSTARG), luaL_check_string(FIRSTARG+1));
+  if (f) lua_pushusertag(f, gettag());
+  else pushresult(0);
+}
+
+
+static void setfile (FILE *f, char *name, int tag) {
   lua_pushusertag(f, tag);
   lua_setglobal(name);
 }
 
 
-static void setreturn (FILE *f, char *name)
-{
-  int tag = gettag(IOTAG);
+static void setreturn (FILE *f, char *name) {
+  int tag = gettag();
   setfile(f, name, tag);
   lua_pushusertag(f, tag);
 }
 
 
-static void io_readfrom (void)
-{
+static void io_readfrom (void) {
   FILE *current;
   lua_Object f = lua_getparam(FIRSTARG);
   if (f == LUA_NOOBJECT) {
-    closefile(FINPUT);
+    closefile(getfilebyname(FINPUT));
     current = stdin;
   }
-  else if (lua_tag(f) == gettag(IOTAG))
+  else if (lua_tag(f) == gettag())  /* deprecated option */
     current = lua_getuserdata(f);
   else {
     char *s = luaL_check_string(FIRSTARG);
@@ -145,19 +184,18 @@ static void io_readfrom (void)
 }
 
 
-static void io_writeto (void)
-{
+static void io_writeto (void) {
   FILE *current;
   lua_Object f = lua_getparam(FIRSTARG);
   if (f == LUA_NOOBJECT) {
-    closefile(FOUTPUT);
+    closefile(getfilebyname(FOUTPUT));
     current = stdout;
   }
-  else if (lua_tag(f) == gettag(IOTAG))
+  else if (lua_tag(f) == gettag())  /* deprecated option */
     current = lua_getuserdata(f);
   else {
     char *s = luaL_check_string(FIRSTARG);
-    current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
+    current = (*s == '|') ? popen(s+1,"w") : fopen(s, "w");
     if (current == NULL) {
       pushresult(0);
       return;
@@ -167,10 +205,8 @@ static void io_writeto (void)
 }
 
 
-static void io_appendto (void)
-{
-  char *s = luaL_check_string(FIRSTARG);
-  FILE *fp = fopen (s, "a");
+static void io_appendto (void) {
+  FILE *fp = fopen(luaL_check_string(FIRSTARG), "a");
   if (fp != NULL)
     setreturn(fp, FOUTPUT);
   else
@@ -178,110 +214,222 @@ static void io_appendto (void)
 }
 
 
+
+/*
+** {======================================================
+** READ
+** =======================================================
+*/
+
+
+/*
+** We cannot lookahead without need, because this can lock stdin.
+** This flag signals when we need to read a next char.
+*/
 #define NEED_OTHER (EOF-1)  /* just some flag different from EOF */
 
-static void io_read (void)
-{
-  int arg = FIRSTARG;
-  FILE *f = getfileparam(FINPUT, &arg);
-  char *buff;
-  char *p = luaL_opt_string(arg, "[^\n]*{\n}");
-  int inskip = 0;  /* to control {skips} */
+
+static int read_pattern (FILE *f, char *p) {
+  int inskip = 0;  /* {skip} level */
   int c = NEED_OTHER;
-  luaL_resetbuffer();
-  while (*p) {
-    if (*p == '{') {
-      inskip++;
-      p++;
-    }
-    else if (*p == '}') {
-      if (inskip == 0)
-        lua_error("unbalanced braces in read pattern");
-      inskip--;
-      p++;
-    }
-    else {
-      char *ep;  /* get what is next */
-      int m;  /* match result */
-      if (c == NEED_OTHER) c = getc(f);
-      m = luaI_singlematch((c == EOF) ? 0 : (char)c, p, &ep);
-      if (m) {
-        if (inskip == 0) luaL_addchar(c);
-        c = NEED_OTHER;
-      }
-      switch (*ep) {
-        case '*':  /* repetition */
-          if (!m) p = ep+1;  /* else stay in (repeat) the same item */
-          break;
-        case '?':  /* optional */
-          p = ep+1;  /* continues reading the pattern */
-          break;
-        default:
-          if (m) p = ep;  /* continues reading the pattern */
-          else
-            goto break_while;   /* pattern fails */
+  while (*p != '\0') {
+    switch (*p) {
+      case '{':
+        inskip++;
+        p++;
+        continue;
+      case '}':
+        if (!inskip) lua_error("unbalanced braces in read pattern");
+        inskip--;
+        p++;
+        continue;
+      default: {
+        char *ep;  /* get what is next */
+        int m;  /* match result */
+        if (c == NEED_OTHER) c = getc(f);
+        if (c != EOF)
+          m = luaI_singlematch(c, p, &ep);
+        else {
+          luaI_singlematch(0, p, &ep);  /* to set "ep" */
+          m = 0;  /* EOF matches no pattern */
+        }
+        if (m) {
+          if (!inskip) luaL_addchar(c);
+          c = NEED_OTHER;
+        }
+        switch (*ep) {
+          case '*':  /* repetition */
+            if (!m) p = ep+1;  /* else stay in (repeat) the same item */
+            continue;
+          case '?':  /* optional */
+            p = ep+1;  /* continues reading the pattern */
+            continue;
+          default:
+            if (!m) goto break_while;  /* pattern fails? */
+            p = ep;  /* else continues reading the pattern */
+        }
       }
     }
   } break_while:
-  if (c >= 0)  /* not EOF nor NEED_OTHER? */
-     ungetc(c, f);
-  luaL_addchar(0);
-  buff = luaL_buffer();
-  if (*buff != 0 || *p == 0)  /* read something or did not fail? */
-    lua_pushstring(buff);
+  if (c != NEED_OTHER) ungetc(c, f);
+  return (*p == '\0');
 }
 
 
-static void io_write (void)
-{
+static int read_number (FILE *f) {
+  double d;
+  if (fscanf(f, "%lf", &d) == 1) {
+    lua_pushnumber(d);
+    return 1;
+  }
+  else return 0;  /* read fails */
+}
+
+
+#define HUNK_LINE	1024
+#define HUNK_FILE	BUFSIZ
+
+static int read_line (FILE *f) {
+  /* equivalent to: return read_pattern(f, "[^\n]*{\n}"); */
+  int n;
+  char *b;
+  do {
+    b = luaL_openspace(HUNK_LINE);
+    if (!fgets(b, HUNK_LINE, f)) return 0;  /* read fails */
+    n = strlen(b);
+    luaL_addsize(n); 
+  } while (b[n-1] != '\n');
+  luaL_addsize(-1);  /* remove '\n' */
+  return 1;
+}
+
+
+static void read_file (FILE *f) {
+  /* equivalent to: return read_pattern(f, ".*"); */
+  int n;
+  do {
+    char *b = luaL_openspace(HUNK_FILE);
+    n = fread(b, sizeof(char), HUNK_FILE, f);
+    luaL_addsize(n); 
+  } while (n==HUNK_FILE);
+}
+
+
+static void io_read (void) {
+  static char *options[] = {"*n", "*l", "*a", ".*", "*w", NULL};
+  int arg = FIRSTARG;
+  FILE *f = getfileparam(FINPUT, &arg);
+  char *p = luaL_opt_string(arg++, "*l");
+  do { /* repeat for each part */
+    long l;
+    int success;
+    luaL_resetbuffer();
+    switch (luaL_findstring(p, options)) {
+      case 0:  /* number */
+        if (!read_number(f)) return;  /* read fails */
+        continue;  /* number is already pushed; avoid the "pushstring" */
+      case 1:  /* line */
+        success = read_line(f);
+        break;
+      case 2: case 3:  /* file */
+        read_file(f);
+        success = 1; /* always success */
+        break;
+      case 4:  /* word */
+        success = read_pattern(f, "{%s*}%S%S*");
+        break;
+      default:
+        success = read_pattern(f, p);
+    }
+    l = luaL_getsize();
+    if (!success && l==0) return;  /* read fails */
+    lua_pushlstring(luaL_buffer(), l);
+  } while ((p = luaL_opt_string(arg++, NULL)) != NULL);
+}
+
+/* }====================================================== */
+
+
+static void io_write (void) {
   int arg = FIRSTARG;
   FILE *f = getfileparam(FOUTPUT, &arg);
   int status = 1;
   char *s;
-  while ((s = luaL_opt_string(arg++, NULL)) != NULL)
-    status = status && (fputs(s, f) != EOF);
+  long l;
+  while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL)
+    status = status && ((long)fwrite(s, 1, l, f) == l);
   pushresult(status);
 }
 
 
-static void io_execute (void)
-{
+static void io_seek (void) {
+  static int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+  static char *modenames[] = {"set", "cur", "end", NULL};
+  FILE *f = getnonullfile(FIRSTARG);
+  int op = luaL_findstring(luaL_opt_string(FIRSTARG+1, "cur"), modenames);
+  long offset = luaL_opt_long(FIRSTARG+2, 0);
+  luaL_arg_check(op != -1, FIRSTARG+1, "invalid mode");
+  op = fseek(f, offset, mode[op]);
+  if (op)
+    pushresult(0);  /* error */
+  else
+    lua_pushnumber(ftell(f));
+}
+
+
+static void io_flush (void) {
+  FILE *f = getfile(FIRSTARG);
+  luaL_arg_check(f || lua_getparam(FIRSTARG) == LUA_NOOBJECT, FIRSTARG,
+                 "invalid file handle");
+  pushresult(fflush(f) == 0);
+}
+
+/* }====================================================== */
+
+
+/*
+** {======================================================
+** Other O.S. Operations
+** =======================================================
+*/
+
+static void io_execute (void) {
   lua_pushnumber(system(luaL_check_string(1)));
 }
 
 
-static void io_remove  (void)
-{
+static void io_remove  (void) {
   pushresult(remove(luaL_check_string(1)) == 0);
 }
 
 
-static void io_rename (void)
-{
+static void io_rename (void) {
   pushresult(rename(luaL_check_string(1),
                     luaL_check_string(2)) == 0);
 }
 
 
-static void io_tmpname (void)
-{
+static void io_tmpname (void) {
   lua_pushstring(tmpnam(NULL));
 }
 
 
 
-static void io_getenv (void)
-{
+static void io_getenv (void) {
   lua_pushstring(getenv(luaL_check_string(1)));  /* if NULL push nil */
 }
 
 
-static void io_date (void)
-{
-  time_t t;
-  struct tm *tm;
+static void io_clock (void) {
+  lua_pushnumber(((double)clock())/CLOCKS_PER_SEC);
+}
+
+
+static void io_date (void) {
+  char b[256];
   char *s = luaL_opt_string(1, "%c");
-  char b[BUFSIZ];
+  struct tm *tm;
+  time_t t;
   time(&t); tm = localtime(&t);
   if (strftime(b,sizeof(b),s,tm))
     lua_pushstring(b);
@@ -290,124 +438,151 @@ static void io_date (void)
 }
 
 
-static void setloc (void)
-{
+static void setloc (void) {
   static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC,
                       LC_TIME};
-  int op = (int)luaL_opt_number(2, 0);
-  luaL_arg_check(0 <= op && op <= 5, 2, "invalid option");
+  static char *catnames[] = {"all", "collate", "ctype", "monetary",
+     "numeric", "time", NULL};
+  int op = luaL_findstring(luaL_opt_string(2, "all"), catnames);
+  luaL_arg_check(op != -1, 2, "invalid option");
   lua_pushstring(setlocale(cat[op], luaL_check_string(1)));
 }
 
 
-static void io_exit (void)
-{
+static void io_exit (void) {
   lua_Object o = lua_getparam(1);
   exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);
 }
 
+/* }====================================================== */
 
-static void io_debug (void)
-{
-  while (1) {
+
+
+static void io_debug (void) {
+  for (;;) {
     char buffer[250];
     fprintf(stderr, "lua_debug> ");
-    if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
-    if (strcmp(buffer, "cont\n") == 0) return;
+    if (fgets(buffer, sizeof(buffer), stdin) == 0 ||
+        strcmp(buffer, "cont\n") == 0)
+      return;
     lua_dostring(buffer);
   }
 }
 
 
-static void lua_printstack (FILE *f)
-{
+
+#define MESSAGESIZE	150
+#define MAXMESSAGE	(MESSAGESIZE*10)
+
+
+#define MAXSRC		40
+
+
+static void errorfb (void) {
+  char buff[MAXMESSAGE];
   int level = 1;  /* skip level 0 (it's this function) */
   lua_Object func;
+  sprintf(buff, "lua error: %.200s\n", lua_getstring(lua_getparam(1)));
   while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
     char *name;
     int currentline;
-    char *filename;
+    char *chunkname;
+    char buffchunk[MAXSRC];
     int linedefined;
-    lua_funcinfo(func, &filename, &linedefined);
-    fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t");
+    lua_funcinfo(func, &chunkname, &linedefined);
+    luaL_chunkid(buffchunk, chunkname, sizeof(buffchunk));
+    if (level == 2) strcat(buff, "Active Stack:\n");
+    strcat(buff, "\t");
+    if (strlen(buff) > MAXMESSAGE-MESSAGESIZE) {
+      strcat(buff, "...\n");
+      break;  /* buffer is full */
+    }
     switch (*lua_getobjname(func, &name)) {
       case 'g':
-        fprintf(f, "function %s", name);
+        sprintf(buff+strlen(buff), "function `%.50s'", name);
         break;
       case 't':
-        fprintf(f, "`%s' tag method", name);
+        sprintf(buff+strlen(buff), "`%.50s' tag method", name);
         break;
       default: {
         if (linedefined == 0)
-          fprintf(f, "main of %s", filename);
+          sprintf(buff+strlen(buff), "main of %.50s", buffchunk);
         else if (linedefined < 0)
-          fprintf(f, "%s", filename);
+          sprintf(buff+strlen(buff), "%.50s", buffchunk);
         else
-          fprintf(f, "function (%s:%d)", filename, linedefined);
-        filename = NULL;
+          sprintf(buff+strlen(buff), "function <%d:%.50s>",
+                  linedefined, buffchunk);
+        chunkname = NULL;
       }
     }
     if ((currentline = lua_currentline(func)) > 0)
-      fprintf(f, " at line %d", currentline);
-    if (filename)
-      fprintf(f, " [in file %s]", filename);
-    fprintf(f, "\n");
+      sprintf(buff+strlen(buff), " at line %d", currentline);
+    if (chunkname)
+      sprintf(buff+strlen(buff), " [%.50s]", buffchunk);
+    strcat(buff, "\n");
+  }
+  func = lua_rawgetglobal("_ALERT");
+  if (lua_isfunction(func)) {  /* avoid error loop if _ALERT is not defined */
+    lua_pushstring(buff);
+    lua_callfunction(func);
   }
-}
-
-
-static void errorfb (void)
-{
-  fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1)));
-  lua_printstack(stderr);
 }
 
 
 
 static struct luaL_reg iolib[] = {
-{"setlocale", setloc},
-{"execute",  io_execute},
-{"remove",   io_remove},
-{"rename",   io_rename},
-{"tmpname",   io_tmpname},
-{"getenv",   io_getenv},
-{"date",     io_date},
-{"exit",     io_exit},
-{"debug",    io_debug},
-{"print_stack", errorfb}
+  {"_ERRORMESSAGE", errorfb},
+  {"clock",     io_clock},
+  {"date",     io_date},
+  {"debug",    io_debug},
+  {"execute",  io_execute},
+  {"exit",     io_exit},
+  {"getenv",   io_getenv},
+  {"remove",   io_remove},
+  {"rename",   io_rename},
+  {"setlocale", setloc},
+  {"tmpname",   io_tmpname}
 };
 
+
 static struct luaL_reg iolibtag[] = {
-{"readfrom", io_readfrom},
-{"writeto",  io_writeto},
-{"appendto", io_appendto},
-{"read",     io_read},
-{"write",    io_write}
+  {"appendto", io_appendto},
+  {"closefile",   io_close},
+  {"flush",     io_flush},
+  {"openfile",   io_open},
+  {"read",     io_read},
+  {"readfrom", io_readfrom},
+  {"seek",     io_seek},
+  {"write",    io_write},
+  {"writeto",  io_writeto}
 };
 
-static void openwithtags (void)
-{
-  int iotag = lua_newtag();
-  int closedtag = lua_newtag();
+
+static void openwithtags (void) {
   int i;
+  int iotag = lua_newtag();
+  lua_newtag();  /* alloc CLOSEDTAG: assume that CLOSEDTAG = iotag-1 */
   for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
-    /* put both tags as upvalues for these functions */
+    /* put iotag as upvalue for these functions */
     lua_pushnumber(iotag);
-    lua_pushnumber(closedtag);
-    lua_pushCclosure(iolibtag[i].func, 2);
+    lua_pushcclosure(iolibtag[i].func, 1);
     lua_setglobal(iolibtag[i].name);
   }
+  /* predefined file handles */
   setfile(stdin, FINPUT, iotag);
   setfile(stdout, FOUTPUT, iotag);
   setfile(stdin, "_STDIN", iotag);
   setfile(stdout, "_STDOUT", iotag);
   setfile(stderr, "_STDERR", iotag);
+  /* close file when collected */
+  lua_pushnumber(iotag);
+  lua_pushcclosure(gc_close, 1); 
+  lua_settagmethod(iotag, "gc");
 }
 
-void lua_iolibopen (void)
-{
+void lua_iolibopen (void) {
+  /* register lib functions */
   luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
   openwithtags();
-  lua_pushcfunction(errorfb);
-  lua_seterrormethod();
 }
+

llex.c

@@ -1,6 +1,6 @@
 /*
-** $Id: llex.c,v 1.12 1997/12/22 17:52:20 roberto Exp roberto $
-** Lexical Analizer
+** $Id: llex.c,v 1.33 1999/03/11 18:59:19 roberto Exp roberto $
+** Lexical Analyzer
 ** See Copyright Notice in lua.h
 */
 
@@ -15,59 +15,85 @@
 #include "lparser.h"
 #include "lstate.h"
 #include "lstring.h"
-#include "lstx.h"
 #include "luadebug.h"
 #include "lzio.h"
 
 
 
-int lua_debug=0;
-
-
 #define next(LS) (LS->current = zgetc(LS->lex_z))
 
 
-static struct {
-  char *name;
-  int token;
-} reserved [] = {
-    {"and", AND}, {"do", DO}, {"else", ELSE}, {"elseif", ELSEIF},
-    {"end", END}, {"function", FUNCTION}, {"if", IF}, {"local", LOCAL},
-    {"nil", NIL}, {"not", NOT}, {"or", OR}, {"repeat", REPEAT},
-    {"return", RETURN}, {"then", THEN}, {"until", UNTIL}, {"while", WHILE}
-};
+#define save(c)	luaL_addchar(c)
+#define save_and_next(LS)  (save(LS->current), next(LS))
 
-void luaX_init (void)
-{
+
+char *reserved [] = {"and", "do", "else", "elseif", "end", "function",
+    "if", "local", "nil", "not", "or", "repeat", "return", "then",
+    "until", "while"};
+
+
+void luaX_init (void) {
   int i;
   for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) {
-    TaggedString *ts = luaS_new(reserved[i].name);
-    ts->head.marked = reserved[i].token;  /* reserved word  (always > 255) */
+    TaggedString *ts = luaS_new(reserved[i]);
+    ts->head.marked = FIRST_RESERVED+i;  /* reserved word  (always > 255) */
   }
 }
 
 
+#define MAXSRC          40
+
+void luaX_syntaxerror (LexState *ls, char *s, char *token) {
+  char buff[MAXSRC];
+  luaL_chunkid(buff, zname(ls->lex_z), sizeof(buff));
+  if (token[0] == '\0')
+    token = "<eof>";
+  luaL_verror("%.100s;\n  last token read: `%.50s' at line %d in %.50s",
+              s, token, ls->linenumber, buff);
+}
+
+
+void luaX_error (LexState *ls, char *s) {
+  save('\0');
+  luaX_syntaxerror(ls, s, luaL_buffer());
+}
+
+
+void luaX_token2str (int token, char *s) {
+  if (token < 255) {
+    s[0] = (char)token;
+    s[1] = '\0';
+  }
+  else
+    strcpy(s, reserved[token-FIRST_RESERVED]);
+}
+
+
+static void luaX_invalidchar (LexState *ls, int c) {
+  char buff[10];
+  sprintf(buff, "0x%02X", c);
+  luaX_syntaxerror(ls, "invalid control char", buff);
+}
+
+
 static void firstline (LexState *LS)
 {
   int c = zgetc(LS->lex_z);
-  if (c == '#') {
-    LS->linenumber++;
+  if (c == '#')
     while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */;
-  }
   zungetc(LS->lex_z);
 }
 
 
-void luaX_setinput (ZIO *z)
+void luaX_setinput (LexState *LS, ZIO *z)
 {
-  LexState *LS = L->lexstate;
   LS->current = '\n';
-  LS->linelasttoken = 0;
   LS->linenumber = 0;
   LS->iflevel = 0;
   LS->ifstate[0].skip = 0;
   LS->ifstate[0].elsepart = 1;  /* to avoid a free $else */
   LS->lex_z = z;
+  LS->fs = NULL;
   firstline(LS);
   luaL_resetbuffer();
 }
@@ -89,15 +115,15 @@ static void skipspace (LexState *LS)
 }
 
 
-static int checkcond (char *buff)
+static int checkcond (LexState *LS, char *buff)
 {
   static char *opts[] = {"nil", "1", NULL};
-  int i = luaO_findstring(buff, opts);
+  int i = luaL_findstring(buff, opts);
   if (i >= 0) return i;
   else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
     return luaS_globaldefined(buff);
   else {
-    luaY_syntaxerror("invalid $if condition", buff);
+    luaX_syntaxerror(LS, "invalid $if condition", buff);
     return 0;  /* to avoid warnings */
   }
 }
@@ -110,9 +136,9 @@ static void readname (LexState *LS, char *buff)
   while (isalnum(LS->current) || LS->current == '_') {
     if (i >= PRAGMASIZE) {
       buff[PRAGMASIZE] = 0;
-      luaY_syntaxerror("pragma too long", buff);
+      luaX_syntaxerror(LS, "pragma too long", buff);
     }
-    buff[i++] = LS->current;
+    buff[i++] = (char)LS->current;
     next(LS);
   }
   buff[i] = 0;
@@ -128,7 +154,7 @@ static void ifskip (LexState *LS)
     if (LS->current == '\n')
       inclinenumber(LS);
     else if (LS->current == EOZ)
-      luaY_syntaxerror("input ends inside a $if", "");
+      luaX_error(LS, "input ends inside a $if");
     else next(LS);
   }
 }
@@ -146,12 +172,12 @@ static void inclinenumber (LexState *LS)
     int skip = LS->ifstate[LS->iflevel].skip;
     next(LS);  /* skip $ */
     readname(LS, buff);
-    switch (luaO_findstring(buff, pragmas)) {
+    switch (luaL_findstring(buff, pragmas)) {
       case 0:  /* debug */
-        if (!skip) lua_debug = 1;
+        if (!skip) L->debug = 1;
         break;
       case 1:  /* nodebug */
-        if (!skip) lua_debug = 0;
+        if (!skip) L->debug = 0;
         break;
       case 2:  /* endinput */
         if (!skip) {
@@ -161,40 +187,41 @@ static void inclinenumber (LexState *LS)
         break;
       case 3:  /* end */
         if (LS->iflevel-- == 0)
-          luaY_syntaxerror("unmatched $end", "$end");
+          luaX_syntaxerror(LS, "unmatched $end", "$end");
         break;
       case 4:  /* ifnot */
         ifnot = 1;
         /* go through */
       case 5:  /* if */
         if (LS->iflevel == MAX_IFS-1)
-          luaY_syntaxerror("too many nested $ifs", "$if");
+          luaX_syntaxerror(LS, "too many nested $ifs", "$if");
         readname(LS, buff);
         LS->iflevel++;
         LS->ifstate[LS->iflevel].elsepart = 0;
-        LS->ifstate[LS->iflevel].condition = checkcond(buff) ? !ifnot : ifnot;
+        LS->ifstate[LS->iflevel].condition = checkcond(LS, buff) ? !ifnot : ifnot;
         LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition;
         break;
       case 6:  /* else */
         if (LS->ifstate[LS->iflevel].elsepart)
-          luaY_syntaxerror("unmatched $else", "$else");
+          luaX_syntaxerror(LS, "unmatched $else", "$else");
         LS->ifstate[LS->iflevel].elsepart = 1;
         LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip ||
                                       LS->ifstate[LS->iflevel].condition;
         break;
       default:
-        luaY_syntaxerror("unknown pragma", buff);
+        luaX_syntaxerror(LS, "unknown pragma", buff);
     }
     skipspace(LS);
     if (LS->current == '\n')  /* pragma must end with a '\n' ... */
       inclinenumber(LS);
     else if (LS->current != EOZ)  /* or eof */
-      luaY_syntaxerror("invalid pragma format", buff);
+      luaX_syntaxerror(LS, "invalid pragma format", buff);
     ifskip(LS);
   }
 }
 
 
+
 /*
 ** =======================================================
 ** LEXICAL ANALIZER
@@ -203,25 +230,13 @@ static void inclinenumber (LexState *LS)
 
 
 
-#define save(c)	luaL_addchar(c)
-#define save_and_next(LS)  (save(LS->current), next(LS))
-
-
-char *luaX_lasttoken (void)
-{
-  save(0);
-  return luaL_buffer();
-}
-
-
-static int read_long_string (LexState *LS, YYSTYPE *l)
-{
+static int read_long_string (LexState *LS) {
   int cont = 0;
-  while (1) {
+  for (;;) {
     switch (LS->current) {
       case EOZ:
-        save(0);
-        return WRONGTOKEN;
+        luaX_error(LS, "unfinished long string");
+        return EOS;  /* to avoid warnings */
       case '[':
         save_and_next(LS);
         if (LS->current == '[') {
@@ -245,28 +260,16 @@ static int read_long_string (LexState *LS, YYSTYPE *l)
         save_and_next(LS);
     }
   } endloop:
-  save_and_next(LS);  /* pass the second ']' */
-  L->Mbuffer[L->Mbuffnext-2] = 0;  /* erases ']]' */
-  l->pTStr = luaS_new(L->Mbuffbase+2);
-  L->Mbuffer[L->Mbuffnext-2] = ']';  /* restores ']]' */
+  save_and_next(LS);  /* skip the second ']' */
+  LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+2),
+                          L->Mbuffnext-L->Mbuffbase-4);
   return STRING;
 }
 
 
-/* to avoid warnings; this declaration cannot be public since YYSTYPE
-** cannot be visible in llex.h (otherwise there is an error, since
-** the parser body redefines it!)
-*/
-int luaY_lex (YYSTYPE *l);
-int luaY_lex (YYSTYPE *l)
-{
-  LexState *LS = L->lexstate;
-  double a;
+int luaX_lex (LexState *LS) {
   luaL_resetbuffer();
-  if (lua_debug)
-    luaY_codedebugline(LS->linelasttoken);
-  LS->linelasttoken = LS->linenumber;
-  while (1) {
+  for (;;) {
     switch (LS->current) {
 
       case ' ': case '\t': case '\r':  /* CR: to avoid problems with DOS */
@@ -275,7 +278,6 @@ int luaY_lex (YYSTYPE *l)
 
       case '\n':
         inclinenumber(LS);
-        LS->linelasttoken = LS->linenumber;
         continue;
 
       case '-':
@@ -290,7 +292,7 @@ int luaY_lex (YYSTYPE *l)
         if (LS->current != '[') return '[';
         else {
           save_and_next(LS);  /* pass the second '[' */
-          return read_long_string(LS, l);
+          return read_long_string(LS);
         }
 
       case '=':
@@ -321,26 +323,46 @@ int luaY_lex (YYSTYPE *l)
           switch (LS->current) {
             case EOZ:
             case '\n':
-              save(0);
-              return WRONGTOKEN;
+              luaX_error(LS, "unfinished string");
+              return EOS;  /* to avoid warnings */
             case '\\':
               next(LS);  /* do not save the '\' */
               switch (LS->current) {
+                case 'a': save('\a'); next(LS); break;
+                case 'b': save('\b'); next(LS); break;
+                case 'f': save('\f'); next(LS); break;
                 case 'n': save('\n'); next(LS); break;
-                case 't': save('\t'); next(LS); break;
                 case 'r': save('\r'); next(LS); break;
+                case 't': save('\t'); next(LS); break;
+                case 'v': save('\v'); next(LS); break;
                 case '\n': save('\n'); inclinenumber(LS); break;
-                default : save_and_next(LS); break;
+                default : {
+                  if (isdigit(LS->current)) {
+                    int c = 0;
+                    int i = 0;
+                    do {
+                      c = 10*c + (LS->current-'0');
+                      next(LS);
+                    } while (++i<3 && isdigit(LS->current));
+                    if (c != (unsigned char)c)
+                      luaX_error(LS, "escape sequence too large");
+                    save(c);
+                  }
+                  else {  /* handles \, ", ', and ? */
+                    save(LS->current);
+                    next(LS);
+                  }
+                  break;
+                }
               }
               break;
             default:
               save_and_next(LS);
           }
         }
-        next(LS);  /* skip delimiter */
-        save(0);
-        l->pTStr = luaS_new(L->Mbuffbase+1);
-        L->Mbuffer[L->Mbuffnext-1] = del;  /* restore delimiter */
+        save_and_next(LS);  /* skip delimiter */
+        LS->seminfo.ts = luaS_newlstr(L->Mbuffer+(L->Mbuffbase+1),
+                                L->Mbuffnext-L->Mbuffbase-2);
         return STRING;
       }
 
@@ -357,65 +379,46 @@ int luaY_lex (YYSTYPE *l)
           else return CONC;   /* .. */
         }
         else if (!isdigit(LS->current)) return '.';
-        /* LS->current is a digit: goes through to number */
-	a=0.0;
-        goto fraction;
+        goto fraction;  /* LS->current is a digit: goes through to number */
 
       case '0': case '1': case '2': case '3': case '4':
       case '5': case '6': case '7': case '8': case '9':
-	a=0.0;
         do {
-          a=10.0*a+(LS->current-'0');
           save_and_next(LS);
         } while (isdigit(LS->current));
         if (LS->current == '.') {
           save_and_next(LS);
           if (LS->current == '.') {
-            save(0);
-            luaY_error(
+            save('.');
+            luaX_error(LS, 
               "ambiguous syntax (decimal point x string concatenation)");
           }
         }
       fraction:
-	{ double da=0.1;
-	  while (isdigit(LS->current))
-	  {
-            a+=(LS->current-'0')*da;
-            da/=10.0;
+        while (isdigit(LS->current))
+          save_and_next(LS);
+        if (toupper(LS->current) == 'E') {
+          save_and_next(LS);  /* read 'E' */
+          save_and_next(LS);  /* read '+', '-' or first digit */
+          while (isdigit(LS->current))
             save_and_next(LS);
-          }
-          if (toupper(LS->current) == 'E') {
-	    int e=0;
-	    int neg;
-	    double ea;
-            save_and_next(LS);
-	    neg=(LS->current=='-');
-            if (LS->current == '+' || LS->current == '-') save_and_next(LS);
-            if (!isdigit(LS->current)) {
-              save(0); return WRONGTOKEN; }
-            do {
-              e=10.0*e+(LS->current-'0');
-              save_and_next(LS);
-            } while (isdigit(LS->current));
-	    for (ea=neg?0.1:10.0; e>0; e>>=1)
-	    {
-	      if (e & 1) a*=ea;
-	      ea*=ea;
-	    }
-          }
-          l->vReal = a;
-          return NUMBER;
         }
+        save('\0');
+        LS->seminfo.r = luaO_str2d(L->Mbuffer+L->Mbuffbase);
+        if (LS->seminfo.r < 0)
+          luaX_error(LS, "invalid numeric format");
+        return NUMBER;
 
       case EOZ:
-        save(0);
         if (LS->iflevel > 0)
-          luaY_syntaxerror("input ends inside a $if", "");
-        return 0;
+          luaX_error(LS, "input ends inside a $if");
+        return EOS;
 
       default:
         if (LS->current != '_' && !isalpha(LS->current)) {
           int c = LS->current;
+          if (iscntrl(c))
+            luaX_invalidchar(LS, c);
           save_and_next(LS);
           return c;
         }
@@ -424,11 +427,11 @@ int luaY_lex (YYSTYPE *l)
           do {
             save_and_next(LS);
           } while (isalnum(LS->current) || LS->current == '_');
-          save(0);
-          ts = luaS_new(L->Mbuffbase);
-          if (ts->head.marked > 255)
+          save('\0');
+          ts = luaS_new(L->Mbuffer+L->Mbuffbase);
+          if (ts->head.marked >= FIRST_RESERVED)
             return ts->head.marked;  /* reserved word */
-          l->pTStr = ts;
+          LS->seminfo.ts = ts;
           return NAME;
         }
     }

llex.h

@@ -1,6 +1,6 @@
 /*
-** $Id: llex.h,v 1.6 1997/12/17 20:48:58 roberto Exp roberto $
-** Lexical Analizer
+** $Id: llex.h,v 1.10 1998/07/24 18:02:38 roberto Exp roberto $
+** Lexical Analyzer
 ** See Copyright Notice in lua.h
 */
 
@@ -11,31 +11,52 @@
 #include "lzio.h"
 
 
+#define FIRST_RESERVED	260
+
+/* maximum length of a reserved word (+1 for terminal 0) */
+#define TOKEN_LEN	15
+
+enum RESERVED {
+  /* terminal symbols denoted by reserved words */
+  AND = FIRST_RESERVED,
+  DO, ELSE, ELSEIF, END, FUNCTION, IF, LOCAL, NIL, NOT, OR,
+  REPEAT, RETURN, THEN, UNTIL, WHILE,
+  /* other terminal symbols */
+  NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS};
+
+
 #define MAX_IFS 5
 
 /* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
 
 struct ifState {
-  int elsepart;  /* true if its in the $else part */
+  int elsepart;  /* true if it's in the $else part */
   int condition;  /* true if $if condition is true */
-  int skip;  /* true if part must be skiped */
+  int skip;  /* true if part must be skipped */
 };
 
 
 typedef struct LexState {
   int current;  /* look ahead character */
+  int token;  /* look ahead token */
+  struct FuncState *fs;  /* 'FuncState' is private for the parser */
+  union {
+    real r;
+    TaggedString *ts;
+  } seminfo;  /* semantics information */
   struct zio *lex_z;  /* input stream */
   int linenumber;  /* input line counter */
-  int linelasttoken;  /* line where last token was read */
-  int lastline;  /* last line wherein a SETLINE was generated */
   int iflevel;  /* level of nested $if's (for lexical analysis) */
   struct ifState ifstate[MAX_IFS];
 } LexState;
 
 
 void luaX_init (void);
-void luaX_setinput (ZIO *z);
-char *luaX_lasttoken (void);
+void luaX_setinput (LexState *LS, ZIO *z);
+int luaX_lex (LexState *LS);
+void luaX_syntaxerror (LexState *ls, char *s, char *token);
+void luaX_error (LexState *ls, char *s);
+void luaX_token2str (int token, char *s);
 
 
 #endif

lmathlib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lmathlib.c,v 1.7 1997/12/09 13:35:19 roberto Exp roberto $
+** $Id: lmathlib.c,v 1.15 1999/01/04 12:41:12 roberto Exp roberto $
 ** Lua standard mathematical library
 ** See Copyright Notice in lua.h
 */
@@ -12,113 +12,110 @@
 #include "lua.h"
 #include "lualib.h"
 
-#ifdef M_PI
-#define PI                      M_PI
+
+#define PI	(3.14159265358979323846)
+#define RADIANS_PER_DEGREE	(PI/180.0)
+
+
+
+/*
+** If you want Lua to operate in radians (instead of degrees),
+** define RADIANS
+*/
+#ifdef RADIANS
+#define FROMRAD(a)	(a)
+#define TORAD(a)	(a)
 #else
-#define PI          ((double)3.14159265358979323846)
+#define FROMRAD(a)	((a)/RADIANS_PER_DEGREE)
+#define TORAD(a)	((a)*RADIANS_PER_DEGREE)
 #endif
 
 
-#define FROMRAD(a) ((a)*(180.0/PI))
-#define TORAD(a)    ((a)*(PI/180.0))
-
-
-static void math_abs (void)
-{
-  double d = luaL_check_number(1);
-  if (d < 0) d = -d;
-  lua_pushnumber(d);
+static void math_abs (void) {
+  lua_pushnumber(fabs(luaL_check_number(1)));
 }
 
-static void math_sin (void)
-{
+static void math_sin (void) {
   lua_pushnumber(sin(TORAD(luaL_check_number(1))));
 }
 
-static void math_cos (void)
-{
+static void math_cos (void) {
   lua_pushnumber(cos(TORAD(luaL_check_number(1))));
 }
 
-static void math_tan (void)
-{
+static void math_tan (void) {
   lua_pushnumber(tan(TORAD(luaL_check_number(1))));
 }
 
-static void math_asin (void)
-{
+static void math_asin (void) {
   lua_pushnumber(FROMRAD(asin(luaL_check_number(1))));
 }
 
-static void math_acos (void)
-{
+static void math_acos (void) {
   lua_pushnumber(FROMRAD(acos(luaL_check_number(1))));
 }
 
-static void math_atan (void)
-{
+static void math_atan (void) {
   lua_pushnumber(FROMRAD(atan(luaL_check_number(1))));
 }
 
-static void math_atan2 (void)
-{
+static void math_atan2 (void) {
   lua_pushnumber(FROMRAD(atan2(luaL_check_number(1), luaL_check_number(2))));
 }
 
-static void math_ceil (void)
-{
+static void math_ceil (void) {
   lua_pushnumber(ceil(luaL_check_number(1)));
 }
 
-static void math_floor (void)
-{
+static void math_floor (void) {
   lua_pushnumber(floor(luaL_check_number(1)));
 }
 
-static void math_mod (void)
-{
+static void math_mod (void) {
   lua_pushnumber(fmod(luaL_check_number(1), luaL_check_number(2)));
 }
 
-static void math_sqrt (void)
-{
+static void math_sqrt (void) {
   lua_pushnumber(sqrt(luaL_check_number(1)));
 }
 
-static void math_pow (void)
-{
+static void math_pow (void) {
   lua_pushnumber(pow(luaL_check_number(1), luaL_check_number(2)));
 }
 
-static void math_log (void)
-{
+static void math_log (void) {
   lua_pushnumber(log(luaL_check_number(1)));
 }
 
-static void math_log10 (void)
-{
+static void math_log10 (void) {
   lua_pushnumber(log10(luaL_check_number(1)));
 }
 
-static void math_exp (void)
-{
+static void math_exp (void) {
   lua_pushnumber(exp(luaL_check_number(1)));
 }
 
-static void math_deg (void)
-{
-  lua_pushnumber(luaL_check_number(1)*(180.0/PI));
+static void math_deg (void) {
+  lua_pushnumber(luaL_check_number(1)/RADIANS_PER_DEGREE);
 }
 
-static void math_rad (void)
-{
-  lua_pushnumber(luaL_check_number(1)*(PI/180.0));
+static void math_rad (void) {
+  lua_pushnumber(luaL_check_number(1)*RADIANS_PER_DEGREE);
+}
+
+static void math_frexp (void) {
+  int e;
+  lua_pushnumber(frexp(luaL_check_number(1), &e));
+  lua_pushnumber(e);
+}
+
+static void math_ldexp (void) {
+  lua_pushnumber(ldexp(luaL_check_number(1), luaL_check_int(2)));
 }
 
 
 
-static void math_min (void)
-{
+static void math_min (void) {
   int i = 1;
   double dmin = luaL_check_number(i);
   while (lua_getparam(++i) != LUA_NOOBJECT) {
@@ -130,8 +127,7 @@ static void math_min (void)
 }
 
 
-static void math_max (void)
-{
+static void math_max (void) {
   int i = 1;
   double dmax = luaL_check_number(i);
   while (lua_getparam(++i) != LUA_NOOBJECT) {
@@ -143,22 +139,27 @@ static void math_max (void)
 }
 
 
-static void math_random (void)
-{
-  /* the '%' is needed because on some sistems (SunOS!) "rand()" may */
-  /* return a value bigger than RAND_MAX... */
+static void math_random (void) {
+  /* the '%' avoids the (rare) case of r==1, and is needed also because on
+     some systems (SunOS!) "rand()" may return a value bigger than RAND_MAX */
   double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
-  double l = luaL_opt_number(1, 0);
+  int l = luaL_opt_int(1, 0);
   if (l == 0)
     lua_pushnumber(r);
-  else
-    lua_pushnumber((int)(r*l)+1);
+  else {
+    int u = luaL_opt_int(2, 0);
+    if (u == 0) {
+      u = l;
+      l = 1;
+    }
+    luaL_arg_check(l<=u, 1, "interval is empty");
+    lua_pushnumber((int)(r*(u-l+1))+l);
+  }
 }
 
 
-static void math_randomseed (void)
-{
-  srand(luaL_check_number(1));
+static void math_randomseed (void) {
+  srand(luaL_check_int(1));
 }
 
 
@@ -170,10 +171,12 @@ static struct luaL_reg mathlib[] = {
 {"asin",  math_asin},
 {"acos",  math_acos},
 {"atan",  math_atan},
-{"atan2",  math_atan2},
+{"atan2", math_atan2},
 {"ceil",  math_ceil},
 {"floor", math_floor},
 {"mod",   math_mod},
+{"frexp", math_frexp},
+{"ldexp", math_ldexp},
 {"sqrt",  math_sqrt},
 {"min",   math_min},
 {"max",   math_max},
@@ -189,10 +192,8 @@ static struct luaL_reg mathlib[] = {
 /*
 ** Open math library
 */
-void lua_mathlibopen (void)
-{
+void lua_mathlibopen (void) {
   luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
-  lua_pushstring("deg"); lua_setglobal("_TRIGMODE");
   lua_pushcfunction(math_pow);
   lua_pushnumber(0);  /* to get its tag */
   lua_settagmethod(lua_tag(lua_pop()), "pow");

lmem.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.c,v 1.3 1997/12/01 20:30:44 roberto Exp roberto $
+** $Id: lmem.c,v 1.13 1999/02/26 15:50:10 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -12,41 +12,59 @@
 #include "lua.h"
 
 
+/*
+** real ANSI systems do not need these tests;
+** but some systems (Sun OS) are not that ANSI...
+*/
+#ifdef OLD_ANSI
+#define realloc(b,s)	((b) == NULL ? malloc(s) : (realloc)(b, s))
+#define free(b)		if (b) (free)(b)
+#endif
 
-int luaM_growaux (void **block, unsigned long nelems, int size,
-                       char *errormsg, unsigned long limit)
-{
-  if (nelems >= limit)
-    lua_error(errormsg);
-  nelems = (nelems == 0) ? 32 : nelems*2;
-  if (nelems > limit)
-    nelems = limit;
-  *block = luaM_realloc(*block, nelems*size);
-  return (int)nelems;
-}
+
+#define MINSIZE	16	/* minimum size for "growing" vectors */
 
 
 
 #ifndef DEBUG
 
+
+static unsigned long power2 (unsigned long n) {
+  unsigned long p = MINSIZE;
+  while (p<=n) p<<=1;
+  return p;
+}
+
+
+void *luaM_growaux (void *block, unsigned long nelems, int inc, int size,
+                       char *errormsg, unsigned long limit) {
+  unsigned long newn = nelems+inc;
+  if ((newn ^ nelems) <= nelems ||  /* still the same power of 2 limit? */
+       (nelems > 0 && newn < MINSIZE))  /* or block already is MINSIZE? */
+      return block;  /* do not need to reallocate */
+  else {  /* it crossed a power of 2 boundary; grow to next power */
+    if (newn >= limit)
+      lua_error(errormsg);
+    newn = power2(newn);
+    if (newn > limit)
+      newn = limit;
+    return luaM_realloc(block, newn*size);
+  }
+}
+
+
 /*
 ** generic allocation routine.
-** real ANSI systems do not need some of these tests,
-** since realloc(NULL, s)==malloc(s) and realloc(b, 0)==free(b).
-** But some systems (e.g. Sun OS) are not that ANSI...
 */
-void *luaM_realloc (void *block, unsigned long size)
-{
+void *luaM_realloc (void *block, unsigned long size) {
   size_t s = (size_t)size;
   if (s != size)
-    lua_error("Allocation Error: Block too big");
+    lua_error("memory allocation error: block too big");
   if (size == 0) {
-    if (block) {
-      free(block);
-    }
+    free(block);  /* block may be NULL, that is OK for free */
     return NULL;
   }
-  block = block ? realloc(block, s) : malloc(s);
+  block = realloc(block, s);
   if (block == NULL)
     lua_error(memEM);
   return block;
@@ -57,53 +75,60 @@ void *luaM_realloc (void *block, unsigned long size)
 #else
 /* DEBUG */
 
-#include <assert.h>
 #include <string.h>
 
 
+void *luaM_growaux (void *block, unsigned long nelems, int inc, int size,
+                       char *errormsg, unsigned long limit) {
+  unsigned long newn = nelems+inc;
+  if (newn >= limit)
+    lua_error(errormsg);
+  return luaM_realloc(block, newn*size);
+}
+
+
+#define HEADER	(sizeof(double))
+
 #define MARK    55
 
 unsigned long numblocks = 0;
 unsigned long totalmem = 0;
 
 
-static void *checkblock (void *block)
-{
-  unsigned long *b = (unsigned long *)block - 1;
+static void *checkblock (void *block) {
+  unsigned long *b = (unsigned long *)((char *)block - HEADER);
   unsigned long size = *b;
-  assert(*(((char *)b)+size+sizeof(unsigned long)) == MARK);
+  LUA_ASSERT(*(((char *)b)+size+HEADER) == MARK, 
+             "corrupted block");
   numblocks--;
   totalmem -= size;
   return b;
 }
 
 
-void *luaM_realloc (void *block, unsigned long size)
-{
-  unsigned long realsize = sizeof(unsigned long)+size+sizeof(char);
+void *luaM_realloc (void *block, unsigned long size) {
+  unsigned long realsize = HEADER+size+1;
   if (realsize != (size_t)realsize)
-    lua_error("Allocation Error: Block too big");
-  if (size == 0) {  /* ANSI doen't need this, but some machines... */
+    lua_error("memory allocation error: block too big");
+  if (size == 0) {
     if (block) {
-      memset(block, -1, *((unsigned long *)block-1));  /* erase block */
+      unsigned long *b = (unsigned long *)((char *)block - HEADER);
+      memset(block, -1, *b);  /* erase block */
       block = checkblock(block);
-      free(block);
     }
+    free(block);
     return NULL;
   }
-  if (block) {
+  if (block)
     block = checkblock(block);
-    block = (unsigned long *)realloc(block, realsize);
-  }
-  else
-    block = (unsigned long *)malloc(realsize);
+  block = (unsigned long *)realloc(block, realsize);
   if (block == NULL)
     lua_error(memEM);
   totalmem += size;
   numblocks++;
   *(unsigned long *)block = size;
-  *(((char *)block)+size+sizeof(unsigned long)) = MARK;
-  return (unsigned long *)block+1;
+  *(((char *)block)+size+HEADER) = MARK;
+  return (unsigned long *)((char *)block+HEADER);
 }
 
 

lmem.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.h,v 1.4 1997/12/01 20:30:44 roberto Exp roberto $
+** $Id: lmem.h,v 1.7 1999/02/25 15:16:26 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -8,10 +8,7 @@
 #define lmem_h
 
 
-#ifndef NULL
-#define NULL 0
-#endif
-
+#include <stdlib.h>
 
 /* memory error messages */
 #define codeEM   "code size overflow"
@@ -19,18 +16,19 @@
 #define refEM   "reference table overflow"
 #define tableEM  "table overflow"
 #define memEM "not enough memory"
+#define arrEM	"internal array bigger than `int' limit"
 
 void *luaM_realloc (void *oldblock, unsigned long size);
-int luaM_growaux (void **block, unsigned long nelems, int size,
+void *luaM_growaux (void *block, unsigned long nelems, int inc, int size,
                        char *errormsg, unsigned long limit);
 
 #define luaM_free(b)	luaM_realloc((b), 0)
 #define luaM_malloc(t)	luaM_realloc(NULL, (t))
 #define luaM_new(t)          ((t *)luaM_malloc(sizeof(t)))
 #define luaM_newvector(n,t)  ((t *)luaM_malloc((n)*sizeof(t)))
-#define luaM_growvector(old,n,t,e,l) \
-          (luaM_growaux((void**)old,n,sizeof(t),e,l))
-#define luaM_reallocvector(v,n,t) ((t *)luaM_realloc(v,(n)*sizeof(t)))
+#define luaM_growvector(v,nelems,inc,t,e,l) \
+          ((v)=(t *)luaM_growaux(v,nelems,inc,sizeof(t),e,l))
+#define luaM_reallocvector(v,n,t) ((v)=(t *)luaM_realloc(v,(n)*sizeof(t)))
 
 
 #ifdef DEBUG

lobject.c

@@ -1,11 +1,11 @@
 /*
-** $Id: lobject.c,v 1.9 1997/12/26 18:38:16 roberto Exp roberto $
+** $Id: lobject.c,v 1.18 1999/02/26 15:48:30 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
 
+#include <ctype.h>
 #include <stdlib.h>
-#include <string.h>
 
 #include "lobject.h"
 #include "lua.h"
@@ -35,14 +35,12 @@ int luaO_redimension (int oldsize)
     if (dimensions[i] > oldsize)
       return dimensions[i];
   }
-  lua_error("table overflow");
+  lua_error("tableEM");
   return 0;  /* to avoid warnings */
 }
 
 
-int luaO_equalObj (TObject *t1, TObject *t2)
-{
-  if (ttype(t1) != ttype(t2)) return 0;
+int luaO_equalval (TObject *t1, TObject *t2) {
   switch (ttype(t1)) {
     case LUA_T_NIL: return 1;
     case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
@@ -52,22 +50,12 @@ int luaO_equalObj (TObject *t1, TObject *t2)
     case LUA_T_CPROTO: return fvalue(t1)  == fvalue(t2);
     case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;
     default:
-     lua_error("internal error in `lua_equalObj'");
-     return 0; /* UNREACHEABLE */
+     LUA_INTERNALERROR("invalid type");
+     return 0; /* UNREACHABLE */
   }
 }
 
 
-int luaO_findstring (char *name, char *list[])
-{
-  int i;
-  for (i=0; list[i]; i++)
-    if (strcmp(list[i], name) == 0)
-      return i;
-  return -1;  /* name not found */
-}
-
-
 void luaO_insertlist (GCnode *root, GCnode *node)
 {
   node->next = root->next;
@@ -75,20 +63,67 @@ void luaO_insertlist (GCnode *root, GCnode *node)
   node->marked = 0;
 }
 
+
 #ifdef OLD_ANSI
-void luaO_memup (void *dest, void *src, int size)
-{
-  char *d = dest;
-  char *s = src;
-  while (size--) d[size]=s[size];
+void luaO_memup (void *dest, void *src, int size) {
+  while (size--)
+    ((char *)dest)[size]=((char *)src)[size];
 }
 
-void luaO_memdown (void *dest, void *src, int size)
-{
-  char *d = dest;
-  char *s = src;
+void luaO_memdown (void *dest, void *src, int size) {
   int i;
-  for (i=0; i<size; i++) d[i]=s[i];
+  for (i=0; i<size; i++)
+    ((char *)dest)[i]=((char *)src)[i];
 }
 #endif
 
+
+
+static double expten (unsigned int e) {
+  double exp = 10.0;
+  double res = 1.0;
+  for (; e; e>>=1) {
+    if (e & 1) res *= exp;
+    exp *= exp;
+  }
+  return res;
+}
+
+
+double luaO_str2d (char *s) {  /* LUA_NUMBER */
+  double a = 0.0;
+  int point = 0;
+  while (isdigit((unsigned char)*s)) {
+    a = 10.0*a + (*(s++)-'0');
+  }
+  if (*s == '.') {
+    s++;
+    while (isdigit((unsigned char)*s)) {
+      a = 10.0*a + (*(s++)-'0');
+      point++;
+    }
+  }
+  if (toupper((unsigned char)*s) == 'E') {
+    int e = 0;
+    int sig = 1;
+    s++;
+    if (*s == '-') {
+      s++;
+      sig = -1;
+    }
+    else if (*s == '+') s++;
+    if (!isdigit((unsigned char)*s)) return -1;  /* no digit in the exponent? */
+    do {
+      e = 10*e + (*(s++)-'0');
+    } while (isdigit((unsigned char)*s));
+    point -= sig*e;
+  }
+  while (isspace((unsigned char)*s)) s++;
+  if (*s != '\0') return -1;  /* invalid trailing characters? */
+  if (point > 0)
+    a /= expten(point);
+  else if (point < 0)
+    a *= expten(-point);
+  return a;
+}
+

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.15 1998/01/13 13:27:25 roberto Exp $
+** $Id: lobject.h,v 1.27 1999/03/04 21:17:26 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -13,20 +13,33 @@
 #include "lua.h"
 
 
+#ifdef DEBUG
+#include "lauxlib.h"
+#define LUA_INTERNALERROR(s)	\
+	luaL_verror("INTERNAL ERROR - %s [%s:%d]",(s),__FILE__,__LINE__)
+#define LUA_ASSERT(c,s) { if (!(c)) LUA_INTERNALERROR(s); }
+#else
+#define LUA_INTERNALERROR(s)  /* empty */
+#define LUA_ASSERT(c,s)  /* empty */
+#endif
+
+
 /*
 ** "real" is the type "number" of Lua
 ** GREP LUA_NUMBER to change that
 */
-#ifndef real
-#define real float
+#ifndef LUA_NUM_TYPE
+#define LUA_NUM_TYPE double
 #endif
 
 
+typedef LUA_NUM_TYPE real;
+
 #define Byte lua_Byte	/* some systems have Byte as a predefined type */
 typedef unsigned char  Byte;  /* unsigned 8 bits */
 
-#define MAX_WORD  (65534U)  /* maximum value of a word (-2 for safety) */
-#define MAX_INT   (INT_MAX-2)  /* maximum value of a int (-2 for safety) */
+
+#define MAX_INT   (INT_MAX-2)  /* maximum value of an int (-2 for safety) */
 
 typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
 
@@ -51,7 +64,6 @@ typedef enum {
   LUA_T_LINE     = -11
 } lua_Type;
 
-#define NUM_TYPES 11
 #define NUM_TAGS  7
 
 
@@ -88,10 +100,13 @@ typedef struct GCnode {
 
 typedef struct TaggedString {
   GCnode head;
-  int constindex;  /* hint to reuse constants (= -1 if this is a userdata) */
   unsigned long hash;
+  int constindex;  /* hint to reuse constants (= -1 if this is a userdata) */
   union {
-    TObject globalval;
+    struct {
+      TObject globalval;
+      long len;  /* if this is a string, here is its length */
+    } s;
     struct {
       int tag;
       void *v;  /* if this is a userdata, here is its value */
@@ -112,7 +127,7 @@ typedef struct TProtoFunc {
   int nconsts;
   Byte *code;  /* ends with opcode ENDCODE */
   int lineDefined;
-  TaggedString  *fileName;
+  TaggedString  *source;
   struct LocVar *locvars;  /* ends with line = -1 */
 } TProtoFunc;
 
@@ -165,12 +180,17 @@ typedef struct Hash {
 
 extern char *luaO_typenames[];
 
+#define luaO_typename(o)        luaO_typenames[-ttype(o)]
+
+
 extern TObject luaO_nilobject;
 
-int luaO_equalObj (TObject *t1, TObject *t2);
+#define luaO_equalObj(t1,t2)	((ttype(t1) != ttype(t2)) ? 0 \
+                                      : luaO_equalval(t1,t2))
+int luaO_equalval (TObject *t1, TObject *t2);
 int luaO_redimension (int oldsize);
-int luaO_findstring (char *name, char *list[]);
 void luaO_insertlist (GCnode *root, GCnode *node);
+double luaO_str2d (char *s);
 
 #ifdef OLD_ANSI
 void luaO_memup (void *dest, void *src, int size);

lopcodes.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lopcodes.h,v 1.14 1997/12/30 19:08:23 roberto Exp roberto $
+** $Id: lopcodes.h,v 1.31 1999/03/05 21:16:07 roberto Exp roberto $
 ** Opcodes for Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -10,173 +10,129 @@
 
 /*
 ** NOTICE: variants of the same opcode must be consecutive: First, those
-** with byte parameter, then with built-in parameters, and last with
-** word parameter.
+** with word parameter, then with byte parameter.
 */
 
 
 typedef enum {
 /* name          parm    before          after           side effect
 -----------------------------------------------------------------------------*/
-ENDCODE,/*	-	-		-  */
+ENDCODE,/*	-	-		(return)			*/
+RETCODE,/*	b	-		(return)			*/
 
-PUSHNIL,/*	b	-		nil_0...nil_b  */
-PUSHNIL0,/*	-	-		nil  */
+CALL,/*		b c	v_c...v_1 f	r_b...r_1	f(v1,...,v_c)	*/
 
-PUSHNUMBER,/*	b	-		(float)b  */
-PUSHNUMBER0,/*	-	-		0.0  */
-PUSHNUMBER1,/*	-	-		1.0  */
-PUSHNUMBER2,/*	-	-		2.0  */
-PUSHNUMBERW,/*	w	-		(float)w  */
+TAILCALL,/*	b c	v_c...v_1 f	(return)	f(v1,...,v_c)	*/
 
-PUSHCONSTANT,/*	b	-		CNST[b] */
-PUSHCONSTANT0,/*-	-		CNST[0] */
-PUSHCONSTANT1,/*-	-		CNST[1] */
-PUSHCONSTANT2,/*-	-		CNST[2] */
-PUSHCONSTANT3,/*-	-		CNST[3] */
-PUSHCONSTANT4,/*-	-		CNST[4] */
-PUSHCONSTANT5,/*-	-		CNST[5] */
-PUSHCONSTANT6,/*-	-		CNST[6] */
-PUSHCONSTANT7,/*-	-		CNST[7] */
-PUSHCONSTANTW,/*w	-		CNST[w] */
+PUSHNIL,/*	b	-		nil_0...nil_b			*/
+POP,/*		b	a_b...a_1	-				*/
 
-PUSHUPVALUE,/*	b	-		Closure[b] */
-PUSHUPVALUE0,/*	-	-		Closure[0] */
-PUSHUPVALUE1,/*	-	-		Closure[1] */
+PUSHNUMBERW,/*	w	-		(float)w			*/
+PUSHNUMBER,/*	b	-		(float)b			*/
 
-PUSHLOCAL,/*	b	-		LOC[b]  */
-PUSHLOCAL0,/*	-	-		LOC[0]  */
-PUSHLOCAL1,/*	-	-		LOC[1]  */
-PUSHLOCAL2,/*	-	-		LOC[2]  */
-PUSHLOCAL3,/*	-	-		LOC[3]  */
-PUSHLOCAL4,/*	-	-		LOC[4]  */
-PUSHLOCAL5,/*	-	-		LOC[5]  */
-PUSHLOCAL6,/*	-	-		LOC[6]  */
-PUSHLOCAL7,/*	-	-		LOC[7]  */
+PUSHNUMBERNEGW,/* w	-		(float)-w			*/
+PUSHNUMBERNEG,/* b	-		(float)-b			*/
 
-GETGLOBAL,/*	b 	-		VAR[CNST[b]]  */
-GETGLOBAL0,/*	-	-		VAR[CNST[0]]  */
-GETGLOBAL1,/*	-	-		VAR[CNST[1]]  */
-GETGLOBAL2,/*	-	-		VAR[CNST[2]]  */
-GETGLOBAL3,/*	-	-		VAR[CNST[3]]  */
-GETGLOBAL4,/*	-	-		VAR[CNST[4]]  */
-GETGLOBAL5,/*	-	-		VAR[CNST[5]]  */
-GETGLOBAL6,/*	-	-		VAR[CNST[6]]  */
-GETGLOBAL7,/*	-	-		VAR[CNST[7]]  */
-GETGLOBALW,/*	w	-		VAR[CNST[w]]  */
+PUSHCONSTANTW,/*w	-		CNST[w]				*/
+PUSHCONSTANT,/*	b	-		CNST[b]				*/
 
-GETTABLE,/*	-	i t		t[i]  */
+PUSHUPVALUE,/*	b	-		Closure[b]			*/
 
-GETDOTTED,/*	b	t		t[CONST[b]]  */
-GETDOTTED0,/*	-	t		t[CONST[0]]  */
-GETDOTTED1,/*	-	t		t[CONST[1]]  */
-GETDOTTED2,/*	-	t		t[CONST[2]]  */
-GETDOTTED3,/*	-	t		t[CONST[3]]  */
-GETDOTTED4,/*	-	t		t[CONST[4]]  */
-GETDOTTED5,/*	-	t		t[CONST[5]]  */
-GETDOTTED6,/*	-	t		t[CONST[6]]  */
-GETDOTTED7,/*	-	t		t[CONST[7]]  */
-GETDOTTEDW,/*	w	t		t[CONST[w]]  */
+PUSHLOCAL,/*	b	-		LOC[b]				*/
 
-PUSHSELF,/*	b	t		t t[CNST[b]]  */
-PUSHSELF0,/*	-	t		t t[CNST[0]]  */
-PUSHSELF1,/*	-	t		t t[CNST[1]]  */
-PUSHSELF2,/*	-	t		t t[CNST[2]]  */
-PUSHSELF3,/*	-	t		t t[CNST[3]]  */
-PUSHSELF4,/*	-	t		t t[CNST[4]]  */
-PUSHSELF5,/*	-	t		t t[CNST[5]]  */
-PUSHSELF6,/*	-	t		t t[CNST[6]]  */
-PUSHSELF7,/*	-	t		t t[CNST[7]]  */
-PUSHSELFW,/*	w	t		t t[CNST[w]]  */
+GETGLOBALW,/*	w	-		VAR[CNST[w]]			*/
+GETGLOBAL,/*	b	-		VAR[CNST[b]]			*/
 
-CREATEARRAY,/*	b	-		newarray(size = b)  */
-CREATEARRAY0,/*	-	-		newarray(size = 0)  */
-CREATEARRAY1,/*	-	-		newarray(size = 1)  */
-CREATEARRAYW,/*	w	-		newarray(size = w)  */
+GETTABLE,/*	-	i t		t[i]				*/
 
-SETLOCAL,/*	b	x		-		LOC[b]=x  */
-SETLOCAL0,/*	-	x		-		LOC[0]=x  */
-SETLOCAL1,/*	-	x		-		LOC[1]=x  */
-SETLOCAL2,/*	-	x		-		LOC[2]=x  */
-SETLOCAL3,/*	-	x		-		LOC[3]=x  */
-SETLOCAL4,/*	-	x		-		LOC[4]=x  */
-SETLOCAL5,/*	-	x		-		LOC[5]=x  */
-SETLOCAL6,/*	-	x		-		LOC[6]=x  */
-SETLOCAL7,/*	-	x		-		LOC[7]=x  */
+GETDOTTEDW,/*	w	t		t[CNST[w]]			*/
+GETDOTTED,/*	b	t		t[CNST[b]]			*/
 
-SETGLOBAL,/*	b	x		-		VAR[CNST[b]]=x  */
-SETGLOBAL0,/*	-	x		-		VAR[CNST[0]]=x  */
-SETGLOBAL1,/*	-	x		-		VAR[CNST[1]]=x  */
-SETGLOBAL2,/*	-	x		-		VAR[CNST[2]]=x  */
-SETGLOBAL3,/*	-	x		-		VAR[CNST[3]]=x  */
-SETGLOBAL4,/*	-	x		-		VAR[CNST[4]]=x  */
-SETGLOBAL5,/*	-	x		-		VAR[CNST[5]]=x  */
-SETGLOBAL6,/*	-	x		-		VAR[CNST[6]]=x  */
-SETGLOBAL7,/*	-	x		-		VAR[CNST[7]]=x  */
-SETGLOBALW,/*	w	x		-		VAR[CNST[w]]=x  */
+PUSHSELFW,/*	w	t		t t[CNST[w]]			*/
+PUSHSELF,/*	b	t		t t[CNST[b]]			*/
 
-SETTABLE0,/*	-	v i t		-		t[i]=v  */
+CREATEARRAYW,/*	w	-		newarray(size = w)		*/
+CREATEARRAY,/*	b	-		newarray(size = b)		*/
 
-SETTABLE,/*	b	v a_b...a_1 i t	a_b...a_1 i t	t[i]=v  */
+SETLOCAL,/*	b	x		-		LOC[b]=x	*/
 
-SETLIST,/*	b c	v_b...v_1 t	-		t[i+c*FPF]=v_i  */
-SETLIST0,/*	b	v_b...v_1 t	-		t[i]=v_i  */
-SETLISTW,/*	w c	v_b...v_1 t	-		t[i+c*FPF]=v_i  */
+SETGLOBALW,/*	w	x		-		VAR[CNST[w]]=x	*/
+SETGLOBAL,/*	b	x		-		VAR[CNST[b]]=x	*/
 
-SETMAP,/*	b	v_b k_b ...v_0 k_0 t	t	t[k_i]=v_i  */
-SETMAP0,/*	-	v_0 k_0 t		t	t[k_0]=v_0  */
+SETTABLEPOP,/*	-	v i t		-		t[i]=v		*/
 
-EQOP,/*		-	y x		(x==y)? 1 : nil  */
-NEQOP,/*	-	y x		(x~=y)? 1 : nil  */
-LTOP,/*		-	y x		(x<y)? 1 : nil  */
-LEOP,/*		-	y x		(x<y)? 1 : nil  */
-GTOP,/*		-	y x		(x>y)? 1 : nil  */
-GEOP,/*		-	y x		(x>=y)? 1 : nil  */
-ADDOP,/*	-	y x		x+y  */
-SUBOP,/*	-	y x		x-y  */
-MULTOP,/*	-	y x		x*y  */
-DIVOP,/*	-	y x		x/y  */
-POWOP,/*	-	y x		x^y  */
-CONCOP,/*	-	y x		x..y  */
-MINUSOP,/*	-	x		-x  */
-NOTOP,/*	-	x		(x==nil)? 1 : nil  */
+SETTABLE,/*	b	v a_b...a_1 i t	 a_b...a_1 i t	  t[i]=v	*/
 
-ONTJMP,/*	b	x		(x!=nil)? x : -	(x!=nil)? PC+=b  */
-ONTJMPW,/*	w	x		(x!=nil)? x : -	(x!=nil)? PC+=w  */
-ONFJMP,/*	b	x		(x==nil)? x : -	(x==nil)? PC+=b  */
-ONFJMPW,/*	w	x		(x==nil)? x : -	(x==nil)? PC+=w  */
-JMP,/*		b	-		-		PC+=b  */
-JMPW,/*		w	-		-		PC+=w  */
-IFFJMP,/*	b	x		-		(x==nil)? PC+=b  */
-IFFJMPW,/*	w	x		-		(x==nil)? PC+=w  */
-IFTUPJMP,/*	b	x		-		(x!=nil)? PC-=b  */
-IFTUPJMPW,/*	w	x		-		(x!=nil)? PC-=w  */
-IFFUPJMP,/*	b	x		-		(x==nil)? PC-=b  */
-IFFUPJMPW,/*	w	x		-		(x==nil)? PC-=w  */
+SETLISTW,/*	w c	v_c...v_1 t	t		t[i+w*FPF]=v_i	*/
+SETLIST,/*	b c	v_c...v_1 t	t		t[i+b*FPF]=v_i	*/
 
-CLOSURE,/*	b	proto v_b...v_1 c(proto) */
-CLOSURE0,/*	-	proto		c(proto) */
-CLOSURE1,/*	-	proto v_1	c(proto) */
+SETMAP,/*	b	v_b k_b ...v_0 k_0 t	t	t[k_i]=v_i	*/
 
-CALLFUNC,/*	b c	v_c...v_1 f	r_b...r_1	f(v1,...,v_c)  */
-CALLFUNC0,/*	b	v_b...v_1 f	-		f(v1,...,v_b)  */
-CALLFUNC1,/*	b	v_b...v_1 f	r_1		f(v1,...,v_b)  */
+NEQOP,/*	-	y x		(x~=y)? 1 : nil			*/
+EQOP,/*		-	y x		(x==y)? 1 : nil			*/
+LTOP,/*		-	y x		(x<y)? 1 : nil			*/
+LEOP,/*		-	y x		(x<y)? 1 : nil			*/
+GTOP,/*		-	y x		(x>y)? 1 : nil			*/
+GEOP,/*		-	y x		(x>=y)? 1 : nil			*/
+ADDOP,/*	-	y x		x+y				*/
+SUBOP,/*	-	y x		x-y				*/
+MULTOP,/*	-	y x		x*y				*/
+DIVOP,/*	-	y x		x/y				*/
+POWOP,/*	-	y x		x^y				*/
+CONCOP,/*	-	y x		x..y				*/
+MINUSOP,/*	-	x		-x				*/
+NOTOP,/*	-	x		(x==nil)? 1 : nil		*/
 
-RETCODE,/*	b	-		-  */
+ONTJMPW,/*	w	x		(x!=nil)? x : -	(x!=nil)? PC+=w	*/
+ONTJMP,/*	b	x		(x!=nil)? x : -	(x!=nil)? PC+=b	*/
+ONFJMPW,/*	w	x		(x==nil)? x : -	(x==nil)? PC+=w	*/
+ONFJMP,/*	b	x		(x==nil)? x : -	(x==nil)? PC+=b	*/
+JMPW,/*		w	-		-		PC+=w		*/
+JMP,/*		b	-		-		PC+=b		*/
+IFFJMPW,/*	w	x		-		(x==nil)? PC+=w	*/
+IFFJMP,/*	b	x		-		(x==nil)? PC+=b	*/
+IFTUPJMPW,/*	w	x		-		(x!=nil)? PC-=w	*/
+IFTUPJMP,/*	b	x		-		(x!=nil)? PC-=b	*/
+IFFUPJMPW,/*	w	x		-		(x==nil)? PC-=w	*/
+IFFUPJMP,/*	b	x		-		(x==nil)? PC-=b	*/
 
-SETLINE,/*	b	-		-		LINE=b  */
-SETLINEW,/*	w	-		-		LINE=w  */
+CLOSUREW,/*	w c	v_c...v_1	closure(CNST[w], v_c...v_1)	*/
+CLOSURE,/*	b c	v_c...v_1	closure(CNST[b], v_c...v_1)	*/
 
-POP,/*		b	-		-		TOP-=(b+1)  */
-POP0,/*		-	-		-		TOP-=1  */
-POP1/*		-	-		-		TOP-=2  */
+SETLINEW,/*	w	-		-		LINE=w		*/
+SETLINE,/*	b	-		-		LINE=b		*/
+
+LONGARGW,/*	w	(add w*(1<<16) to arg of next instruction)	*/
+LONGARG,/*	b	(add b*(1<<16) to arg of next instruction)	*/
+
+CHECKSTACK /*	b  (assert #temporaries == b; only for internal debuging!) */
 
 } OpCode;
 
 
 #define RFIELDS_PER_FLUSH 32	/* records (SETMAP) */
-#define LFIELDS_PER_FLUSH 64    /* lists (SETLIST) */
+#define LFIELDS_PER_FLUSH 64    /* FPF - lists (SETLIST) */
 
 #define ZEROVARARG	64
 
+
+/* maximum value of an arg of 3 bytes; must fit in an "int" */
+#if MAX_INT < (1<<24)
+#define MAX_ARG	MAX_INT
+#else
+#define MAX_ARG	((1<<24)-1)
+#endif
+
+/* maximum value of a word of 2 bytes; cannot be bigger than MAX_ARG */
+#if MAX_ARG < (1<<16)
+#define MAX_WORD	MAX_ARG
+#else
+#define MAX_WORD	((1<<16)-1)
+#endif
+
+
+/* maximum value of a byte */
+#define MAX_BYTE	((1<<8)-1)
+
+
 #endif

lparser.h

@@ -1,6 +1,6 @@
 /*
-** $Id: lparser.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
-** Syntax analizer and code generator
+** $Id: lparser.h,v 1.2 1997/12/22 20:57:18 roberto Exp roberto $
+** LL(1) Parser and code generator for Lua
 ** See Copyright Notice in lua.h
 */
 

lstate.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 1.4 1997/12/11 14:48:46 roberto Exp roberto $
+** $Id: lstate.c,v 1.9 1999/02/25 15:17:01 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -17,18 +17,25 @@
 #include "ltm.h"
 
 
-LState *lua_state = NULL;
+lua_State *lua_state = NULL;
 
 
 void lua_open (void)
 {
   if (lua_state) return;
-  lua_state = luaM_new(LState);
-  L->numCblocks = 0;
+  lua_state = luaM_new(lua_State);
   L->Cstack.base = 0;
   L->Cstack.lua2C = 0;
   L->Cstack.num = 0;
   L->errorJmp = NULL;
+  L->Mbuffer = NULL;
+  L->Mbuffbase = 0;
+  L->Mbuffsize = 0;
+  L->Mbuffnext = 0;
+  L->numCblocks = 0;
+  L->debug = 0;
+  L->callhook = NULL;
+  L->linehook = NULL;
   L->rootproto.next = NULL;
   L->rootproto.marked = 0;
   L->rootcl.next = NULL;
@@ -37,12 +44,9 @@ void lua_open (void)
   L->rootglobal.marked = 0;
   L->roottable.next = NULL;
   L->roottable.marked = 0;
+  L->IMtable = NULL;
   L->refArray = NULL;
   L->refSize = 0;
-  L->Mbuffsize = 0;
-  L->Mbuffnext = 0;
-  L->Mbuffbase = NULL;
-  L->Mbuffer = NULL;
   L->GCthreshold = GARBAGE_BLOCK;
   L->nblocks = 0;
   luaD_init();
@@ -76,3 +80,5 @@ void lua_close (void)
   printf("total de memoria: %ld\n", totalmem);
 #endif
 }
+
+

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.6 1997/12/17 20:48:58 roberto Exp roberto $
+** $Id: lstate.h,v 1.15 1999/02/25 15:17:01 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -7,7 +7,11 @@
 #ifndef lstate_h
 #define lstate_h
 
+#include <setjmp.h>
+
 #include "lobject.h"
+#include "lua.h"
+#include "luadebug.h"
 
 
 #define MAX_C_BLOCKS 10
@@ -38,44 +42,45 @@ typedef struct {
 } stringtable;
 
 
+enum Status {LOCK, HOLD, FREE, COLLECTED};
+
 struct ref {
   TObject o;
-  enum {LOCK, HOLD, FREE, COLLECTED} status;
+  enum Status status;
 };
 
 
-typedef struct LState {
+struct lua_State {
+  /* thread-specific state */
   struct Stack stack;  /* Lua stack */
   struct C_Lua_Stack Cstack;  /* C2lua struct */
-  void *errorJmp;  /* current error recover point */
-  TObject errorim;  /* error tag method */
+  jmp_buf *errorJmp;  /* current error recover point */
+  char *Mbuffer;  /* global buffer */
+  int Mbuffbase;  /* current first position of Mbuffer */
+  int Mbuffsize;  /* size of Mbuffer */
+  int Mbuffnext;  /* next position to fill in Mbuffer */
+  struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
+  int numCblocks;  /* number of nested Cblocks */
+  int debug;
+  lua_CHFunction callhook;
+  lua_LHFunction linehook;
+  /* global state */
   GCnode rootproto;  /* list of all prototypes */
   GCnode rootcl;  /* list of all closures */
   GCnode roottable;  /* list of all tables */
   GCnode rootglobal;  /* list of strings with global values */
   stringtable *string_root;  /* array of hash tables for strings and udata */
   struct IM *IMtable;  /* table for tag methods */
-  int IMtable_size;  /* size of IMtable */
   int last_tag;  /* last used tag in IMtable */
-  struct FuncState *mainState, *currState;  /* point to local structs in yacc */
-  struct LexState *lexstate;  /* point to local struct in yacc */
   struct ref *refArray;  /* locked objects */
   int refSize;  /* size of refArray */
   unsigned long GCthreshold;
   unsigned long nblocks;  /* number of 'blocks' currently allocated */
-  char *Mbuffer;  /* global buffer */
-  char *Mbuffbase;  /* current first position of Mbuffer */
-  int Mbuffsize;  /* size of Mbuffer */
-  int Mbuffnext;  /* next position to fill in Mbuffer */
-  struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
-  int numCblocks;  /* number of nested Cblocks */
-} LState;
-
-
-extern LState *lua_state;
+};
 
 
 #define L	lua_state
 
 
 #endif
+

lstring.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.c,v 1.9 1997/12/30 19:15:52 roberto Exp roberto $
+** $Id: lstring.c,v 1.18 1999/02/08 16:28:48 roberto Exp roberto $
 ** String table (keeps all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -14,18 +14,20 @@
 #include "lua.h"
 
 
-#define NUM_HASHS  61
+#define NUM_HASHSTR	31
+#define NUM_HASHUDATA	31
+#define NUM_HASHS  (NUM_HASHSTR+NUM_HASHUDATA)
 
 
 #define gcsizestring(l)	(1+(l/64))  /* "weight" for a string with length 'l' */
 
 
 
-static TaggedString EMPTY = {{NULL, 2}, 0, 0L, {{LUA_T_NIL, {NULL}}}, {0}};
+static TaggedString EMPTY = {{NULL, 2}, 0L, 0,
+                            {{{LUA_T_NIL, {NULL}}, 0L}}, {0}};
 
 
-void luaS_init (void)
-{
+void luaS_init (void) {
   int i;
   L->string_root = luaM_newvector(NUM_HASHS, stringtable);
   for (i=0; i<NUM_HASHS; i++) {
@@ -36,109 +38,150 @@ void luaS_init (void)
 }
 
 
-static unsigned long hash (char *s, int tag)
-{
-  unsigned long h;
-  if (tag != LUA_T_STRING)
-    h = (unsigned long)s;
-  else {
-    h = 0;
-    while (*s)
-      h = ((h<<5)-h)^(unsigned char)*(s++);
-  }
+static unsigned long hash_s (char *s, long l) {
+  unsigned long h = 0;  /* seed */
+  while (l--)
+      h = h ^ ((h<<5)+(h>>2)+(unsigned char)*(s++));
   return h;
 }
 
-
-static void grow (stringtable *tb)
-{
-  int newsize = luaO_redimension(tb->size);
-  TaggedString **newhash = luaM_newvector(newsize, TaggedString *);
+static int newsize (stringtable *tb) {
+  int size = tb->size;
+  int realuse = 0;
   int i;
-  for (i=0; i<newsize; i++)
+  /* count how many entries are really in use */
+  for (i=0; i<size; i++)
+    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
+      realuse++;
+  return luaO_redimension((realuse+1)*2);  /* +1 is the new element */
+}
+
+
+static void grow (stringtable *tb) {
+  int ns = newsize(tb);
+  TaggedString **newhash = luaM_newvector(ns, TaggedString *);
+  int i;
+  for (i=0; i<ns; i++)
     newhash[i] = NULL;
   /* rehash */
   tb->nuse = 0;
   for (i=0; i<tb->size; i++) {
     if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
-      int h = tb->hash[i]->hash%newsize;
-      while (newhash[h])
-        h = (h+1)%newsize;
-      newhash[h] = tb->hash[i];
+      unsigned long h = tb->hash[i]->hash;
+      int h1 = h%ns;
+      while (newhash[h1]) {
+        h1 += (h&(ns-2)) + 1;  /* double hashing */
+        if (h1 >= ns) h1 -= ns;
+      }
+      newhash[h1] = tb->hash[i];
       tb->nuse++;
     }
   }
   luaM_free(tb->hash);
-  tb->size = newsize;
+  tb->size = ns;
   tb->hash = newhash;
 }
 
 
-static TaggedString *newone (char *buff, int tag, unsigned long h)
-{
-  TaggedString *ts;
-  if (tag == LUA_T_STRING) {
-    long l = strlen(buff);
-    ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l);
-    strcpy(ts->str, buff);
-    ts->u.globalval.ttype = LUA_T_NIL;  /* initialize global value */
-    ts->constindex = 0;
-    L->nblocks += gcsizestring(l);
-  }
-  else {
-    ts = (TaggedString *)luaM_malloc(sizeof(TaggedString));
-    ts->u.d.v = buff;
-    ts->u.d.tag = tag == LUA_ANYTAG ? 0 : tag;
-    ts->constindex = -1;  /* tag -> this is a userdata */
-    L->nblocks++;
-  }
+static TaggedString *newone_s (char *str, long l, unsigned long h) {
+  TaggedString *ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l);
+  memcpy(ts->str, str, l);
+  ts->str[l] = 0;  /* ending 0 */
+  ts->u.s.globalval.ttype = LUA_T_NIL;  /* initialize global value */
+  ts->u.s.len = l;
+  ts->constindex = 0;
+  L->nblocks += gcsizestring(l);
   ts->head.marked = 0;
   ts->head.next = (GCnode *)ts;  /* signal it is in no list */
   ts->hash = h;
   return ts;
 }
 
-static TaggedString *insert (char *buff, int tag, stringtable *tb)
-{
+static TaggedString *newone_u (char *buff, int tag, unsigned long h) {
+  TaggedString *ts = luaM_new(TaggedString);
+  ts->u.d.v = buff;
+  ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag;
+  ts->constindex = -1;  /* tag -> this is a userdata */
+  L->nblocks++;
+  ts->head.marked = 0;
+  ts->head.next = (GCnode *)ts;  /* signal it is in no list */
+  ts->hash = h;
+  return ts;
+}
+
+static TaggedString *insert_s (char *str, long l, stringtable *tb) {
   TaggedString *ts;
-  unsigned long h = hash(buff, tag);
+  unsigned long h = hash_s(str, l);
   int size = tb->size;
-  int i;
   int j = -1;
+  int h1;
   if ((long)tb->nuse*3 >= (long)size*2) {
     grow(tb);
     size = tb->size;
   }
-  for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
+  h1 = h%size;
+  while ((ts = tb->hash[h1]) != NULL) {
     if (ts == &EMPTY)
-      j = i;
-    else if ((ts->constindex >= 0) ?  /* is a string? */
-              (tag == LUA_T_STRING && (strcmp(buff, ts->str) == 0)) :
-              ((tag == ts->u.d.tag || tag == LUA_ANYTAG) && buff == ts->u.d.v))
+      j = h1;
+    else if (ts->u.s.len == l && (memcmp(str, ts->str, l) == 0))
       return ts;
-    if (++i == size) i=0;
+    h1 += (h&(size-2)) + 1;  /* double hashing */
+    if (h1 >= size) h1 -= size;
   }
   /* not found */
   if (j != -1)  /* is there an EMPTY space? */
-    i = j;
+    h1 = j;
   else
     tb->nuse++;
-  ts = tb->hash[i] = newone(buff, tag, h);
+  ts = tb->hash[h1] = newone_s(str, l, h);
   return ts;
 }
 
-TaggedString *luaS_createudata (void *udata, int tag)
-{
-  return insert(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]);
+
+static TaggedString *insert_u (void *buff, int tag, stringtable *tb) {
+  TaggedString *ts;
+  unsigned long h = (unsigned long)buff;
+  int size = tb->size;
+  int j = -1;
+  int h1;
+  if ((long)tb->nuse*3 >= (long)size*2) {
+    grow(tb);
+    size = tb->size;
+  }
+  h1 = h%size;
+  while ((ts = tb->hash[h1]) != NULL) {
+    if (ts == &EMPTY)
+      j = h1;
+    else if ((tag == ts->u.d.tag || tag == LUA_ANYTAG) && buff == ts->u.d.v)
+      return ts;
+    h1 += (h&(size-2)) + 1;  /* double hashing */
+    if (h1 >= size) h1 -= size;
+  }
+  /* not found */
+  if (j != -1)  /* is there an EMPTY space? */
+    h1 = j;
+  else
+    tb->nuse++;
+  ts = tb->hash[h1] = newone_u(buff, tag, h);
+  return ts;
 }
 
-TaggedString *luaS_new (char *str)
-{
-  return insert(str, LUA_T_STRING, &L->string_root[(unsigned)str[0]%NUM_HASHS]);
+
+TaggedString *luaS_createudata (void *udata, int tag) {
+  int t = ((unsigned)udata%NUM_HASHUDATA)+NUM_HASHSTR;
+  return insert_u(udata, tag, &L->string_root[t]);
 }
 
-TaggedString *luaS_newfixedstring (char *str)
-{
+TaggedString *luaS_newlstr (char *str, long l) {
+  int t = (l==0) ? 0 : ((int)((unsigned char)str[0]*l))%NUM_HASHSTR;
+  return insert_s(str, l, &L->string_root[t]);
+}
+
+TaggedString *luaS_new (char *str) {
+  return luaS_newlstr(str, strlen(str));
+}
+
+TaggedString *luaS_newfixedstring (char *str) {
   TaggedString *ts = luaS_new(str);
   if (ts->head.marked == 0)
     ts->head.marked = 2;  /* avoid GC */
@@ -146,11 +189,10 @@ TaggedString *luaS_newfixedstring (char *str)
 }
 
 
-void luaS_free (TaggedString *l)
-{
+void luaS_free (TaggedString *l) {
   while (l) {
     TaggedString *next = (TaggedString *)l->head.next;
-    L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(strlen(l->str));
+    L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len);
     luaM_free(l);
     l = next;
   }
@@ -161,8 +203,7 @@ void luaS_free (TaggedString *l)
 ** Garbage collection functions.
 */
 
-static void remove_from_list (GCnode *l)
-{
+static void remove_from_list (GCnode *l) {
   while (l) {
     GCnode *next = l->next;
     while (next && !next->marked)
@@ -172,8 +213,7 @@ static void remove_from_list (GCnode *l)
 }
 
 
-TaggedString *luaS_collector (void)
-{
+TaggedString *luaS_collector (void) {
   TaggedString *frees = NULL;
   int i;
   remove_from_list(&(L->rootglobal));
@@ -196,18 +236,18 @@ TaggedString *luaS_collector (void)
 }
 
 
-TaggedString *luaS_collectudata (void)
-{
+TaggedString *luaS_collectudata (void) {
   TaggedString *frees = NULL;
   int i;
   L->rootglobal.next = NULL;  /* empty list of globals */
-  for (i=0; i<NUM_HASHS; i++) {
+  for (i=NUM_HASHSTR; i<NUM_HASHS; i++) {
     stringtable *tb = &L->string_root[i];
     int j;
     for (j=0; j<tb->size; j++) {
       TaggedString *t = tb->hash[j];
-      if (t == NULL || t == &EMPTY || t->constindex != -1)
-        continue;  /* get only user datas */
+      if (t == NULL || t == &EMPTY)
+        continue;
+      LUA_ASSERT(t->constindex == -1, "must be userdata");
       t->head.next = (GCnode *)frees;
       frees = t;
       tb->hash[j] = &EMPTY;
@@ -217,8 +257,7 @@ TaggedString *luaS_collectudata (void)
 }
 
 
-void luaS_freeall (void)
-{
+void luaS_freeall (void) {
   int i;
   for (i=0; i<NUM_HASHS; i++) {
     stringtable *tb = &L->string_root[i];
@@ -234,9 +273,8 @@ void luaS_freeall (void)
 }
 
 
-void luaS_rawsetglobal (TaggedString *ts, TObject *newval)
-{
-  ts->u.globalval = *newval;
+void luaS_rawsetglobal (TaggedString *ts, TObject *newval) {
+  ts->u.s.globalval = *newval;
   if (ts->head.next == (GCnode *)ts) {  /* is not in list? */
     ts->head.next = L->rootglobal.next;
     L->rootglobal.next = (GCnode *)ts;
@@ -244,19 +282,17 @@ void luaS_rawsetglobal (TaggedString *ts, TObject *newval)
 }
 
 
-char *luaS_travsymbol (int (*fn)(TObject *))
-{
+char *luaS_travsymbol (int (*fn)(TObject *)) {
   TaggedString *g;
   for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
-    if (fn(&g->u.globalval))
+    if (fn(&g->u.s.globalval))
       return g->str;
   return NULL;
 }
 
 
-int luaS_globaldefined (char *name)
-{
+int luaS_globaldefined (char *name) {
   TaggedString *ts = luaS_new(name);
-  return ts->u.globalval.ttype != LUA_T_NIL;
+  return ts->u.s.globalval.ttype != LUA_T_NIL;
 }
 

lstring.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.h,v 1.5 1997/11/26 18:53:45 roberto Exp roberto $
+** $Id: lstring.h,v 1.6 1997/12/01 20:31:25 roberto Exp roberto $
 ** String table (keep all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -15,6 +15,7 @@ void luaS_init (void);
 TaggedString *luaS_createudata (void *udata, int tag);
 TaggedString *luaS_collector (void);
 void luaS_free (TaggedString *l);
+TaggedString *luaS_newlstr (char *str, long l);
 TaggedString *luaS_new (char *str);
 TaggedString *luaS_newfixedstring (char *str);
 void luaS_rawsetglobal (TaggedString *ts, TObject *newval);

lstrlib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstrlib.c,v 1.6 1998/01/09 14:44:55 roberto Exp $
+** $Id: lstrlib.c,v 1.27 1999/02/25 19:13:56 roberto Exp roberto $
 ** Standard library for strings and pattern-matching
 ** See Copyright Notice in lua.h
 */
@@ -19,89 +19,100 @@
 static void addnchar (char *s, int n)
 {
   char *b = luaL_openspace(n);
-  strncpy(b, s, n);
+  memcpy(b, s, n);
   luaL_addsize(n);
 }
 
 
-static void addstr (char *s)
-{
-  addnchar(s, strlen(s));
-}
-
-
 static void str_len (void)
 {
- lua_pushnumber(strlen(luaL_check_string(1)));
+  long l;
+  luaL_check_lstr(1, &l);
+  lua_pushnumber(l);
 }
 
 
-static void closeandpush (void)
-{
-  luaL_addchar(0);
-  lua_pushstring(luaL_buffer());
+static void closeandpush (void) {
+  lua_pushlstring(luaL_buffer(), luaL_getsize());
 }
 
 
-static void str_sub (void)
-{
-  char *s = luaL_check_string(1);
-  long l = strlen(s);
-  long start = (long)luaL_check_number(2);
-  long end = (long)luaL_opt_number(3, -1);
-  if (start < 0) start = l+start+1;
-  if (end < 0) end = l+end+1;
-  if (1 <= start && start <= end && end <= l) {
-    luaL_resetbuffer();
-    addnchar(s+start-1, end-start+1);
-    closeandpush();
-  }
+static long posrelat (long pos, long len) {
+  /* relative string position: negative means back from end */
+  return (pos>=0) ? pos : len+pos+1;
+}
+
+
+static void str_sub (void) {
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  long start = posrelat(luaL_check_long(2), l);
+  long end = posrelat(luaL_opt_long(3, -1), l);
+  if (start < 1) start = 1;
+  if (end > l) end = l;
+  if (start <= end)
+    lua_pushlstring(s+start-1, end-start+1);
   else lua_pushstring("");
 }
 
 
-static void str_lower (void)
-{
-  char *s;
+static void str_lower (void) {
+  long l;
+  int i;
+  char *s = luaL_check_lstr(1, &l);
   luaL_resetbuffer();
-  for (s = luaL_check_string(1); *s; s++)
-    luaL_addchar(tolower((unsigned char)*s));
+  for (i=0; i<l; i++)
+    luaL_addchar(tolower((unsigned char)(s[i])));
   closeandpush();
 }
 
 
-static void str_upper (void)
-{
-  char *s;
+static void str_upper (void) {
+  long l;
+  int i;
+  char *s = luaL_check_lstr(1, &l);
   luaL_resetbuffer();
-  for (s = luaL_check_string(1); *s; s++)
-    luaL_addchar(toupper((unsigned char)*s));
+  for (i=0; i<l; i++)
+    luaL_addchar(toupper((unsigned char)(s[i])));
   closeandpush();
 }
 
 static void str_rep (void)
 {
-  char *s = luaL_check_string(1);
-  int n = (int)luaL_check_number(2);
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  int n = luaL_check_int(2);
   luaL_resetbuffer();
   while (n-- > 0)
-    addstr(s);
+    addnchar(s, l);
   closeandpush();
 }
 
 
-static void str_ascii (void)
-{
-  char *s = luaL_check_string(1);
-  long pos = (long)luaL_opt_number(2, 1) - 1;
-  luaL_arg_check(0<=pos && pos<strlen(s), 2,  "out of range");
-  lua_pushnumber((unsigned char)s[pos]);
+static void str_byte (void) {
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  long pos = posrelat(luaL_opt_long(2, 1), l);
+  luaL_arg_check(0<pos && pos<=l, 2,  "out of range");
+  lua_pushnumber((unsigned char)s[pos-1]);
+}
+
+
+static void str_char (void) {
+  int i = 0;
+  luaL_resetbuffer();
+  while (lua_getparam(++i) != LUA_NOOBJECT) {
+    double c = luaL_check_number(i);
+    luaL_arg_check((unsigned char)c == c, i, "invalid value");
+    luaL_addchar((unsigned char)c);
+  }
+  closeandpush();
 }
 
 
 
 /*
-** =======================================================
+** {======================================================
 ** PATTERN MATCHING
 ** =======================================================
 */
@@ -109,6 +120,7 @@ static void str_ascii (void)
 #define MAX_CAPT 9
 
 struct Capture {
+  char *src_end;  /* end ('\0') of source string */
   int level;  /* total number of captures (finished or unfinished) */
   struct {
     char *init;
@@ -121,22 +133,17 @@ struct Capture {
 #define SPECIALS  "^$*?.([%-"
 
 
-static void push_captures (struct Capture *cap)
-{
+static void push_captures (struct Capture *cap) {
   int i;
   for (i=0; i<cap->level; i++) {
     int l = cap->capture[i].len;
-    char *buff = luaL_openspace(l+1);
     if (l == -1) lua_error("unfinished capture");
-    strncpy(buff, cap->capture[i].init, l);
-    buff[l] = 0;
-    lua_pushstring(buff);
+    lua_pushlstring(cap->capture[i].init, l);
   }
 }
 
 
-static int check_cap (int l, struct Capture *cap)
-{
+static int check_cap (int l, struct Capture *cap) {
   l -= '1';
   if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
     lua_error("invalid capture index");
@@ -144,8 +151,7 @@ static int check_cap (int l, struct Capture *cap)
 }
 
 
-static int capture_to_close (struct Capture *cap)
-{
+static int capture_to_close (struct Capture *cap) {
   int level = cap->level;
   for (level--; level>=0; level--)
     if (cap->capture[level].len == -1) return level;
@@ -154,76 +160,74 @@ static int capture_to_close (struct Capture *cap)
 }
 
 
-static char *bracket_end (char *p)
-{
+static char *bracket_end (char *p) {
   return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
 }
 
 
-static int matchclass (int c, int cl)
-{
+static int matchclass (int c, int cl) {
   int res;
-  if (c == 0) return 0;
-  switch (tolower((unsigned char)cl)) {
-    case 'w' : res = isalnum((unsigned char)c); break;
-    case 'd' : res = isdigit((unsigned char)c); break;
-    case 's' : res = isspace((unsigned char)c); break;
-    case 'a' : res = isalpha((unsigned char)c); break;
-    case 'p' : res = ispunct((unsigned char)c); break;
-    case 'l' : res = islower((unsigned char)c); break;
-    case 'u' : res = isupper((unsigned char)c); break;
-    case 'c' : res = iscntrl((unsigned char)c); break;
+  switch (tolower(cl)) {
+    case 'a' : res = isalpha(c); break;
+    case 'c' : res = iscntrl(c); break;
+    case 'd' : res = isdigit(c); break;
+    case 'l' : res = islower(c); break;
+    case 'p' : res = ispunct(c); break;
+    case 's' : res = isspace(c); break;
+    case 'u' : res = isupper(c); break;
+    case 'w' : res = isalnum(c); break;
+    case 'x' : res = isxdigit(c); break;
+    case 'z' : res = (c == '\0'); break;
     default: return (cl == c);
   }
-  return (islower((unsigned char)cl) ? res : !res);
+  return (islower(cl) ? res : !res);
 }
 
 
-int luaI_singlematch (int c, char *p, char **ep)
-{
+int luaI_singlematch (int c, char *p, char **ep) {
   switch (*p) {
-    case '.':
+    case '.':  /* matches any char */
       *ep = p+1;
-      return (c != 0);
-    case '\0':
+      return 1;
+    case '\0':  /* end of pattern; matches nothing */
       *ep = p;
       return 0;
     case ESC:
       if (*(++p) == '\0')
         luaL_verror("incorrect pattern (ends with `%c')", ESC);
       *ep = p+1;
-      return matchclass(c, *p);
+      return matchclass(c, (unsigned char)*p);
     case '[': {
       char *end = bracket_end(p+1);
       int sig = *(p+1) == '^' ? (p++, 0) : 1;
       if (end == NULL) lua_error("incorrect pattern (missing `]')");
       *ep = end+1;
-      if (c == 0) return 0;
       while (++p < end) {
         if (*p == ESC) {
-          if (((p+1) < end) && matchclass(c, *++p)) return sig;
+          if (((p+1) < end) && matchclass(c, (unsigned char)*++p))
+            return sig;
         }
         else if ((*(p+1) == '-') && (p+2 < end)) {
           p+=2;
-          if (*(p-2) <= c && c <= *p) return sig;
+          if ((int)(unsigned char)*(p-2) <= c && c <= (int)(unsigned char)*p)
+            return sig;
         }
-        else if (*p == c) return sig;
+        else if ((unsigned char)*p == c) return sig;
       }
       return !sig;
     }
     default:
       *ep = p+1;
-      return (*p == c);
+      return ((unsigned char)*p == c);
   }
 }
 
 
-static char *matchbalance (char *s, int b, int e)
-{
+static char *matchbalance (char *s, int b, int e, struct Capture *cap) {
   if (*s != b) return NULL;
   else {
     int cont = 1;
-    while (*(++s)) {
+    while (++s < cap->src_end) {
       if (*s == e) {
         if (--cont == 0) return s+1;
       }
@@ -234,15 +238,15 @@ static char *matchbalance (char *s, int b, int e)
 }
 
 
-static char *matchitem (char *s, char *p, struct Capture *cap, char **ep)
-{
+static char *matchitem (char *s, char *p, struct Capture *cap, char **ep) {
   if (*p == ESC) {
     p++;
     if (isdigit((unsigned char)*p)) {  /* capture */
       int l = check_cap(*p, cap);
+      int len = cap->capture[l].len;
       *ep = p+1;
-      if (strncmp(cap->capture[l].init, s, cap->capture[l].len) == 0)
-        return s+cap->capture[l].len;
+      if (cap->src_end-s >= len && memcmp(cap->capture[l].init, s, len) == 0)
+        return s+len;
       else return NULL;
     }
     else if (*p == 'b') {  /* balanced string */
@@ -250,16 +254,17 @@ static char *matchitem (char *s, char *p, struct Capture *cap, char **ep)
       if (*p == 0 || *(p+1) == 0)
         lua_error("unbalanced pattern");
       *ep = p+2;
-      return matchbalance(s, *p, *(p+1));
+      return matchbalance(s, *p, *(p+1), cap);
     }
     else p--;  /* and go through */
   }
-  return (luaI_singlematch(*s, p, ep) ? s+1 : NULL);
+  /* "luaI_singlematch" sets "ep" (so must be called even at the end of "s" */
+  return (luaI_singlematch((unsigned char)*s, p, ep) && s<cap->src_end) ?
+                    s+1 : NULL;
 }
 
 
-static char *match (char *s, char *p, struct Capture *cap)
-{
+static char *match (char *s, char *p, struct Capture *cap) {
   init: /* using goto's to optimize tail recursion */
   switch (*p) {
     case '(': {  /* start capture */
@@ -281,30 +286,30 @@ static char *match (char *s, char *p, struct Capture *cap)
       return res;
     }
     case '\0': case '$':  /* (possibly) end of pattern */
-      if (*p == 0 || (*(p+1) == 0 && *s == 0))
+      if (*p == 0 || (*(p+1) == 0 && s == cap->src_end))
         return s;
       /* else go through */
     default: {  /* it is a pattern item */
-      char *ep;  /* get what is next */
+      char *ep;  /* will point to what is next */
       char *s1 = matchitem(s, p, cap, &ep);
       switch (*ep) {
         case '*': {  /* repetition */
           char *res;
-          if (s1 && (res = match(s1, p, cap)))
+          if (s1 && s1>s && ((res=match(s1, p, cap)) != NULL))
             return res;
           p=ep+1; goto init;  /* else return match(s, ep+1, cap); */
         }
         case '?': {  /* optional */
           char *res;
-          if (s1 && (res = match(s1, ep+1, cap)))
+          if (s1 && ((res=match(s1, ep+1, cap)) != NULL))
             return res;
           p=ep+1; goto init;  /* else return match(s, ep+1, cap); */
         }
         case '-': {  /* repetition */
           char *res;
-          if ((res = match(s, ep+1, cap)) != 0)
+          if ((res = match(s, ep+1, cap)) != NULL)
             return res;
-          else if (s1) {
+          else if (s1 && s1>s) {
             s = s1;
             goto init;  /* return match(s1, p, cap); */
           }
@@ -320,25 +325,27 @@ static char *match (char *s, char *p, struct Capture *cap)
 }
 
 
-static void str_find (void)
-{
-  char *s = luaL_check_string(1);
+static void str_find (void) {
+  long l;
+  char *s = luaL_check_lstr(1, &l);
   char *p = luaL_check_string(2);
-  long init = (long)luaL_opt_number(3, 1) - 1;
-  luaL_arg_check(0 <= init && init <= strlen(s), 3, "out of range");
+  long init = posrelat(luaL_opt_long(3, 1), l) - 1;
+  struct Capture cap;
+  luaL_arg_check(0 <= init && init <= l, 3, "out of range");
   if (lua_getparam(4) != LUA_NOOBJECT ||
-      strpbrk(p, SPECIALS) == NULL) {  /* no special caracters? */
+      strpbrk(p, SPECIALS) == NULL) {  /* no special characters? */
     char *s2 = strstr(s+init, p);
     if (s2) {
       lua_pushnumber(s2-s+1);
       lua_pushnumber(s2-s+strlen(p));
+      return;
     }
   }
   else {
     int anchor = (*p == '^') ? (p++, 1) : 0;
     char *s1=s+init;
+    cap.src_end = s+l;
     do {
-      struct Capture cap;
       char *res;
       cap.level = 0;
       if ((res=match(s1, p, &cap)) != NULL) {
@@ -347,25 +354,32 @@ static void str_find (void)
         push_captures(&cap);
         return;
       }
-    } while (*s1++ && !anchor);
+    } while (s1++<cap.src_end && !anchor);
   }
+  lua_pushnil();  /* if arrives here, it didn't find */
 }
 
 
-static void add_s (lua_Object newp, struct Capture *cap)
-{
+static void add_s (lua_Object newp, struct Capture *cap) {
   if (lua_isstring(newp)) {
     char *news = lua_getstring(newp);
-    while (*news) {
-      if (*news != ESC || !isdigit((unsigned char)*++news))
-        luaL_addchar(*news++);
+    int l = lua_strlen(newp);
+    int i;
+    for (i=0; i<l; i++) {
+      if (news[i] != ESC)
+        luaL_addchar(news[i]);
       else {
-        int l = check_cap(*news++, cap);
-        addnchar(cap->capture[l].init, cap->capture[l].len);
+        i++;  /* skip ESC */
+        if (!isdigit((unsigned char)news[i]))
+          luaL_addchar(news[i]);
+        else {
+          int level = check_cap(news[i], cap);
+          addnchar(cap->capture[level].init, cap->capture[level].len);
+        }
       }
     }
   }
-  else if (lua_isfunction(newp)) {
+  else {  /* is a function */
     lua_Object res;
     int status;
     int oldbuff;
@@ -381,24 +395,27 @@ static void add_s (lua_Object newp, struct Capture *cap)
       lua_error(NULL);
     }
     res = lua_getresult(1);
-    addstr(lua_isstring(res) ? lua_getstring(res) : "");
+    if (lua_isstring(res))
+      addnchar(lua_getstring(res), lua_strlen(res));
     lua_endblock();
   }
-  else luaL_arg_check(0, 3, "string or function expected");
 }
 
 
-static void str_gsub (void)
-{
-  char *src = luaL_check_string(1);
+static void str_gsub (void) {
+  long srcl;
+  char *src = luaL_check_lstr(1, &srcl);
   char *p = luaL_check_string(2);
   lua_Object newp = lua_getparam(3);
-  int max_s = (int)luaL_opt_number(4, strlen(src)+1);
+  int max_s = luaL_opt_int(4, srcl+1);
   int anchor = (*p == '^') ? (p++, 1) : 0;
   int n = 0;
+  struct Capture cap;
+  luaL_arg_check(lua_isstring(newp) || lua_isfunction(newp), 3,
+                 "string or function expected");
   luaL_resetbuffer();
+  cap.src_end = src+srcl;
   while (n < max_s) {
-    struct Capture cap;
     char *e;
     cap.level = 0;
     e = match(src, p, &cap);
@@ -408,32 +425,41 @@ static void str_gsub (void)
     }
     if (e && e>src) /* non empty match? */
       src = e;  /* skip it */
-    else if (*src)
+    else if (src < cap.src_end)
       luaL_addchar(*src++);
     else break;
     if (anchor) break;
   }
-  addstr(src);
+  addnchar(src, cap.src_end-src);
   closeandpush();
   lua_pushnumber(n);  /* number of substitutions */
 }
 
+/* }====================================================== */
 
-static void luaI_addquoted (char *s)
-{
+
+static void luaI_addquoted (int arg) {
+  long l;
+  char *s = luaL_check_lstr(arg, &l);
   luaL_addchar('"');
-  for (; *s; s++) {
-    if (strchr("\"\\\n", *s))
-      luaL_addchar('\\');
-    luaL_addchar(*s);
+  while (l--) {
+    switch (*s) {
+      case '"':  case '\\':  case '\n':
+        luaL_addchar('\\');
+        luaL_addchar(*s);
+        break;
+      case '\0': addnchar("\\000", 4); break;
+      default: luaL_addchar(*s);
+    }
+    s++;
   }
   luaL_addchar('"');
 }
 
-#define MAX_FORMAT 200
+/* maximum size of each format specification (such as '%-099.99d') */
+#define MAX_FORMAT 20
 
-static void str_format (void)
-{
+static void str_format (void) {
   int arg = 1;
   char *strfrmt = luaL_check_string(arg);
   luaL_resetbuffer();
@@ -443,40 +469,52 @@ static void str_format (void)
     else if (*++strfrmt == '%')
       luaL_addchar(*strfrmt++);  /* %% */
     else { /* format item */
-      char form[MAX_FORMAT];      /* store the format ('%...') */
       struct Capture cap;
-      char *buff;
+      char form[MAX_FORMAT];  /* to store the format ('%...') */
+      char *buff;  /* to store the formatted item */
       char *initf = strfrmt;
       form[0] = '%';
-      cap.level = 0;
-      strfrmt = match(strfrmt, "%d?%$?[-+ #]*(%d*)%.?(%d*)", &cap);
-      if (cap.capture[0].len > 3 || cap.capture[1].len > 3)  /* < 1000? */
-        lua_error("invalid format (width or precision too long)");
-      if (isdigit((unsigned char)initf[0]) && initf[1] == '$') {
-        arg = initf[0] - '0';
+      if (isdigit((unsigned char)*initf) && *(initf+1) == '$') {
+        arg = *initf - '0';
         initf += 2;  /* skip the 'n$' */
       }
       arg++;
-      strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include convertion */
+      cap.src_end = strfrmt+strlen(strfrmt)+1;
+      cap.level = 0;
+      strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
+      if (cap.capture[0].len > 2 || cap.capture[1].len > 2 ||  /* < 100? */
+          strfrmt-initf > MAX_FORMAT-2)
+        lua_error("invalid format (width or precision too long)");
+      strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
       form[strfrmt-initf+2] = 0;
-      buff = luaL_openspace(1000);  /* to store the formatted value */
+      buff = luaL_openspace(512);  /* 512 > soid luaI_addquot99.99f', -1e308) */
       switch (*strfrmt++) {
-        case 'q':
-          luaI_addquoted(luaL_check_string(arg));
-          continue;
-        case 's': {
-          char *s = luaL_check_string(arg);
-          buff = luaL_openspace(strlen(s));
-          sprintf(buff, form, s);
+        case 'c':  case 'd':  case 'i':
+          sprintf(buff, form, luaL_check_int(arg));
           break;
-        }
-        case 'c':  case 'd':  case 'i': case 'o':
-        case 'u':  case 'x':  case 'X':
-          sprintf(buff, form, (int)luaL_check_number(arg));
+        case 'o':  case 'u':  case 'x':  case 'X':
+          sprintf(buff, form, (unsigned int)luaL_check_number(arg));
           break;
         case 'e':  case 'E': case 'f': case 'g': case 'G':
           sprintf(buff, form, luaL_check_number(arg));
           break;
+        case 'q':
+          luaI_addquoted(arg);
+          continue;  /* skip the "addsize" at the end */
+        case 's': {
+          long l;
+          char *s = luaL_check_lstr(arg, &l);
+          if (cap.capture[1].len == 0 && l >= 100) {
+            /* no precision and string is too big to be formatted;
+               keep original string */
+            addnchar(s, l);
+            continue;  /* skip the "addsize" at the end */
+          }
+          else {
+            sprintf(buff, form, s);
+            break;
+          }
+        }
         default:  /* also treat cases 'pnLlh' */
           lua_error("invalid option in `format'");
       }
@@ -492,8 +530,10 @@ static struct luaL_reg strlib[] = {
 {"strsub", str_sub},
 {"strlower", str_lower},
 {"strupper", str_upper},
+{"strchar", str_char},
 {"strrep", str_rep},
-{"ascii", str_ascii},
+{"ascii", str_byte},  /* for compatibility with 3.0 and earlier */
+{"strbyte", str_byte},
 {"format", str_format},
 {"strfind", str_find},
 {"gsub", str_gsub}

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.10 1998/01/09 14:44:55 roberto Exp roberto $
+** $Id: ltable.c,v 1.20 1999/01/25 17:41:19 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -20,14 +20,11 @@
 #define nodevector(t)	((t)->node)
 
 
-#define REHASH_LIMIT    0.70    /* avoid more than this % full */
-
 #define TagDefault LUA_T_ARRAY;
 
 
 
-static long int hashindex (TObject *ref)
-{
+static long int hashindex (TObject *ref) {
   long int h;
   switch (ttype(ref)) {
     case LUA_T_NUMBER:
@@ -56,61 +53,45 @@ static long int hashindex (TObject *ref)
 }
 
 
-static int present (Hash *t, TObject *key)
-{
+Node *luaH_present (Hash *t, TObject *key) {
   int tsize = nhash(t);
   long int h = hashindex(key);
   int h1 = h%tsize;
-  TObject *rf = ref(node(t, h1));
-  if (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)) {
-    int h2 = h%(tsize-2) + 1;
-    do {
-      h1 += h2;
-      if (h1 >= tsize) h1 -= tsize;
-      rf = ref(node(t, h1));
-    } while (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf));
+  Node *n = node(t, h1);
+  /* keep looking until an entry with "ref" equal to key or nil */
+  while ((ttype(ref(n)) == ttype(key)) ? !luaO_equalval(key, ref(n))
+                                       : ttype(ref(n)) != LUA_T_NIL) {
+    h1 += (h&(tsize-2)) + 1;  /* double hashing */
+    if (h1 >= tsize) h1 -= tsize;
+    n = node(t, h1);
   }
-  return h1;
+  return n;
 }
 
 
-/*
-** Alloc a vector node
-*/
-static Node *hashnodecreate (int nhash)
-{
-  Node *v = luaM_newvector(nhash, Node);
-  int i;
-  for (i=0; i<nhash; i++)
-    ttype(ref(&v[i])) = LUA_T_NIL;
-  return v;
-}
-
-/*
-** Delete a hash
-*/
-static void hashdelete (Hash *t)
-{
-  luaM_free(nodevector(t));
-  luaM_free(t);
-}
-
-
-void luaH_free (Hash *frees)
-{
+void luaH_free (Hash *frees) {
   while (frees) {
     Hash *next = (Hash *)frees->head.next;
     L->nblocks -= gcsize(frees->nhash);
-    hashdelete(frees);
+    luaM_free(nodevector(frees));
+    luaM_free(frees);
     frees = next;
   }
 }
 
 
-Hash *luaH_new (int nhash)
-{
+static Node *hashnodecreate (int nhash) {
+  Node *v = luaM_newvector(nhash, Node);
+  int i;
+  for (i=0; i<nhash; i++)
+    ttype(ref(&v[i])) = ttype(val(&v[i])) = LUA_T_NIL;
+  return v;
+}
+
+
+Hash *luaH_new (int nhash) {
   Hash *t = luaM_new(Hash);
-  nhash = luaO_redimension((int)((float)nhash/REHASH_LIMIT));
+  nhash = luaO_redimension(nhash*3/2);
   nodevector(t) = hashnodecreate(nhash);
   nhash(t) = nhash;
   nuse(t) = 0;
@@ -121,96 +102,75 @@ Hash *luaH_new (int nhash)
 }
 
 
-/*
-** Rehash:
-** Check if table has deleted slots. It it has, it does not need to
-** grow, since rehash will reuse them.
-*/
-static int emptyslots (Hash *t)
-{
+static int newsize (Hash *t) {
+  Node *v = t->node;
+  int size = nhash(t);
+  int realuse = 0;
   int i;
-  for (i=nhash(t)-1; i>=0; i--) {
-    Node *n = node(t, i);
-    if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) == LUA_T_NIL)
-      return 1;
+  for (i=0; i<size; i++) {
+    if (ttype(val(v+i)) != LUA_T_NIL)
+      realuse++;
   }
-  return 0;
+  return luaO_redimension((realuse+1)*2);  /* +1 is the new element */
 }
 
-static void rehash (Hash *t)
-{
-  int   nold = nhash(t);
+
+static void rehash (Hash *t) {
+  int nold = nhash(t);
   Node *vold = nodevector(t);
+  int nnew = newsize(t);
   int i;
-  if (!emptyslots(t))
-    nhash(t) = luaO_redimension(nhash(t));
-  nodevector(t) = hashnodecreate(nhash(t));
+  nodevector(t) = hashnodecreate(nnew);
+  nhash(t) = nnew;
+  nuse(t) = 0;
   for (i=0; i<nold; i++) {
     Node *n = vold+i;
-    if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
-      *node(t, present(t, ref(n))) = *n;  /* copy old node to luaM_new hash */
+    if (ttype(val(n)) != LUA_T_NIL) {
+      *luaH_present(t, ref(n)) = *n;  /* copy old node to new hash */
+      nuse(t)++;
+    }
   }
-  L->nblocks += gcsize(t->nhash)-gcsize(nold);
+  L->nblocks += gcsize(nnew)-gcsize(nold);
   luaM_free(vold);
 }
 
-/*
-** If the hash node is present, return its pointer, otherwise return
-** null.
-*/
-TObject *luaH_get (Hash *t, TObject *ref)
-{
- int h = present(t, ref);
- if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
- else return NULL;
-}
 
-
-/*
-** If the hash node is present, return its pointer, otherwise create a luaM_new
-** node for the given reference and also return its pointer.
-*/
-TObject *luaH_set (Hash *t, TObject *ref)
-{
-  Node *n = node(t, present(t, ref));
-  if (ttype(ref(n)) == LUA_T_NIL) {
-    nuse(t)++;
-    if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) {
-      rehash(t);
-      n = node(t, present(t, ref));
-    }
-    *ref(n) = *ref;
-    ttype(val(n)) = LUA_T_NIL;
-  }
-  return (val(n));
-}
-
-
-static Node *hashnext (Hash *t, int i)
-{
-  Node *n;
-  int tsize = nhash(t);
-  if (i >= tsize)
-    return NULL;
-  n = node(t, i);
-  while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
-    if (++i >= tsize)
-      return NULL;
-    n = node(t, i);
-  }
-  return node(t, i);
-}
-
-Node *luaH_next (TObject *o, TObject *r)
-{
-  Hash *t = avalue(o);
-  if (ttype(r) == LUA_T_NIL)
-    return hashnext(t, 0);
+void luaH_set (Hash *t, TObject *ref, TObject *val) {
+  Node *n = luaH_present(t, ref);
+  if (ttype(ref(n)) != LUA_T_NIL)
+    *val(n) = *val;
   else {
-    int i = present(t, r);
-    Node *n = node(t, i);
-    luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL,
-                   2, "key not found");
-    return hashnext(t, i+1);
+    TObject buff = *val;  /* rehash may invalidate this address */
+    if ((long)nuse(t)*3L > (long)nhash(t)*2L) {
+      rehash(t);
+      n = luaH_present(t, ref);
+    }
+    nuse(t)++;
+    *ref(n) = *ref;
+    *val(n) = buff;
   }
 }
+
+
+int luaH_pos (Hash *t, TObject *r) {
+  Node *n = luaH_present(t, r);
+  luaL_arg_check(ttype(val(n)) != LUA_T_NIL, 2, "key not found");
+  return n-(t->node);
+}
+
+
+void luaH_setint (Hash *t, int ref, TObject *val) {
+  TObject index;
+  ttype(&index) = LUA_T_NUMBER;
+  nvalue(&index) = ref;
+  luaH_set(t, &index, val);
+}
+
+
+TObject *luaH_getint (Hash *t, int ref) {
+  TObject index;
+  ttype(&index) = LUA_T_NUMBER;
+  nvalue(&index) = ref;
+  return luaH_get(t, &index);
+}
+

ltable.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
+** $Id: ltable.h,v 1.10 1999/01/25 17:40:10 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -15,10 +15,16 @@
 #define val(n)		(&(n)->val)
 #define nhash(t)	((t)->nhash)
 
+#define luaH_get(t,ref)	(val(luaH_present((t), (ref))))
+#define luaH_move(t,from,to)	(luaH_setint(t, to, luaH_getint(t, from)))
+
 Hash *luaH_new (int nhash);
 void luaH_free (Hash *frees);
-TObject *luaH_get (Hash *t, TObject *ref);
-TObject *luaH_set (Hash *t, TObject *ref);
-Node *luaH_next (TObject *o, TObject *r);
+Node *luaH_present (Hash *t, TObject *key);
+void luaH_set (Hash *t, TObject *ref, TObject *val);
+int luaH_pos (Hash *t, TObject *r);
+void luaH_setint (Hash *t, int ref, TObject *val);
+TObject *luaH_getint (Hash *t, int ref);
+
 
 #endif

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.12 1997/12/15 16:17:20 roberto Exp roberto $
+** $Id: ltm.c,v 1.23 1999/02/25 19:13:56 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -22,9 +22,8 @@ char *luaT_eventname[] = {  /* ORDER IM */
 };
 
 
-static int luaI_checkevent (char *name, char *list[])
-{
-  int e = luaO_findstring(name, list);
+static int luaI_checkevent (char *name, char *list[]) {
+  int e = luaL_findstring(name, list);
   if (e < 0)
     luaL_verror("`%.50s' is not a valid event name", name);
   return e;
@@ -35,7 +34,7 @@ static int luaI_checkevent (char *name, char *list[])
 /* events in LUA_T_NIL are all allowed, since this is used as a
 *  'placeholder' for "default" fallbacks
 */
-static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
+static char luaT_validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
 {1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_USERDATA */
 {1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_NUMBER */
 {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
@@ -45,71 +44,59 @@ static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
 {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}   /* LUA_T_NIL */
 };
 
-
-static int validevent (int t, int e)
-{ /* ORDER LUA_T */
-  return (t < LUA_T_NIL) ?  1 : validevents[-t][e];
+static int luaT_validevent (int t, int e) {  /* ORDER LUA_T */
+  return (t < LUA_T_NIL) ?  1 : luaT_validevents[-t][e];
 }
 
 
-static void init_entry (int tag)
-{
+static void init_entry (int tag) {
   int i;
   for (i=0; i<IM_N; i++)
     ttype(luaT_getim(tag, i)) = LUA_T_NIL;
 }
 
 
-void luaT_init (void)
-{
+void luaT_init (void) {
   int t;
-  L->IMtable_size = NUM_TAGS*2;
   L->last_tag = -(NUM_TAGS-1);
-  L->IMtable = luaM_newvector(L->IMtable_size, struct IM);
+  luaM_growvector(L->IMtable, 0, NUM_TAGS, struct IM, arrEM, MAX_INT);
   for (t=L->last_tag; t<=0; t++)
     init_entry(t);
 }
 
 
-int lua_newtag (void)
-{
+int lua_newtag (void) {
   --L->last_tag;
-  if ((-L->last_tag) >= L->IMtable_size)
-    L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size,
-                                   struct IM, memEM, MAX_INT);
+  luaM_growvector(L->IMtable, -(L->last_tag), 1, struct IM, arrEM, MAX_INT);
   init_entry(L->last_tag);
   return L->last_tag;
 }
 
 
-static void checktag (int tag)
-{
+static void checktag (int tag) {
   if (!(L->last_tag <= tag && tag <= 0))
     luaL_verror("%d is not a valid tag", tag);
 }
 
-void luaT_realtag (int tag)
-{
+void luaT_realtag (int tag) {
   if (!(L->last_tag <= tag && tag < LUA_T_NIL))
-    luaL_verror("tag %d is not result of `newtag'", tag);
+    luaL_verror("tag %d was not created by `newtag'", tag);
 }
 
 
-int lua_copytagmethods (int tagto, int tagfrom)
-{
+int lua_copytagmethods (int tagto, int tagfrom) {
   int e;
   checktag(tagto);
   checktag(tagfrom);
   for (e=0; e<IM_N; e++) {
-    if (validevent(tagto, e))
+    if (luaT_validevent(tagto, e))
       *luaT_getim(tagto, e) = *luaT_getim(tagfrom, e);
   }
   return tagto;
 }
 
 
-int luaT_efectivetag (TObject *o)
-{
+int luaT_effectivetag (TObject *o) {
   int t;
   switch (t = ttype(o)) {
     case LUA_T_ARRAY:
@@ -123,7 +110,7 @@ int luaT_efectivetag (TObject *o)
 #ifdef DEBUG
     case LUA_T_PMARK: case LUA_T_CMARK:
     case LUA_T_CLMARK: case LUA_T_LINE:
-      lua_error("internal error");
+      LUA_INTERNALERROR("invalid type");
 #endif
     default:
       return t;
@@ -131,36 +118,33 @@ int luaT_efectivetag (TObject *o)
 }
 
 
-TObject *luaT_gettagmethod (int t, char *event)
-{
+TObject *luaT_gettagmethod (int t, char *event) {
   int e = luaI_checkevent(event, luaT_eventname);
   checktag(t);
-  if (validevent(t, e))
+  if (luaT_validevent(t, e))
     return luaT_getim(t,e);
   else
     return &luaO_nilobject;
 }
 
 
-void luaT_settagmethod (int t, char *event, TObject *func)
-{
+void luaT_settagmethod (int t, char *event, TObject *func) {
   TObject temp = *func;
   int e = luaI_checkevent(event, luaT_eventname);
   checktag(t);
-  if (!validevent(t, e))
-    luaL_verror("settagmethod: cannot change internal method `%.20s' for tag %d",
-                luaT_eventname[e], t);
+  if (!luaT_validevent(t, e))
+    luaL_verror("cannot change tag method `%.20s' for type `%.20s'%.20s",
+                luaT_eventname[e], luaO_typenames[-t],
+                (t == LUA_T_ARRAY || t == LUA_T_USERDATA) ? " with default tag"
+                                                          : "");
   *func = *luaT_getim(t,e);
   *luaT_getim(t, e) = temp;
 }
 
 
-char *luaT_travtagmethods (int (*fn)(TObject *))
-{
+char *luaT_travtagmethods (int (*fn)(TObject *)) {  /* ORDER IM */
   int e;
-  if (fn(&L->errorim))
-    return "error";
-  for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {  /* ORDER IM */
+  for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {
     int t;
     for (t=0; t>=L->last_tag; t--)
       if (fn(luaT_getim(t,e)))
@@ -177,6 +161,7 @@ char *luaT_travtagmethods (int (*fn)(TObject *))
 #ifdef LUA_COMPAT2_5
 
 #include "lapi.h"
+#include "lstring.h"
 
 static void errorFB (void)
 {
@@ -191,35 +176,34 @@ static void errorFB (void)
 static void nilFB (void) { }
 
 
-static void typeFB (void)
-{
+static void typeFB (void) {
   lua_error("unexpected type");
 }
 
 
-static void fillvalids (IMS e, TObject *func)
-{
+static void fillvalids (IMS e, TObject *func) {
   int t;
   for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
-    if (validevent(t, e))
+    if (luaT_validevent(t, e))
       *luaT_getim(t, e) = *func;
 }
 
 
-void luaT_setfallback (void)
-{
+void luaT_setfallback (void) {
   static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
   TObject oldfunc;
   lua_CFunction replace;
   char *name = luaL_check_string(1);
   lua_Object func = lua_getparam(2);
   luaL_arg_check(lua_isfunction(func), 2, "function expected");
-  switch (luaO_findstring(name, oldnames)) {
-    case 0:  /* old error fallback */
-      oldfunc = L->errorim;
-      L->errorim = *luaA_Address(func);
+  switch (luaL_findstring(name, oldnames)) {
+    case 0: {  /* old error fallback */
+      TObject *em = &(luaS_new("_ERRORMESSAGE")->u.s.globalval);
+      oldfunc = *em;
+      *em = *luaA_Address(func);
       replace = errorFB;
       break;
+    }
     case 1:  /* old getglobal fallback */
       oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
       *luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
@@ -243,7 +227,7 @@ void luaT_setfallback (void)
     }
     default: {
       int e;
-      if ((e = luaO_findstring(name, luaT_eventname)) >= 0) {
+      if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
         oldfunc = *luaT_getim(LUA_T_NIL, e);
         fillvalids(e, luaA_Address(func));
         replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;

ltm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
+** $Id: ltm.h,v 1.4 1997/11/26 18:53:45 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -45,14 +45,14 @@ struct IM {
 
 
 #define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event])
-#define luaT_getimbyObj(o,e)  (luaT_getim(luaT_efectivetag(o),(e)))
+#define luaT_getimbyObj(o,e)  (luaT_getim(luaT_effectivetag(o),(e)))
 
 extern char *luaT_eventname[];
 
 
 void luaT_init (void);
 void luaT_realtag (int tag);
-int luaT_efectivetag (TObject *o);
+int luaT_effectivetag (TObject *o);
 void luaT_settagmethod (int t, char *event, TObject *func);
 TObject *luaT_gettagmethod (int t, char *event);
 char *luaT_travtagmethods (int (*fn)(TObject *));

lua.c

@@ -1,11 +1,13 @@
 /*
-** $Id: lua.c,v 1.11 1997/12/22 18:05:23 roberto Exp roberto $
+** $Id: lua.c,v 1.18 1999/01/26 11:50:58 roberto Exp roberto $
 ** Lua stand-alone interpreter
 ** See Copyright Notice in lua.h
 */
 
 
+#include <signal.h>
 #include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
 #include "lua.h"
@@ -26,8 +28,44 @@
 #endif
 
 
-static void print_message (void)
-{
+typedef void (*handler)(int);  /* type for signal actions */
+
+static void laction (int i);
+
+
+static lua_LHFunction old_linehook = NULL;
+static lua_CHFunction old_callhook = NULL;
+
+
+static handler lreset (void) {
+  return signal(SIGINT, laction);
+}
+
+
+static void lstop (void) {
+  lua_setlinehook(old_linehook);
+  lua_setcallhook(old_callhook);
+  lreset();
+  lua_error("interrupted!");
+}
+
+
+static void laction (int i) {
+  old_linehook = lua_setlinehook((lua_LHFunction)lstop);
+  old_callhook = lua_setcallhook((lua_CHFunction)lstop);
+}
+
+
+static int ldo (int (*f)(char *), char *name) {
+  int res;
+  handler h = lreset();
+  res = f(name);  /* dostring | dofile */
+  signal(SIGINT, h);  /* restore old action */
+  return res;
+}
+
+
+static void print_message (void) {
   fprintf(stderr,
 "Lua: command line options:\n"
 "  -v       print version information\n"
@@ -41,8 +79,7 @@ static void print_message (void)
 }
 
 
-static void assign (char *arg)
-{
+static void assign (char *arg) {
   if (strlen(arg) >= 500)
     fprintf(stderr, "lua: shell argument too long");
   else {
@@ -55,13 +92,11 @@ static void assign (char *arg)
   }
 }
 
-#define BUF_SIZE	512
 
-static void manual_input (int prompt)
-{
+static void manual_input (int prompt) {
   int cont = 1;
   while (cont) {
-    char buffer[BUF_SIZE];
+    char buffer[BUFSIZ];
     int i = 0;
     lua_beginblock();
     if (prompt)
@@ -77,14 +112,14 @@ static void manual_input (int prompt)
           buffer[i-1] = '\n';
         else break;
       }
-      else if (i >= BUF_SIZE-1) {
+      else if (i >= BUFSIZ-1) {
         fprintf(stderr, "lua: argument line too long\n");
         break;
       }
-      else buffer[i++] = c;
+      else buffer[i++] = (char)c;
     }
-    buffer[i] = 0;
-    lua_dostring(buffer);
+    buffer[i] = '\0';
+    ldo(lua_dostring, buffer);
     lua_endblock();
   }
   printf("\n");
@@ -94,24 +129,23 @@ static void manual_input (int prompt)
 int main (int argc, char *argv[])
 {
   int i;
-  setlocale(LC_ALL, "");
-  lua_iolibopen();
-  lua_strlibopen();
-  lua_mathlibopen();
+  lua_open();
   lua_pushstring("> "); lua_setglobal("_PROMPT");
+  setlocale(LC_ALL, "");
+  lua_userinit();
   if (argc < 2) {  /* no arguments? */
     if (isatty(0)) {
       printf("%s  %s\n", LUA_VERSION, LUA_COPYRIGHT);
       manual_input(1);
     }
     else
-      lua_dofile(NULL);  /* executes stdin as a file */
+      ldo(lua_dofile, NULL);  /* executes stdin as a file */
   }
   else for (i=1; i<argc; i++) {
     if (argv[i][0] == '-') {  /* option? */
       switch (argv[i][1]) {
         case 0:
-          lua_dofile(NULL);  /* executes stdin as a file */
+          ldo(lua_dofile, NULL);  /* executes stdin as a file */
           break;
         case 'i':
           manual_input(1);
@@ -120,7 +154,7 @@ int main (int argc, char *argv[])
           manual_input(0);
           break;
         case 'd':
-          lua_debug = 1;
+          lua_setdebug(1);
           break;
         case 'v':
           printf("%s  %s\n(written by %s)\n\n",
@@ -128,7 +162,7 @@ int main (int argc, char *argv[])
           break;
         case 'e':
           i++;
-          if (lua_dostring(argv[i]) != 0) {
+          if (ldo(lua_dostring, argv[i]) != 0) {
             fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
             return 1;
           }
@@ -141,7 +175,7 @@ int main (int argc, char *argv[])
     else if (strchr(argv[i], '='))
       assign(argv[i]);
     else {
-      int result = lua_dofile(argv[i]);
+      int result = ldo(lua_dofile, argv[i]);
       if (result) {
         if (result == 2) {
           fprintf(stderr, "lua: cannot execute file ");

lua.h

@@ -1,50 +1,18 @@
 /*
-** $Id: lua.h,v 1.13 1998/01/02 17:46:32 roberto Exp roberto $
+** $Id: lua.h,v 1.30 1999/02/25 19:13:56 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
 ** e-mail: lua@tecgraf.puc-rio.br
 ** www: http://www.tecgraf.puc-rio.br/lua/
+** See Copyright Notice at the end of this file
 */
 
-/*********************************************************************
-* Copyright  (c) 1994-1998 TeCGraf, PUC-Rio.
-* Written by Waldemar Celes Filho, Roberto Ierusalimschy and
-* Luiz Henrique de Figueiredo.
-* All rights reserved.
-* 
-* Permission is hereby granted, without written agreement and with­
-* out license or royalty fees, to use, copy, modify, and distribute
-* this  software  and its documentation for any purpose, subject to
-* the following conditions:
-* 
-* The above copyright notice and this permission notice  shall  ap­
-* pear in all copies or substantial portions of this software.
-* 
-* The name "Lua" cannot be used for any modified form of this soft­
-* ware that does not originate from the authors. Nevertheless,  the
-* name  "Lua"  may and should be used to designate the language im­
-* plemented and described in this package, even if embedded in  any
-* other  system,  as  long  as  its syntax and semantics remain un­
-* changed.
-* 
-* The authors specifically disclaim any warranties, including,  but
-* not  limited  to,  the  implied warranties of merchantability and
-* fitness for a particular purpose. The software provided hereunder
-* is  on  an  "as  is" basis, and the authors have no obligation to
-* provide maintenance, support, updates, enhancements, or modifica­
-* tions.  In no event shall TeCGraf, PUC-Rio, or the authors be li­
-* able to any party for direct, indirect, special,  incidental,  or
-* consequential damages arising out of the use of this software and
-* its documentation.
-*********************************************************************/
-
-
 
 #ifndef lua_h
 #define lua_h
 
-#define LUA_VERSION	"Lua 3.1 (alpha)"
-#define LUA_COPYRIGHT	"Copyright (C) 1994-1998 TeCGraf"
+#define LUA_VERSION	"Lua 3.2 (beta)"
+#define LUA_COPYRIGHT	"Copyright (C) 1994-1999 TeCGraf, PUC-Rio"
 #define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
 
 
@@ -52,16 +20,18 @@
 
 #define LUA_ANYTAG    (-1)
 
+typedef struct lua_State lua_State;
+extern lua_State *lua_state;
+
 typedef void (*lua_CFunction) (void);
 typedef unsigned int lua_Object;
 
-
 void	       lua_open			(void);
 void           lua_close		(void);
+lua_State      *lua_setstate		(lua_State *st);
 
 lua_Object     lua_settagmethod	(int tag, char *event); /* In: new method */
 lua_Object     lua_gettagmethod	(int tag, char *event);
-lua_Object     lua_seterrormethod (void);  /* In: new method */
 
 int            lua_newtag		(void);
 int            lua_copytagmethods	(int tagto, int tagfrom);
@@ -70,6 +40,8 @@ void           lua_settag		(int tag); /* In: object */
 void           lua_error		(char *s);
 int            lua_dofile 		(char *filename); /* Out: returns */
 int            lua_dostring 		(char *string); /* Out: returns */
+int            lua_dobuffer		(char *buff, int size, char *name);
+					  /* Out: returns */
 int            lua_callfunction		(lua_Object f);
 					  /* In: parameters; Out: returns */
 
@@ -90,14 +62,16 @@ int            lua_isfunction           (lua_Object object);
 
 double         lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
+long           lua_strlen 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
 void	      *lua_getuserdata		(lua_Object object);
 
 
 void 	       lua_pushnil 		(void);
 void           lua_pushnumber 		(double n);
+void           lua_pushlstring		(char *s, long len);
 void           lua_pushstring 		(char *s);
-void           lua_pushCclosure		(lua_CFunction fn, int n);
+void           lua_pushcclosure		(lua_CFunction fn, int n);
 void           lua_pushusertag          (void *u, int tag);
 void           lua_pushobject       	(lua_Object object);
 
@@ -115,6 +89,9 @@ lua_Object     lua_rawgettable		(void); /* In: table, index */
 
 int            lua_tag			(lua_Object object);
 
+char          *lua_nextvar		(char *varname);  /* Out: value */
+int            lua_next			(lua_Object o, int i);
+						/* Out: ref, value */ 
 
 int            lua_ref			(int lock); /* In: value */
 lua_Object     lua_getref		(int ref);
@@ -126,7 +103,7 @@ long	       lua_collectgarbage	(long limit);
 
 
 /* =============================================================== */
-/* some useful macros */
+/* some useful macros/functions */
 
 #define lua_call(name)		lua_callfunction(lua_getglobal(name))
 
@@ -138,10 +115,11 @@ long	       lua_collectgarbage	(long limit);
 
 #define lua_pushuserdata(u)     lua_pushusertag(u, 0)
 
-#define lua_pushcfunction(f)	lua_pushCclosure(f, 0)
+#define lua_pushcfunction(f)	lua_pushcclosure(f, 0)
 
 #define lua_clonetag(t)		lua_copytagmethods(lua_newtag(), (t))
 
+lua_Object     lua_seterrormethod (void);  /* In: new method */
 
 /* ==========================================================================
 ** for compatibility with old versions. Avoid using these macros/functions
@@ -176,3 +154,40 @@ lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
 #endif
 
 #endif
+
+
+
+/******************************************************************************
+* Copyright (c) 1994-1999 TeCGraf, PUC-Rio.  All rights reserved.
+* 
+* Permission is hereby granted, without written agreement and without license
+* or royalty fees, to use, copy, modify, and distribute this software and its
+* documentation for any purpose, including commercial applications, subject to
+* the following conditions:
+* 
+*  - The above copyright notice and this permission notice shall appear in all
+*    copies or substantial portions of this software.
+* 
+*  - The origin of this software must not be misrepresented; you must not
+*    claim that you wrote the original software. If you use this software in a
+*    product, an acknowledgment in the product documentation would be greatly
+*    appreciated (but it is not required).
+* 
+*  - Altered source versions must be plainly marked as such, and must not be
+*    misrepresented as being the original software.
+*    
+* The authors specifically disclaim any warranties, including, but not limited
+* to, the implied warranties of merchantability and fitness for a particular
+* purpose.  The software provided hereunder is on an "as is" basis, and the
+* authors have no obligation to provide maintenance, support, updates,
+* enhancements, or modifications.  In no event shall TeCGraf, PUC-Rio, or the
+* authors be held liable to any party for direct, indirect, special,
+* incidental, or consequential damages arising out of the use of this software
+* and its documentation.
+* 
+* The Lua language and this implementation have been entirely designed and
+* written by Waldemar Celes Filho, Roberto Ierusalimschy and
+* Luiz Henrique de Figueiredo at TeCGraf, PUC-Rio.
+*
+* This implementation contains no third-party code.
+******************************************************************************/

lua.stx

@@ -1,939 +0,0 @@
-%{
-/*
-** $Id: lua.stx,v 1.32 1998/01/12 13:00:51 roberto Exp roberto $
-** Syntax analizer and code generator
-** See Copyright Notice in lua.h
-*/
-
-
-#include <stdlib.h>
-#include <string.h>
-
-#include "lauxlib.h"
-#include "ldo.h"
-#include "lfunc.h"
-#include "llex.h"
-#include "lmem.h"
-#include "lopcodes.h"
-#include "lparser.h"
-#include "lstate.h"
-#include "lstring.h"
-#include "lua.h"
-#include "luadebug.h"
-#include "lzio.h"
-
-
-int luaY_parse (void);
-
-
-#define MES_LIM(x)	"(limit=" x ")"
-
-
-/* size of a "normal" jump instruction: OpCode + 1 byte */
-#define JMPSIZE	2
-
-/* maximum number of local variables */
-#define MAXLOCALS 32
-#define SMAXLOCALS "32"
-
-#define MINGLOBAL (MAXLOCALS+1)
-
-/* maximum number of variables in a multiple assignment */
-#define MAXVAR 32
-#define SMAXVAR "32"
-
-/* maximum number of nested functions */
-#define MAXSTATES  6
-#define SMAXSTATES  "6"
-
-/* maximum number of upvalues */
-#define MAXUPVALUES 16
-#define SMAXUPVALUES "16"
-
-
-
-/*
-** Variable descriptor:
-** if 0<n<MINGLOBAL, represents local variable indexed by (n-1);
-** if MINGLOBAL<=n, represents global variable at position (n-MINGLOBAL);
-** if n<0, indexed variable with index (-n)-1 (table on top of stack);
-** if n==0, an indexed variable (table and index on top of stack)
-** Must be long to store negative Word values.
-*/
-typedef long vardesc;
-
-#define isglobal(v)	(MINGLOBAL<=(v))
-#define globalindex(v)	((v)-MINGLOBAL)
-#define islocal(v)	(0<(v) && (v)<MINGLOBAL)
-#define localindex(v)	((v)-1)
-#define isdot(v)	(v<0)
-#define dotindex(v)	((-(v))-1)
-
-/* state needed to generate code for a given function */
-typedef struct FuncState {
-  TProtoFunc *f;  /* current function header */
-  int pc;  /* next position to code */
-  TaggedString *localvar[MAXLOCALS];  /* store local variable names */
-  int stacksize;  /* number of values on activation register */
-  int maxstacksize;  /* maximum number of values on activation register */
-  int nlocalvar;  /* number of active local variables */
-  int nupvalues;  /* number of upvalues */
-  int nvars;  /* number of entries in f->locvars */
-  int maxcode;  /* size of f->code */
-  int maxvars;  /* size of f->locvars (-1 if no debug information) */
-  int maxconsts;  /* size of f->consts */
-  vardesc varbuffer[MAXVAR];  /* variables in an assignment list */
-  vardesc upvalues[MAXUPVALUES];  /* upvalues */
-} FuncState;
-
-
-
-#define YYPURE	1
-
-
-void luaY_syntaxerror (char *s, char *token)
-{
-  if (token[0] == 0)
-    token = "<eof>";
-  luaL_verror("%.100s;\n  last token read: \"%.50s\" at line %d in file %.50s",
-           s, token, L->lexstate->linenumber, L->mainState->f->fileName->str);
-}
-
-
-void luaY_error (char *s)
-{
-  luaY_syntaxerror(s, luaX_lasttoken());
-}
-
-
-static void check_pc (int n)
-{
-  FuncState *fs = L->currState;
-  if (fs->pc+n > fs->maxcode)
-    fs->maxcode = luaM_growvector(&fs->f->code, fs->maxcode,
-                                  Byte, codeEM, MAX_INT);
-}
-
-
-static void code_byte (Byte c)
-{
-  check_pc(1);
-  L->currState->f->code[L->currState->pc++] = c;
-}
-
-
-static void deltastack (int delta)
-{
-  FuncState *fs = L->currState;
-  fs->stacksize += delta;
-  if (fs->stacksize > fs->maxstacksize) {
-    if (fs->stacksize > 255)
-      luaY_error("function/expression too complex");
-    fs->maxstacksize = fs->stacksize;
-  }
-}
-
-
-static int code_oparg_at (int pc, OpCode op, int builtin, int arg, int delta)
-{
-  Byte *code = L->currState->f->code;
-  deltastack(delta);
-  if (arg < builtin) {
-    code[pc] = op+1+arg;
-    return 1;
-  }
-  else if (arg <= 255) {
-    code[pc] = op;
-    code[pc+1] = arg;
-    return 2;
-  }
-  else if (arg <= MAX_WORD) {
-    code[pc] = op+1+builtin;
-    code[pc+1] = arg&0xFF;
-    code[pc+2] = arg>>8;
-    return 3;
-  }
-  else luaY_error("code too long " MES_LIM("64K"));
-  return 0;   /* to avoid warnings */
-}
-
-
-static int fix_opcode (int pc, OpCode op, int builtin, int arg)
-{
-  FuncState *fs = L->currState;
-  if (arg < builtin) {  /* close space */
-    luaO_memdown(fs->f->code+pc+1, fs->f->code+pc+2, fs->pc-(pc+2));
-    fs->pc--;
-  }
-  else if (arg > 255) {  /* open space */
-    check_pc(1);
-    luaO_memup(fs->f->code+pc+1, fs->f->code+pc, fs->pc-pc);
-    fs->pc++;
-  }
-  return code_oparg_at(pc, op, builtin, arg, 0) - 2;
-}
-
-
-static void code_oparg (OpCode op, int builtin, int arg, int delta)
-{
-  check_pc(3);  /* maximum code size */
-  L->currState->pc += code_oparg_at(L->currState->pc, op, builtin, arg, delta);
-}
-
-
-static void code_opcode (OpCode op, int delta)
-{
-  deltastack(delta);
-  code_byte(op);
-}
-
-
-static void code_pop (OpCode op)
-{
-  code_opcode(op, -1);
-}
-
-/* binary operations get 2 arguments and leave one, so they pop one */
-#define code_binop(op)	code_pop(op)
-
-
-static void code_neutralop (OpCode op)
-{
-  code_opcode(op, 0);
-}
-
-/* unary operations get 1 argument and leave one, so they are neutral */
-#define code_unop(op)	code_neutralop(op)
-
-
-static void code_constant (int c)
-{
-  code_oparg(PUSHCONSTANT, 8, c, 1);
-}
-
-
-static int next_constant (FuncState *cs)
-{
-  TProtoFunc *f = cs->f;
-  if (f->nconsts >= cs->maxconsts) {
-    cs->maxconsts = luaM_growvector(&f->consts, cs->maxconsts, TObject,
-                                    constantEM, MAX_WORD);
-  }
-  return f->nconsts++;
-}
-
-
-static int string_constant (TaggedString *s, FuncState *cs)
-{
-  TProtoFunc *f = cs->f;
-  int c = s->constindex;
-  if (!(c < f->nconsts &&
-      ttype(&f->consts[c]) == LUA_T_STRING && tsvalue(&f->consts[c]) == s)) {
-    c = next_constant(cs);
-    ttype(&f->consts[c]) = LUA_T_STRING;
-    tsvalue(&f->consts[c]) = s;
-    s->constindex = c;  /* hint for next time */
-  }
-  return c;
-}
-
-
-static void code_string (TaggedString *s)
-{
-  code_constant(string_constant(s, L->currState));
-}
-
-
-#define LIM 20
-static int real_constant (real r)
-{
-  /* check whether 'r' has appeared within the last LIM entries */
-  TObject *cnt = L->currState->f->consts;
-  int c = L->currState->f->nconsts;
-  int lim = c < LIM ? 0 : c-LIM;
-  while (--c >= lim) {
-    if (ttype(&cnt[c]) == LUA_T_NUMBER && nvalue(&cnt[c]) == r)
-      return c;
-  }
-  /* not found; create a luaM_new entry */
-  c = next_constant(L->currState);
-  cnt = L->currState->f->consts;  /* 'next_constant' may reallocate this vector */
-  ttype(&cnt[c]) = LUA_T_NUMBER;
-  nvalue(&cnt[c]) = r;
-  return c;
-}
-
-
-static void code_number (real f)
-{
-  int i;
-  if (f >= 0 && f <= (real)MAX_WORD && (real)(i=(int)f) == f)
-    code_oparg(PUSHNUMBER, 3, i, 1);  /* f has an (short) integer value */
-  else
-    code_constant(real_constant(f));
-}
-
-
-static void flush_record (int n)
-{
-  if (n > 0)
-    code_oparg(SETMAP, 1, n-1, -2*n);
-}
-
-static void flush_list (int m, int n)
-{
-  if (n == 0) return;
-  code_oparg(SETLIST, 1, m, -n);
-  code_byte(n);
-}
-
-
-static void luaI_registerlocalvar (TaggedString *varname, int line)
-{
-  FuncState *fs = L->currState;
-  if (fs->maxvars != -1) {  /* debug information? */
-    if (fs->nvars >= fs->maxvars)
-      fs->maxvars = luaM_growvector(&fs->f->locvars, fs->maxvars,
-                                    LocVar, "", MAX_WORD);
-    fs->f->locvars[fs->nvars].varname = varname;
-    fs->f->locvars[fs->nvars].line = line;
-    fs->nvars++;
-  }
-}
-
-
-static void luaI_unregisterlocalvar (int line)
-{
-  luaI_registerlocalvar(NULL, line);
-}
-
-
-static void store_localvar (TaggedString *name, int n)
-{
-  if (L->currState->nlocalvar+n < MAXLOCALS)
-    L->currState->localvar[L->currState->nlocalvar+n] = name;
-  else
-    luaY_error("too many local variables " MES_LIM(SMAXLOCALS));
-  luaI_registerlocalvar(name, L->lexstate->linenumber);
-}
-
-static void add_localvar (TaggedString *name)
-{
-  store_localvar(name, 0);
-  L->currState->nlocalvar++;
-}
-
-
-/* 
-** dotted variables <a.x> must be stored like regular indexed vars <a["x"]>
-*/
-static vardesc var2store (vardesc var)
-{
-  if (isdot(var)) {
-    code_constant(dotindex(var));
-    var = 0;
-  }
-  return var;
-}
-
-
-static void add_varbuffer (vardesc var, int n)
-{
-  if (n >= MAXVAR)
-    luaY_error("variable buffer overflow " MES_LIM(SMAXVAR));
-  L->currState->varbuffer[n] = var2store(var);
-}
-
-
-static int aux_localname (TaggedString *n, FuncState *st)
-{
-  int i;
-  for (i=st->nlocalvar-1; i >= 0; i--)
-    if (n == st->localvar[i]) return i;  /* local var index */
-  return -1;  /* not found */
-}
-
-
-static vardesc singlevar (TaggedString *n, FuncState *st)
-{
-  int i = aux_localname(n, st);
-  if (i == -1) {  /* check shadowing */
-    int l;
-    for (l=1; l<=(st-L->mainState); l++)
-      if (aux_localname(n, st-l) >= 0)
-        luaY_syntaxerror("cannot access a variable in outer scope", n->str);
-    return string_constant(n, st)+MINGLOBAL;  /* global value */
-  }
-  else return i+1;  /* local value */
-}
-
-
-static int indexupvalue (TaggedString *n)
-{
-  vardesc v = singlevar(n, L->currState-1);
-  int i;
-  for (i=0; i<L->currState->nupvalues; i++) {
-    if (L->currState->upvalues[i] == v)
-      return i;
-  }
-  /* new one */
-  if (++(L->currState->nupvalues) > MAXUPVALUES)
-    luaY_error("too many upvalues in a single function " MES_LIM(SMAXUPVALUES));
-  L->currState->upvalues[i] = v;  /* i = L->currState->nupvalues - 1 */
-  return i;
-}
-
-
-static void pushupvalue (TaggedString *n)
-{
-  int i;
-  if (L->currState == L->mainState)
-    luaY_error("cannot access upvalue in main");
-  if (aux_localname(n, L->currState) >= 0)
-    luaY_syntaxerror("cannot access an upvalue in current scope", n->str);
-  i = indexupvalue(n);
-  code_oparg(PUSHUPVALUE, 2, i, 1);
-}
-
-
-void luaY_codedebugline (int line)
-{
-  if (lua_debug && line != L->lexstate->lastline) {
-    code_oparg(SETLINE, 0, line, 0);
-    L->lexstate->lastline = line;
-  }
-}
-
-
-static void adjuststack (int n)
-{
-  if (n > 0)
-    code_oparg(POP, 2, n-1, -n);
-  else if (n < 0)
-    code_oparg(PUSHNIL, 1, (-n)-1, -n);
-}
-
-
-static long adjust_functioncall (long exp, int nresults)
-{
-  if (exp <= 0)
-    return -exp; /* exp is -list length */
-  else {
-    int temp = L->currState->f->code[exp];
-    int nparams = L->currState->f->code[exp-1];
-    exp += fix_opcode(exp-2, CALLFUNC, 2, nresults);
-    L->currState->f->code[exp] = nparams;
-    if (nresults != MULT_RET)
-      deltastack(nresults);
-    deltastack(-(nparams+1));
-    return temp+nresults;
-  }
-}
-
-
-static void adjust_mult_assign (int vars, long exps)
-{
-  if (exps > 0) { /* must correct function call */
-    int diff = L->currState->f->code[exps] - vars;
-    if (diff < 0)
-      adjust_functioncall(exps, -diff);
-    else {
-      adjust_functioncall(exps, 0);
-      adjuststack(diff);
-    }
-  }
-  else adjuststack((-exps)-vars);
-}
-
-
-static void code_args (int nparams, int dots)
-{
-  L->currState->nlocalvar += nparams;  /* "self" may already be there */
-  nparams = L->currState->nlocalvar;
-  if (!dots) {
-    L->currState->f->code[1] = nparams;  /* fill-in arg information */
-    deltastack(nparams);
-  }
-  else {
-    L->currState->f->code[1] = nparams+ZEROVARARG;
-    deltastack(nparams+1);
-    add_localvar(luaS_new("arg"));
-  }
-}
-
-
-static void lua_pushvar (vardesc var)
-{
-  if (isglobal(var))
-    code_oparg(GETGLOBAL, 8, globalindex(var), 1);
-  else if (islocal(var))
-    code_oparg(PUSHLOCAL, 8, localindex(var), 1);
-  else if (isdot(var))
-    code_oparg(GETDOTTED, 8, dotindex(var), 0);
-  else
-    code_pop(GETTABLE);
-}
-
-
-static void storevar (vardesc var)
-{
-  if (var == 0)  /* indexed var */
-    code_opcode(SETTABLE0, -3);
-  else if (isglobal(var))
-    code_oparg(SETGLOBAL, 8, globalindex(var), -1);
-  else  /* local var */
-    code_oparg(SETLOCAL, 8, localindex(var), -1);
-}
-
-
-/* returns how many elements are left as 'garbage' on the stack */
-static int lua_codestore (int i, int left)
-{
-  if (L->currState->varbuffer[i] != 0 ||  /* global or local var or */
-      left+i == 0) {  /* indexed var without values in between */
-    storevar(L->currState->varbuffer[i]);
-    return left;
-  }
-  else {  /* indexed var with values in between*/
-    code_oparg(SETTABLE, 0, left+i, -1);
-    return left+2;  /* table/index are not popped, since they are not on top */
-  }
-}
-
-
-static int fix_jump (int pc, OpCode op, int n)
-{
-  /* jump is relative to position following jump instruction */
-  return fix_opcode(pc, op, 0, n-(pc+JMPSIZE));
-}
-
-
-static void fix_upjmp (OpCode op, int pos)
-{
-  int delta = L->currState->pc+JMPSIZE - pos;  /* jump is relative */
-  if (delta > 255) delta++;
-  code_oparg(op, 0, delta, 0);
-}
-
-
-static void codeIf (int thenAdd, int elseAdd)
-{
-  int elseinit = elseAdd+JMPSIZE;
-  if (L->currState->pc == elseinit) {  /* no else part */
-    L->currState->pc -= JMPSIZE;
-    elseinit = L->currState->pc;
-  }
-  else
-    elseinit += fix_jump(elseAdd, JMP, L->currState->pc);
-  fix_jump(thenAdd, IFFJMP, elseinit);
-}
-
-
-static void code_shortcircuit (int pc, OpCode op)
-{
-  fix_jump(pc, op, L->currState->pc);
-}
-
-
-static void codereturn (void)
-{
-  code_oparg(RETCODE, 0, L->currState->nlocalvar, 0);
-  L->currState->stacksize = L->currState->nlocalvar;
-}
-
-
-static void func_onstack (TProtoFunc *f)
-{
-  int i;
-  int nupvalues = (L->currState+1)->nupvalues;
-  int c = next_constant(L->currState);
-  ttype(&L->currState->f->consts[c]) = LUA_T_PROTO;
-  L->currState->f->consts[c].value.tf = (L->currState+1)->f;
-  if (nupvalues == 0)
-    code_constant(c);
-  else {
-    for (i=0; i<nupvalues; i++)
-      lua_pushvar((L->currState+1)->upvalues[i]);
-    code_constant(c);
-    code_oparg(CLOSURE, 2, nupvalues, -nupvalues);
-  }
-}
-
-
-static void init_state (TaggedString *filename)
-{
-  TProtoFunc *f = luaF_newproto();
-  FuncState *fs = L->currState;
-  fs->stacksize = 0;
-  fs->maxstacksize = 0;
-  fs->nlocalvar = 0;
-  fs->nupvalues = 0;
-  fs->f = f;
-  f->fileName = filename;
-  fs->pc = 0;
-  fs->maxcode = 0;
-  f->code = NULL;
-  fs->maxconsts = 0;
-  if (lua_debug) {
-    fs->nvars = 0;
-    fs->maxvars = 0;
-  }
-  else
-    fs->maxvars = -1;  /* flag no debug information */
-  code_byte(0);  /* to be filled with stacksize */
-  code_byte(0);  /* to be filled with arg information */
-  L->lexstate->lastline = 0;  /* invalidate it */
-}
-
-
-static void init_func (void)
-{
-  if (L->currState-L->mainState >= MAXSTATES-1)
-    luaY_error("too many nested functions " MES_LIM(SMAXSTATES));
-  L->currState++;
-  init_state(L->mainState->f->fileName);
-  luaY_codedebugline(L->lexstate->linenumber);
-  L->currState->f->lineDefined = L->lexstate->linenumber;
-}
-
-static TProtoFunc *close_func (void)
-{
-  TProtoFunc *f = L->currState->f;
-  code_neutralop(ENDCODE);
-  f->code[0] = L->currState->maxstacksize;
-  f->code = luaM_reallocvector(f->code, L->currState->pc, Byte);
-  f->consts = luaM_reallocvector(f->consts, f->nconsts, TObject);
-  if (L->currState->maxvars != -1) {  /* debug information? */
-    luaI_registerlocalvar(NULL, -1);  /* flag end of vector */
-    f->locvars = luaM_reallocvector(f->locvars, L->currState->nvars, LocVar);
-  }
-  L->currState--;
-  return f;
-}
-
-
-/*
-** Parse Lua code.
-*/
-TProtoFunc *luaY_parser (ZIO *z)
-{
-  struct LexState lexstate;
-  FuncState state[MAXSTATES];
-  L->currState = L->mainState = &state[0];
-  L->lexstate = &lexstate;
-  luaX_setinput(z);
-  init_state(luaS_new(zname(z)));
-  if (luaY_parse()) lua_error("parse error");
-  return close_func();
-}
-
-
-%}
-
-
-%union
-{
-  int vInt;
-  real vReal;
-  char *pChar;
-  long vLong;
-  TaggedString *pTStr;
-  TProtoFunc *pFunc;
-}
-
-%start chunk
-
-%token WRONGTOKEN
-%token NIL
-%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
-%token RETURN
-%token LOCAL
-%token FUNCTION
-%token DOTS
-%token <vReal> NUMBER
-%token <pTStr>  NAME STRING
-
-%type <vInt> SaveWord, cond, GetPC, SaveWordPop, SaveWordPush
-%type <vLong> exprlist, exprlist1  /* if > 0, points to function return
-	counter (which has list length); if <= 0, -list lenght */
-%type <vLong> functioncall, expr, sexp  /* if != 0, points to function return
-					 counter */
-%type <vInt>  varlist1, funcParams, funcvalue
-%type <vInt>  fieldlist, localnamelist, decinit
-%type <vInt>  ffieldlist1, lfieldlist1, ffieldlist, lfieldlist, part
-%type <vLong> var, varname, funcname /* vardesc */
-
-
-%left AND OR
-%left EQ NE '>' '<' LE GE
-%left CONC
-%left '+' '-'
-%left '*' '/'
-%left UNARY NOT
-%right '^'
-
-
-%% /* beginning of rules section */
-
-
-chunk    : statlist ret ;
-
-statlist : /* empty */
-	 | statlist stat sc
-	 ;
-
-sc	 : /* empty */ | ';' ;
-
-stat   : IF cond THEN block SaveWord elsepart END { codeIf($2, $5); }
-
-       | DO block END
-
-       | WHILE GetPC cond DO block END
-       {{
-	 FuncState *fs = L->currState;
-         int expsize = $3-$2;
-	 int newpos = $2+JMPSIZE;
-	 check_pc(expsize);
-	 memcpy(fs->f->code+fs->pc, fs->f->code+$2, expsize);
-	 luaO_memdown(fs->f->code+$2, fs->f->code+$3, fs->pc-$2);
-	 newpos += fix_jump($2, JMP, fs->pc-expsize);
-	 fix_upjmp(IFTUPJMP, newpos);
-       }}
-
-       | REPEAT GetPC block UNTIL expr1
-       {
-	 fix_upjmp(IFFUPJMP, $2);
-	 deltastack(-1);  /* pops condition */
-       }
-
-       | varlist1 '=' exprlist1
-       {{
-	  int i;
-          int left = 0;
-	  adjust_mult_assign($1, $3);
-	  for (i=$1-1; i>=0; i--)
-	    left = lua_codestore(i, left);
-          adjuststack(left);  /* remove eventual 'garbage' left on stack */
-       }}
-
-       | functioncall { adjust_functioncall($1, 0); }
-
-       | LOCAL localnamelist decinit
-       {
-         L->currState->nlocalvar += $2;
-         adjust_mult_assign($2, $3);
-       }
-
-       | FUNCTION funcname body { storevar($2); }
-       ;
-
-block    : {$<vInt>$ = L->currState->nlocalvar;} chunk
-         {
-           adjuststack(L->currState->nlocalvar - $<vInt>1);
-	   for (; L->currState->nlocalvar > $<vInt>1; L->currState->nlocalvar--)
-	     luaI_unregisterlocalvar(L->lexstate->linenumber);
-         }
-         ;
-
-funcname : varname { $$ = $1; init_func(); }
-	|  fvarname '.' fname
-	{
-          $$ = 0;  /* flag indexed variable */
-	  init_func();
-	}
-	| fvarname ':' fname
-	{
-          $$ = 0;  /* flag indexed variable */
-	  init_func();
-	  add_localvar(luaS_new("self"));
-	}
-		;
-
-fvarname : varname { lua_pushvar($1); } ;
-
-fname	: NAME { code_string($1); } ;
-
-body :  '(' parlist ')' chunk END { func_onstack(close_func()); } ;
-
-elsepart : /* empty */
-	 | ELSE block
-         | ELSEIF cond THEN block SaveWord elsepart { codeIf($2, $5); }
-         ;
-
-ret	: /* empty */
-        | RETURN exprlist sc
-          {
-	   adjust_functioncall($2, MULT_RET);
-           codereturn();
-          }
-	;
-
-GetPC	: /* empty */ { $$ = L->currState->pc; } ;
-
-SaveWord : /* empty */
-	{ $$ = L->currState->pc;
-	  check_pc(JMPSIZE);
-	  L->currState->pc += JMPSIZE;  /* open space */
-	}
-	 ;
-
-SaveWordPop : SaveWord { $$ = $1; deltastack(-1);  /* pop condition */ } ;
-
-SaveWordPush : SaveWord { $$ = $1; deltastack(1);  /* push a value */ } ;
-
-cond	:	expr1 SaveWordPop  { $$ = $2; } ;
-
-expr1	 : expr { adjust_functioncall($1, 1); } ;
-				
-expr :  '(' expr ')'     { $$ = $2; }
-     |  expr1 EQ  expr1	 { code_binop(EQOP);   $$ = 0; }
-     |	expr1 '<' expr1	 { code_binop(LTOP);   $$ = 0; }
-     |	expr1 '>' expr1	 { code_binop(GTOP);   $$ = 0; }
-     |	expr1 NE  expr1	 { code_binop(NEQOP);  $$ = 0; }
-     |	expr1 LE  expr1	 { code_binop(LEOP);   $$ = 0; }
-     |	expr1 GE  expr1	 { code_binop(GEOP);   $$ = 0; }
-     |	expr1 '+' expr1  { code_binop(ADDOP);  $$ = 0; }
-     |	expr1 '-' expr1  { code_binop(SUBOP);  $$ = 0; }
-     |	expr1 '*' expr1  { code_binop(MULTOP); $$ = 0; }
-     |	expr1 '/' expr1  { code_binop(DIVOP);  $$ = 0; }
-     |	expr1 '^' expr1  { code_binop(POWOP);  $$ = 0; }
-     |	expr1 CONC expr1 { code_binop(CONCOP);  $$ = 0; }
-     |	'-' expr1 %prec UNARY	{ code_unop(MINUSOP); $$ = 0;}
-     |	NOT expr1	 { code_unop(NOTOP);  $$ = 0;}
-     |  sexp             { $$ = $1;  /* simple expressions */ }
-     |  table 		 { $$ = 0; }
-     |  NUMBER           { code_number($1); $$ = 0; }
-     |  STRING           { code_string($1); $$ = 0; }
-     |	NIL		 { adjuststack(-1); $$ = 0; }
-     |  FUNCTION { init_func(); } body { $$ = 0; }
-     |	expr1 AND SaveWordPop expr1 { code_shortcircuit($3, ONFJMP); $$ = 0; }
-     |	expr1 OR SaveWordPop expr1 { code_shortcircuit($3, ONTJMP); $$ = 0; }
-     ;
-
-sexp1	: sexp { adjust_functioncall($1, 1); } ;
-
-sexp	: var { lua_pushvar($1); $$ = 0; }
-	| '%' NAME { pushupvalue($2); $$ = 0; }
-	|  functioncall { $$ = $1; }
-	;
-
-var	  :	varname { $$ = $1; }
-	  |	sexp1 '[' expr1 ']' { $$ = 0; }  /* indexed variable */
-	  |	sexp1 '.' NAME { $$ = (-string_constant($3, L->currState))-1; }
-	  ;
-
-varname	  :	NAME { $$ = singlevar($1, L->currState); } ;
-
-table : '{' SaveWordPush fieldlist '}' { fix_opcode($2, CREATEARRAY, 2, $3); } ;
-
-functioncall : funcvalue funcParams
-	{
-	  code_byte(0);  /* save space for opcode */
-	  code_byte($1+$2);  /* number of parameters */
-	  $$ = L->currState->pc;
-	  code_byte(0);  /* must be adjusted by other rules */
-	}
-	     ;
-
-funcvalue    : sexp1 { $$ = 0; }
-	     | sexp1 ':' NAME
-	     {
-               code_oparg(PUSHSELF, 8, string_constant($3, L->currState), 1);
-               $$ = 1;
-	     }
-	     ;
-
-funcParams :	'(' exprlist ')' { $$ = adjust_functioncall($2, 1); }
-	|	table  { $$ = 1; }
-	|	STRING { code_string($1); $$ = 1; }
-	;
-
-exprlist  :	/* empty */		{ $$ = 0; }
-	  |	exprlist1		{ $$ = $1; }
-	  ;
-		
-exprlist1 :  expr	{ if ($1 != 0) $$ = $1; else $$ = -1; }
-	  |  exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr
-	{
-	  if ($4 == 0) $$ = -($<vLong>3 + 1);  /* -length */
-	  else {
-            L->currState->f->code[$4] = $<vLong>3;  /* store list length */
-	    $$ = $4;
-	  }
-	}
-	  ;
-
-parlist  :  /* empty */ { code_args(0, 0); }
-	  | DOTS { code_args(0, 1); }
-	  | localnamelist { code_args($1, 0); }
-	  | localnamelist ',' DOTS { code_args($1, 1); }
-	  ;
-		
-fieldlist :  part { $$ = abs($1); }
-	| part ';' part
-	{
-	  if ($1*$3 > 0)  /* repeated parts? */
-	    luaY_error("invalid constructor syntax");
-	  $$ = abs($1)+abs($3);
-	}
-	;
-
-part : /* empty */ { $$ = 0; }
-	| ffieldlist { $$ = $1; }
-	| lfieldlist { $$ = $1; }
-	;
-
-lastcomma : /* empty */ | ',' ;
-
-ffieldlist : ffieldlist1 lastcomma
-	{
-	  flush_record($1%RFIELDS_PER_FLUSH);
-	  $$ = -$1;  /* negative signals a "record" part */
-	}
-	;
-
-lfieldlist : lfieldlist1 lastcomma
-	{
-	  flush_list($1/LFIELDS_PER_FLUSH, $1%LFIELDS_PER_FLUSH);
-	  $$ = $1;
-	}
-	;
-
-ffieldlist1 : ffield			{$$=1;}
-	   | ffieldlist1 ',' ffield	
-		{
-		  $$=$1+1;
-		  if ($$%RFIELDS_PER_FLUSH == 0)
-	            flush_record(RFIELDS_PER_FLUSH);
-		}
-	   ;
-
-ffield      : ffieldkey '=' expr1 ;
-
-ffieldkey   : '[' expr1 ']'
-	    | fname
-	    ;
-
-lfieldlist1 : expr1  {$$=1;}
-	    | lfieldlist1 ',' expr1
-		{
-		  $$=$1+1;
-		  if ($$%LFIELDS_PER_FLUSH == 0)
-		    flush_list($$/LFIELDS_PER_FLUSH - 1, LFIELDS_PER_FLUSH);
-		}
-            ;
-
-varlist1  : var { $$ = 1; add_varbuffer($1, 0); }
-	  | varlist1 ',' var { add_varbuffer($3, $1); $$ = $1+1; }
-	  ;
-
-localnamelist : NAME {store_localvar($1, 0); $$ = 1;}
-	      | localnamelist ',' NAME { store_localvar($3, $1); $$ = $1+1; }
-	      ;
-
-decinit	  : /* empty */  { $$ = 0; }
-	  | '=' exprlist1 { $$ = $2; }
-	  ;
-
-%%
-

luadebug.h

@@ -1,6 +1,6 @@
 /*
-** $Id: $
-** Debuging API
+** $Id: luadebug.h,v 1.5 1999/02/04 17:47:59 roberto Exp roberto $
+** Debugging API
 ** See Copyright Notice in lua.h
 */
 
@@ -17,17 +17,18 @@ typedef void (*lua_LHFunction) (int line);
 typedef void (*lua_CHFunction) (lua_Function func, char *file, int line);
 
 lua_Function lua_stackedfunction (int level);
-void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
+void lua_funcinfo (lua_Object func, char **source, int *linedefined);
 int lua_currentline (lua_Function func);
 char *lua_getobjname (lua_Object o, char **name);
 
 lua_Object lua_getlocal (lua_Function func, int local_number, char **name);
 int lua_setlocal (lua_Function func, int local_number);
 
+int lua_nups (lua_Function func);
 
-extern lua_LHFunction lua_linehook;
-extern lua_CHFunction lua_callhook;
-extern int lua_debug;
+lua_LHFunction lua_setlinehook (lua_LHFunction func);
+lua_CHFunction lua_setcallhook (lua_CHFunction func);
+int lua_setdebug (int debug);
 
 
 #endif

lualib.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lualib.h,v 1.2 1997/11/26 18:53:45 roberto Exp roberto $
+** $Id: lualib.h,v 1.4 1998/06/19 16:14:09 roberto Exp roberto $
 ** Lua standard libraries
 ** See Copyright Notice in lua.h
 */
@@ -10,12 +10,13 @@
 
 #include "lua.h"
 
-
 void lua_iolibopen   (void);
 void lua_strlibopen  (void);
 void lua_mathlibopen (void);
+void lua_dblibopen   (void);
 
 
+void lua_userinit (void);
 
 
 /* To keep compatibility with old versions */
@@ -26,7 +27,7 @@ void lua_mathlibopen (void);
 
 
 
-/* auxiliar functions (private) */
+/* Auxiliary functions (private) */
 
 int luaI_singlematch (int c, char *p, char **ep);
 

lundump.c

@@ -1,272 +1,234 @@
 /*
-** $Id: lundump.c,v 1.4 1998/01/13 20:05:24 lhf Exp $
+** $Id: lundump.c,v 1.18 1999/04/09 03:10:40 lhf Exp lhf $
 ** load bytecodes from files
 ** See Copyright Notice in lua.h
 */
 
 #include <stdio.h>
+#include <string.h>
 #include "lauxlib.h"
 #include "lfunc.h"
 #include "lmem.h"
+#include "lopcodes.h"
 #include "lstring.h"
 #include "lundump.h"
 
-typedef struct {
- ZIO* Z;
- int SwapNumber;
- int LoadFloat;
-} Sundump;
+#define	LoadBlock(b,size,Z)	ezread(Z,b,size)
 
-static void unexpectedEOZ(ZIO* Z)
+#if LUAC_NATIVE
+	#define doLoadNumber(x,Z)	LoadBlock(&x,sizeof(x),Z)
+#else
+	#define doLoadNumber(x,Z)	x=LoadNumber(Z)
+#endif
+
+static void unexpectedEOZ (ZIO* Z)
 {
- luaL_verror("unexpected end of binary file %s",Z->name);
+ luaL_verror("unexpected end of file in %s",zname(Z));
 }
 
-static int ezgetc(ZIO* Z)
+static int ezgetc (ZIO* Z)
 {
  int c=zgetc(Z);
  if (c==EOZ) unexpectedEOZ(Z);
  return c;
 }
 
-static int ezread(ZIO* Z, void* b, int n)
+static void ezread (ZIO* Z, void* b, int n)
 {
  int r=zread(Z,b,n);
  if (r!=0) unexpectedEOZ(Z);
- return r;
 }
 
-static int LoadWord(ZIO* Z)
+static unsigned int LoadWord (ZIO* Z)
 {
- int hi=ezgetc(Z);
- int lo=ezgetc(Z);
+ unsigned int hi=ezgetc(Z);
+ unsigned int lo=ezgetc(Z);
  return (hi<<8)|lo;
 }
 
-static void* LoadBlock(int size, ZIO* Z)
+static unsigned long LoadLong (ZIO* Z)
 {
- void* b=luaM_malloc(size);
- ezread(Z,b,size);
+ unsigned long hi=LoadWord(Z);
+ unsigned long lo=LoadWord(Z);
+ return (hi<<16)|lo;
+}
+
+static real LoadNumber (ZIO* Z)
+{
+ char b[256];
+ int size=ezgetc(Z);
+ LoadBlock(b,size,Z);
+ b[size]=0;
+ if (b[0]=='-')
+  return -luaO_str2d(b+1);
+ else
+  return luaO_str2d(b);
+}
+
+static int LoadInt (ZIO* Z, char* message)
+{
+ unsigned long l=LoadLong(Z);
+ unsigned int i=l;
+ if (i!=l) luaL_verror(message,l,zname(Z));
+ return i;
+}
+
+#define PAD	5			/* two word operands plus opcode */
+
+static Byte* LoadCode (ZIO* Z)
+{
+ int size=LoadInt(Z,"code too long (%ld bytes) in %s");
+ Byte* b=luaM_malloc(size+PAD);
+ LoadBlock(b,size,Z);
+ if (b[size-1]!=ENDCODE) luaL_verror("bad code in %s",zname(Z));
+ memset(b+size,ENDCODE,PAD);		/* pad code for safety */
  return b;
 }
 
-static int LoadSize(ZIO* Z)
+static TaggedString* LoadTString (ZIO* Z)
 {
- int hi=LoadWord(Z);
- int lo=LoadWord(Z);
- int s=(hi<<16)|lo;
- if (hi!=0 && s==lo)
-  luaL_verror("code too long (%ld bytes)",(hi<<16)|(long)lo);
- return s;
-}
-
-static char* LoadString(ZIO* Z)
-{
- int size=LoadWord(Z);
+ long size=LoadLong(Z);
  if (size==0)
   return NULL;
  else
  {
-  char* b=luaL_openspace(size);
-  ezread(Z,b,size);
-  return b;
+  char* s=luaL_openspace(size);
+  LoadBlock(s,size,Z);
+  return luaS_newlstr(s,size-1);
  }
 }
 
-static TaggedString* LoadTString(ZIO* Z)
+static void LoadLocals (TProtoFunc* tf, ZIO* Z)
 {
- char* s=LoadString(Z);
- return (s==NULL) ? NULL : luaS_new(s);
-}
-
-static void SwapFloat(float* f)
-{
- Byte* p=(Byte*)f;
- Byte* q=p+sizeof(float)-1;
- Byte t;
- t=*p; *p++=*q; *q--=t;
- t=*p; *p++=*q; *q--=t;
-}
-
-static void SwapDouble(double* f)
-{
- Byte* p=(Byte*)f;
- Byte* q=p+sizeof(double)-1;
- Byte t;
- t=*p; *p++=*q; *q--=t;
- t=*p; *p++=*q; *q--=t;
- t=*p; *p++=*q; *q--=t;
- t=*p; *p++=*q; *q--=t;
-}
-
-static real LoadNumber(Sundump* S)
-{
- if (S->LoadFloat)
- {
-  float f;
-  ezread(S->Z,&f,sizeof(f));
-  if (S->SwapNumber) SwapFloat(&f);
-  return f;
- }
- else
- {
-  double f;
-  ezread(S->Z,&f,sizeof(f));
-  if (S->SwapNumber) SwapDouble(&f);
-  return f;
- }
-}
-
-static void LoadLocals(TProtoFunc* tf, ZIO* Z)
-{
- int i,n=LoadWord(Z);
+ int i,n=LoadInt(Z,"too many locals (%ld) in %s");
  if (n==0) return;
  tf->locvars=luaM_newvector(n+1,LocVar);
  for (i=0; i<n; i++)
  {
-  tf->locvars[i].line=LoadWord(Z);
+  tf->locvars[i].line=LoadInt(Z,"too many lines (%ld) in %s");
   tf->locvars[i].varname=LoadTString(Z);
  }
  tf->locvars[i].line=-1;		/* flag end of vector */
  tf->locvars[i].varname=NULL;
 }
 
-static void LoadConstants(TProtoFunc* tf, Sundump* S)
+static TProtoFunc* LoadFunction (ZIO* Z);
+
+static void LoadConstants (TProtoFunc* tf, ZIO* Z)
 {
- int i,n=LoadWord(S->Z);
+ int i,n=LoadInt(Z,"too many constants (%ld) in %s");
  tf->nconsts=n;
  if (n==0) return;
  tf->consts=luaM_newvector(n,TObject);
  for (i=0; i<n; i++)
  {
   TObject* o=tf->consts+i;
-  int c=ezgetc(S->Z);
-  switch (c)
+  ttype(o)=-ezgetc(Z);			/* ttype(o) is negative - ORDER LUA_T */
+  switch (ttype(o))
   {
-   case ID_NUM:
-	ttype(o)=LUA_T_NUMBER;
-	nvalue(o)=LoadNumber(S);
+   case LUA_T_NUMBER:
+	doLoadNumber(nvalue(o),Z);
 	break;
-   case ID_STR:
-	ttype(o)=LUA_T_STRING;	
-	tsvalue(o)=LoadTString(S->Z);
+   case LUA_T_STRING:
+	tsvalue(o)=LoadTString(Z);
 	break;
-   case ID_FUN:
-	ttype(o)=LUA_T_PROTO;
-	tfvalue(o)=NULL;
+   case LUA_T_PROTO:
+	tfvalue(o)=LoadFunction(Z);
+	break;
+   case LUA_T_NIL:
 	break;
-#ifdef DEBUG
    default:				/* cannot happen */
-	luaL_verror("internal error in LoadConstants: "
-		"bad constant #%d type=%d ('%c')\n",i,c,c);
+	luaU_badconstant("load",i,o,tf);
 	break;
-#endif
   }
  }
 }
 
-static TProtoFunc* LoadFunction(Sundump* S);
-
-static void LoadFunctions(TProtoFunc* tf, Sundump* S)
+static TProtoFunc* LoadFunction (ZIO* Z)
 {
- while (zgetc(S->Z)==ID_FUNCTION)
- {
-  int i=LoadWord(S->Z); 
-  TProtoFunc* t=LoadFunction(S);
-  TObject* o=tf->consts+i;
-  tfvalue(o)=t;
- }
-}
-
-static TProtoFunc* LoadFunction(Sundump* S)
-{
- ZIO* Z=S->Z;
  TProtoFunc* tf=luaF_newproto();
- tf->lineDefined=LoadWord(Z);
- tf->fileName=LoadTString(Z);
- tf->code=LoadBlock(LoadSize(Z),Z);
- LoadConstants(tf,S);
+ tf->lineDefined=LoadInt(Z,"lineDefined too large (%ld) in %s");
+ tf->source=LoadTString(Z);
+ if (tf->source==NULL) tf->source=luaS_new(zname(Z));
+ tf->code=LoadCode(Z);
  LoadLocals(tf,Z);
- LoadFunctions(tf,S);
+ LoadConstants(tf,Z);
  return tf;
 }
 
-static void LoadSignature(ZIO* Z)
+static void LoadSignature (ZIO* Z)
 {
  char* s=SIGNATURE;
  while (*s!=0 && ezgetc(Z)==*s)
   ++s;
- if (*s!=0) luaL_verror("bad signature in binary file %s",Z->name);
+ if (*s!=0) luaL_verror("bad signature in %s",zname(Z));
 }
 
-static void LoadHeader(Sundump* S)
+static void LoadHeader (ZIO* Z)
 {
- ZIO* Z=S->Z;
  int version,sizeofR;
  LoadSignature(Z);
  version=ezgetc(Z);
  if (version>VERSION)
   luaL_verror(
-	"binary file %s too new: version=0x%02x; expected at most 0x%02x",
-	Z->name,version,VERSION);
- if (version<0x31)			/* major change in 3.1 */
+	"%s too new: version=0x%02x; expected at most 0x%02x",
+	zname(Z),version,VERSION);
+ if (version<VERSION0)			/* check last major change */
   luaL_verror(
-	"binary file %s too old: version=0x%02x; expected at least 0x%02x",
-	Z->name,version,0x31);
- sizeofR=ezgetc(Z);			/* test float representation */
- if (sizeofR==sizeof(float))
- {
-  float f,tf=TEST_FLOAT;
-  ezread(Z,&f,sizeof(f));
-  if (f!=tf)
-  {
-   SwapFloat(&f);
-   if (f!=tf)
-    luaL_verror("unknown float representation in binary file %s",Z->name);
-   S->SwapNumber=1;
-  }
-  S->LoadFloat=1;
- }
- else if (sizeofR==sizeof(double))
- {
-  double f,tf=TEST_FLOAT;
-  ezread(Z,&f,sizeof(f));
-  if (f!=tf)
-  {
-   SwapDouble(&f);
-   if (f!=tf)
-    luaL_verror("unknown float representation in binary file %s",Z->name);
-   S->SwapNumber=1;
-  }
-  S->LoadFloat=0;
- }
+	"%s too old: version=0x%02x; expected at least 0x%02x",
+	zname(Z),version,VERSION0);
+ sizeofR=ezgetc(Z);			/* test number representation */
+#if LUAC_NATIVE
+ if (sizeofR==0)
+  luaL_verror("cannot read numbers in %s: "
+	"support for decimal format not enabled",
+	zname(Z));
+ if (sizeofR!=sizeof(real))
+  luaL_verror("unknown number size in %s: read %d; expected %d",
+	zname(Z),sizeofR,sizeof(real));
  else
-  luaL_verror(
-       "floats in binary file %s have %d bytes; "
-       "expected %d (float) or %d (double)",
-       Z->name,sizeofR,sizeof(float),sizeof(double));
+ {
+ real f=-TEST_NUMBER,tf=TEST_NUMBER;
+ doLoadNumber(f,Z);
+ if (f!=tf)
+  luaL_verror("unknown number representation in %s: "
+	"read " NUMBER_FMT "; expected " NUMBER_FMT,
+	zname(Z),f,tf);
+ }
+#else
+ if (sizeofR!=0)
+  luaL_verror("cannot read numbers in %s: "
+	"support for native format not enabled",
+	zname(Z));
+#endif
 }
 
-static TProtoFunc* LoadChunk(Sundump* S)
+static TProtoFunc* LoadChunk (ZIO* Z)
 {
- LoadHeader(S);
- return LoadFunction(S);
+ LoadHeader(Z);
+ return LoadFunction(Z);
 }
 
 /*
 ** load one chunk from a file or buffer
 ** return main if ok and NULL at EOF
 */
-TProtoFunc* luaU_undump1(ZIO* Z)
+TProtoFunc* luaU_undump1 (ZIO* Z)
 {
  int c=zgetc(Z);
- Sundump S;
- S.Z=Z;
- S.SwapNumber=0;
- S.LoadFloat=1;
  if (c==ID_CHUNK)
-  return LoadChunk(&S);
+  return LoadChunk(Z);
  else if (c!=EOZ)
-  luaL_verror("%s is not a lua binary file",Z->name);
+  luaL_verror("%s is not a Lua binary file",zname(Z));
  return NULL;
 }
+
+/*
+* handle constants that cannot happen
+*/
+void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf)
+{
+ int t=ttype(o);
+ char* name= (t>0 || t<LUA_T_LINE) ? "?" : luaO_typenames[-t];
+ luaL_verror("cannot %s constant #%d: type=%d [%s]" IN,s,i,t,name,INLOC);
+}

lundump.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lundump.h,v 1.4 1998/01/13 20:05:24 lhf Exp $
+** $Id: lundump.h,v 1.13 1999/03/29 16:16:18 lhf Exp lhf $
 ** load pre-compiled Lua chunks
 ** See Copyright Notice in lua.h
 */
@@ -10,18 +10,39 @@
 #include "lobject.h"
 #include "lzio.h"
 
-#define ID_CHUNK	27		/* ESC */
-#define ID_FUNCTION	'#'
-#define ID_END		'$'
-#define ID_NUM		'N'
-#define ID_STR		'S'
-#define ID_FUN		'F'
-#define	SIGNATURE	"Lua"
-#define	VERSION		0x31		/* last format change was in 3.1 */
-#define	TEST_FLOAT	0.123456789e-23	/* a float for testing representation */
+TProtoFunc* luaU_undump1 (ZIO* Z);	/* load one chunk */
+void luaU_badconstant (char* s, int i, TObject* o, TProtoFunc* tf);
+					/* handle cases that cannot happen */
 
-#define IsMain(f)	(f->lineDefined==0)
+/* definitions for headers of binary files */
+#define	VERSION		0x32		/* last format change was in 3.2 */
+#define	VERSION0	0x32		/* last major  change was in 3.2 */
+#define ID_CHUNK	27		/* binary files start with ESC... */
+#define	SIGNATURE	"Lua"		/* ...followed by this signature */
 
-TProtoFunc* luaU_undump1(ZIO* Z);	/* load one chunk */
+/* formats for error messages */
+#define SOURCE		"<%s:%d>"
+#define IN		" in %p " SOURCE
+#define INLOC		tf,tf->source->str,tf->lineDefined
+
+/* format for numbers in listings and error messages */
+#ifndef NUMBER_FMT
+#define NUMBER_FMT	"%.16g"		/* LUA_NUMBER */
+#endif
+
+/* LUA_NUMBER
+* by default, numbers are stored in precompiled chunks as decimal strings.
+* this is completely portable and fast enough for most applications.
+* if you want to use this default, do nothing.
+* if you want additional speed at the expense of portability, move the line
+* below out of this comment.
+#define LUAC_NATIVE
+*/
+
+#ifdef LUAC_NATIVE
+/* a multiple of PI for testing number representation */
+/* multiplying by 1E8 gives non-trivial integer values */
+#define	TEST_NUMBER	3.14159265358979323846E8
+#endif
 
 #endif

lvm.c

@@ -1,11 +1,14 @@
 /*
-** $Id: lvm.c,v 1.22 1998/01/12 13:35:37 roberto Exp roberto $
+** $Id: lvm.c,v 1.54 1999/03/10 14:09:45 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
 
 
+#include <ctype.h>
+#include <limits.h>
 #include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
 #include "lauxlib.h"
@@ -13,6 +16,7 @@
 #include "lfunc.h"
 #include "lgc.h"
 #include "lmem.h"
+#include "lobject.h"
 #include "lopcodes.h"
 #include "lstate.h"
 #include "lstring.h"
@@ -27,9 +31,7 @@
 #endif
 
 
-#define skip_word(pc)	(pc+=2)
-#define get_word(pc)	(*(pc)+(*((pc)+1)<<8))
-#define next_word(pc)   (pc+=2, get_word(pc-2))
+#define highbyte(x)	((x)<<8)
 
 
 /* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
@@ -37,44 +39,47 @@
 
 
 
-static TaggedString *strconc (char *l, char *r)
-{
-  size_t nl = strlen(l);
-  char *buffer = luaL_openspace(nl+strlen(r)+1);
-  strcpy(buffer, l);
-  strcpy(buffer+nl, r);
-  return luaS_new(buffer);
+static TaggedString *strconc (TaggedString *l, TaggedString *r) {
+  long nl = l->u.s.len;
+  long nr = r->u.s.len;
+  char *buffer = luaL_openspace(nl+nr);
+  memcpy(buffer, l->str, nl);
+  memcpy(buffer+nl, r->str, nr);
+  return luaS_newlstr(buffer, nl+nr);
 }
 
 
-int luaV_tonumber (TObject *obj)
-{  /* LUA_NUMBER */
-  double t;
-  char c;
+int luaV_tonumber (TObject *obj) {  /* LUA_NUMBER */
   if (ttype(obj) != LUA_T_STRING)
     return 1;
-  else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) {
-    nvalue(obj) = (real)t;
+  else {
+    double t;
+    char *e = svalue(obj);
+    int sig = 1;
+    while (isspace((unsigned char)*e)) e++;
+    if (*e == '-') {
+      e++;
+      sig = -1;
+    }
+    else if (*e == '+') e++;
+    /* no digit before or after decimal point? */
+    if (!isdigit((unsigned char)*e) && !isdigit((unsigned char)*(e+1)))
+      return 2;
+    t = luaO_str2d(e);
+    if (t<0) return 2;
+    nvalue(obj) = (real)t*sig;
     ttype(obj) = LUA_T_NUMBER;
     return 0;
   }
-  else
-    return 2;
 }
 
 
-int luaV_tostring (TObject *obj)
-{ /* LUA_NUMBER */
+int luaV_tostring (TObject *obj) {  /* LUA_NUMBER */
   if (ttype(obj) != LUA_T_NUMBER)
     return 1;
   else {
-    char s[60];
-    real f = nvalue(obj);
-    int i;
-    if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
-      sprintf (s, "%d", i);
-    else
-      sprintf (s, "%g", (double)nvalue(obj));
+    char s[32];  /* 16 digits, signal, point and \0  (+ some extra...) */
+    sprintf(s, "%.16g", (double)nvalue(obj));
     tsvalue(obj) = luaS_new(s);
     ttype(obj) = LUA_T_STRING;
     return 0;
@@ -82,8 +87,15 @@ int luaV_tostring (TObject *obj)
 }
 
 
-void luaV_closure (int nelems)
-{
+void luaV_setn (Hash *t, int val) {
+  TObject index, value;
+  ttype(&index) = LUA_T_STRING; tsvalue(&index) = luaS_new("n");
+  ttype(&value) = LUA_T_NUMBER; nvalue(&value) = val;
+  luaH_set(t, &index, &value);
+}
+
+
+void luaV_closure (int nelems) {
   if (nelems > 0) {
     struct Stack *S = &L->stack;
     Closure *c = luaF_newclosure(nelems);
@@ -100,94 +112,104 @@ void luaV_closure (int nelems)
 ** Function to index a table.
 ** Receives the table at top-2 and the index at top-1.
 */
-void luaV_gettable (void)
-{
-  struct Stack *S = &L->stack;
+void luaV_gettable (void) {
+  TObject *table = L->stack.top-2;
   TObject *im;
-  if (ttype(S->top-2) != LUA_T_ARRAY)  /* not a table, get "gettable" method */
-    im = luaT_getimbyObj(S->top-2, IM_GETTABLE);
+  if (ttype(table) != LUA_T_ARRAY) {  /* not a table, get gettable method */
+    im = luaT_getimbyObj(table, IM_GETTABLE);
+    if (ttype(im) == LUA_T_NIL)
+      lua_error("indexed expression not a table");
+  }
   else {  /* object is a table... */
-    int tg = (S->top-2)->value.a->htag;
+    int tg = table->value.a->htag;
     im = luaT_getim(tg, IM_GETTABLE);
     if (ttype(im) == LUA_T_NIL) {  /* and does not have a "gettable" method */
-      TObject *h = luaH_get(avalue(S->top-2), S->top-1);
-      if (h != NULL && ttype(h) != LUA_T_NIL) {
-        --S->top;
-        *(S->top-1) = *h;
+      TObject *h = luaH_get(avalue(table), table+1);
+      if (ttype(h) == LUA_T_NIL &&
+          (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)) {
+        /* result is nil and there is an "index" tag method */
+        luaD_callTM(im, 2, 1);  /* calls it */
       }
-      else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)
-        luaD_callTM(im, 2, 1);
       else {
-        --S->top;
-        ttype(S->top-1) = LUA_T_NIL;
+        L->stack.top--;
+        *table = *h;  /* "push" result into table position */
       }
       return;
     }
     /* else it has a "gettable" method, go through to next command */
   }
   /* object is not a table, or it has a "gettable" method */
-  if (ttype(im) != LUA_T_NIL)
-    luaD_callTM(im, 2, 1);
-  else
-    lua_error("indexed expression not a table");
+  luaD_callTM(im, 2, 1);
 }
 
 
 /*
-** Function to store indexed based on values at the stack.top
-** mode = 0: raw store (without internal methods)
-** mode = 1: normal store (with internal methods)
-** mode = 2: "deep L->stack.stack" store (with internal methods)
+** Receives table at *t, index at *(t+1) and value at top.
 */
-void luaV_settable (TObject *t, int mode)
-{
+void luaV_settable (TObject *t) {
   struct Stack *S = &L->stack;
-  TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE);
-  if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
-    TObject *h = luaH_set(avalue(t), t+1);
-    *h = *(S->top-1);
-    S->top -= (mode == 2) ? 1 : 3;
-  }
-  else {  /* object is not a table, and/or has a specific "settable" method */
-    if (im && ttype(im) != LUA_T_NIL) {
-      if (mode == 2) {
-        *(S->top+1) = *(L->stack.top-1);
-        *(S->top) = *(t+1);
-        *(S->top-1) = *t;
-        S->top += 2;  /* WARNING: caller must assure stack space */
-      }
-      luaD_callTM(im, 3, 0);
-    }
-    else
+  TObject *im;
+  if (ttype(t) != LUA_T_ARRAY) {  /* not a table, get "settable" method */
+    im = luaT_getimbyObj(t, IM_SETTABLE);
+    if (ttype(im) == LUA_T_NIL)
       lua_error("indexed expression not a table");
   }
+  else {  /* object is a table... */
+    im = luaT_getim(avalue(t)->htag, IM_SETTABLE);
+    if (ttype(im) == LUA_T_NIL) {  /* and does not have a "settable" method */
+      luaH_set(avalue(t), t+1, S->top-1);
+      S->top--;  /* pop value */
+      return;
+    }
+    /* else it has a "settable" method, go through to next command */
+  }
+  /* object is not a table, or it has a "settable" method */
+  /* prepare arguments and call the tag method */
+  *(S->top+1) = *(L->stack.top-1);
+  *(S->top) = *(t+1);
+  *(S->top-1) = *t;
+  S->top += 2;  /* WARNING: caller must assure stack space */
+  luaD_callTM(im, 3, 0);
 }
 
 
-void luaV_getglobal (TaggedString *ts)
-{
-  /* WARNING: caller must assure stack space */
-  TObject *value = &ts->u.globalval;
-  TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
-  if (ttype(im) == LUA_T_NIL) {  /* default behavior */
-    *L->stack.top++ = *value;
-  }
+void luaV_rawsettable (TObject *t) {
+  if (ttype(t) != LUA_T_ARRAY)
+    lua_error("indexed expression not a table");
   else {
     struct Stack *S = &L->stack;
-    ttype(S->top) = LUA_T_STRING;
-    tsvalue(S->top) = ts;
-    S->top++;
-    *S->top++ = *value;
-    luaD_callTM(im, 2, 1);
+    luaH_set(avalue(t), t+1, S->top-1);
+    S->top -= 3;
   }
 }
 
 
-void luaV_setglobal (TaggedString *ts)
-{
-  TObject *oldvalue = &ts->u.globalval;
+void luaV_getglobal (TaggedString *ts) {
+  /* WARNING: caller must assure stack space */
+  /* only userdata, tables and nil can have getglobal tag methods */
+  static char valid_getglobals[] = {1, 0, 0, 1, 0, 0, 1, 0};  /* ORDER LUA_T */
+  TObject *value = &ts->u.s.globalval;
+  if (valid_getglobals[-ttype(value)]) {
+    TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
+    if (ttype(im) != LUA_T_NIL) {  /* is there a tag method? */
+      struct Stack *S = &L->stack;
+      ttype(S->top) = LUA_T_STRING;
+      tsvalue(S->top) = ts;
+      S->top++;
+      *S->top++ = *value;
+      luaD_callTM(im, 2, 1);
+      return;
+    }
+    /* else no tag method: go through to default behavior */
+  }
+  *L->stack.top++ = *value;  /* default behavior */
+}
+
+
+void luaV_setglobal (TaggedString *ts) {
+  TObject *oldvalue = &ts->u.s.globalval;
   TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
-  if (ttype(im) == LUA_T_NIL)  /* default behavior */
+  if (ttype(im) == LUA_T_NIL)  /* is there a tag method? */
     luaS_rawsetglobal(ts, --L->stack.top);
   else {
     /* WARNING: caller must assure stack space */
@@ -224,17 +246,34 @@ static void call_arith (IMS event)
 }
 
 
-static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
-                        lua_Type ttype_great, IMS op)
+static int luaV_strcomp (char *l, long ll, char *r, long lr)
 {
+  for (;;) {
+    long temp = strcoll(l, r);
+    if (temp != 0) return temp;
+    /* strings are equal up to a '\0' */
+    temp = strlen(l);  /* index of first '\0' in both strings */
+    if (temp == ll)  /* l is finished? */
+      return (temp == lr) ? 0 : -1;  /* l is equal or smaller than r */
+    else if (temp == lr)  /* r is finished? */
+      return 1;  /* l is greater than r (because l is not finished) */
+    /* both strings longer than temp; go on comparing (after the '\0') */
+    temp++;
+    l += temp; ll -= temp; r += temp; lr -= temp;
+  }
+}
+
+void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,
+                      lua_Type ttype_great, IMS op) {
   struct Stack *S = &L->stack;
   TObject *l = S->top-2;
   TObject *r = S->top-1;
-  int result;
+  real result;
   if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
-    result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
+    result = nvalue(l)-nvalue(r);
   else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
-    result = strcoll(svalue(l), svalue(r));
+    result = luaV_strcomp(svalue(l), tsvalue(l)->u.s.len,
+                          svalue(r), tsvalue(r)->u.s.len);
   else {
     call_binTM(op, "unexpected type in comparison");
     return;
@@ -246,27 +285,16 @@ static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
 }
 
 
-void luaV_pack (StkId firstel, int nvararg, TObject *tab)
-{
+void luaV_pack (StkId firstel, int nvararg, TObject *tab) {
   TObject *firstelem = L->stack.stack+firstel;
   int i;
+  Hash *htab;
   if (nvararg < 0) nvararg = 0;
-  avalue(tab)  = luaH_new(nvararg+1);  /* +1 for field 'n' */
+  htab = avalue(tab) = luaH_new(nvararg+1);  /* +1 for field 'n' */
   ttype(tab) = LUA_T_ARRAY;
-  for (i=0; i<nvararg; i++) {
-    TObject index;
-    ttype(&index) = LUA_T_NUMBER;
-    nvalue(&index) = i+1;
-    *(luaH_set(avalue(tab), &index)) = *(firstelem+i);
-  }
-  /* store counter in field "n" */ {
-    TObject index, extra;
-    ttype(&index) = LUA_T_STRING;
-    tsvalue(&index) = luaS_new("n");
-    ttype(&extra) = LUA_T_NUMBER;
-    nvalue(&extra) = nvararg;
-    *(luaH_set(avalue(tab), &index)) = extra;
-  }
+  for (i=0; i<nvararg; i++)
+    luaH_setint(htab, i+1, firstelem+i);
+  luaV_setn(htab, nvararg);  /* store counter in field "n" */
 }
 
 
@@ -286,12 +314,11 @@ static void adjust_varargs (StkId first_extra_arg)
 ** [stack+base,top). Returns n such that the the results are between
 ** [stack+n,top).
 */
-StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
-{
+StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base) {
   struct Stack *S = &L->stack;  /* to optimize */
-  Byte *pc = tf->code;
+  register Byte *pc = tf->code;
   TObject *consts = tf->consts;
-  if (lua_callhook)
+  if (L->callhook)
     luaD_callHook(base, tf, 0);
   luaD_checkstack((*pc++)+EXTRA_STACK);
   if (*pc < ZEROVARARG)
@@ -300,86 +327,82 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
     luaC_checkGC();
     adjust_varargs(base+(*pc++)-ZEROVARARG);
   }
-  while (1) {
-    int aux;
-    switch ((OpCode)(aux = *pc++)) {
+  for (;;) {
+    register int aux = 0;
+    switchentry:
+    switch ((OpCode)*pc++) {
 
-      case PUSHNIL0:
-        ttype(S->top++) = LUA_T_NIL;
+      case ENDCODE:
+        S->top = S->stack + base;
+        goto ret;
+        
+      case RETCODE:
+        base += *pc++;
+        goto ret;
+
+      case CALL: aux = *pc++;
+        luaD_call((S->top-S->stack)-(*pc++), aux);
         break;
 
-      case PUSHNIL:
-        aux = *pc++;
+      case TAILCALL: aux = *pc++;
+        luaD_call((S->top-S->stack)-(*pc++), MULT_RET);
+        base += aux;
+        goto ret;
+
+      case PUSHNIL: aux = *pc++;
         do {
           ttype(S->top++) = LUA_T_NIL;
         } while (aux--);
         break;
 
-      case PUSHNUMBER:
-        aux = *pc++; goto pushnumber;
+      case POP: aux = *pc++;
+        S->top -= aux;
+        break;
 
-      case PUSHNUMBERW:
-        aux = next_word(pc); goto pushnumber;
-
-      case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
-        aux -= PUSHNUMBER0;
-      pushnumber:
+      case PUSHNUMBERW: aux += highbyte(*pc++);
+      case PUSHNUMBER:  aux += *pc++;
         ttype(S->top) = LUA_T_NUMBER;
         nvalue(S->top) = aux;
         S->top++;
         break;
 
-      case PUSHLOCAL:
-        aux = *pc++; goto pushlocal;
+      case PUSHNUMBERNEGW: aux += highbyte(*pc++);
+      case PUSHNUMBERNEG:  aux += *pc++;
+        ttype(S->top) = LUA_T_NUMBER;
+        nvalue(S->top) = -aux;
+        S->top++;
+        break;
 
-      case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
-      case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
-        aux -= PUSHLOCAL0;
-      pushlocal:
+      case PUSHCONSTANTW: aux += highbyte(*pc++);
+      case PUSHCONSTANT:  aux += *pc++;
+        *S->top++ = consts[aux];
+        break;
+
+      case PUSHUPVALUE: aux = *pc++;
+        *S->top++ = cl->consts[aux+1];
+        break;
+
+      case PUSHLOCAL: aux = *pc++;
         *S->top++ = *((S->stack+base) + aux);
         break;
 
-      case GETGLOBALW:
-        aux = next_word(pc); goto getglobal;
-
-      case GETGLOBAL:
-        aux = *pc++; goto getglobal;
-
-      case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3:
-      case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7:
-        aux -= GETGLOBAL0;
-      getglobal:
+      case GETGLOBALW: aux += highbyte(*pc++);
+      case GETGLOBAL:  aux += *pc++;
         luaV_getglobal(tsvalue(&consts[aux]));
         break;
 
       case GETTABLE:
-       luaV_gettable();
-       break;
+        luaV_gettable();
+        break;
 
-      case GETDOTTEDW:
-        aux = next_word(pc); goto getdotted;
-
-      case GETDOTTED:
-        aux = *pc++; goto getdotted;
-
-      case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3:
-      case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
-        aux -= GETDOTTED0;
-      getdotted:
+      case GETDOTTEDW: aux += highbyte(*pc++);
+      case GETDOTTED:  aux += *pc++;
         *S->top++ = consts[aux];
         luaV_gettable();
         break;
 
-      case PUSHSELFW:
-        aux = next_word(pc); goto pushself;
-
-      case PUSHSELF:
-        aux = *pc++; goto pushself;
-
-      case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3:
-      case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7:
-        aux -= PUSHSELF0;
-      pushself: {
+      case PUSHSELFW: aux += highbyte(*pc++);
+      case PUSHSELF:  aux += *pc++; {
         TObject receiver = *(S->top-1);
         *S->top++ = consts[aux];
         luaV_gettable();
@@ -387,141 +410,75 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
         break;
       }
 
-      case PUSHCONSTANTW:
-        aux = next_word(pc); goto pushconstant;
-
-      case PUSHCONSTANT:
-        aux = *pc++; goto pushconstant;
-
-      case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2:
-      case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5:
-      case PUSHCONSTANT6: case PUSHCONSTANT7:
-        aux -= PUSHCONSTANT0;
-      pushconstant:
-        *S->top++ = consts[aux];
-        break;
-
-      case PUSHUPVALUE:
-        aux = *pc++; goto pushupvalue;
-
-      case PUSHUPVALUE0: case PUSHUPVALUE1:
-        aux -= PUSHUPVALUE0;
-      pushupvalue:
-        *S->top++ = cl->consts[aux+1];
-        break;
-
-      case SETLOCAL:
-        aux = *pc++; goto setlocal;
-
-      case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3:
-      case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
-        aux -= SETLOCAL0;
-      setlocal:
-        *((S->stack+base) + aux) = *(--S->top);
-        break;
-
-      case SETGLOBALW:
-        aux = next_word(pc); goto setglobal;
-
-      case SETGLOBAL:
-        aux = *pc++; goto setglobal;
-
-      case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3:
-      case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7:
-        aux -= SETGLOBAL0;
-      setglobal:
-        luaV_setglobal(tsvalue(&consts[aux]));
-        break;
-
-      case SETTABLE0:
-       luaV_settable(S->top-3, 1);
-       break;
-
-      case SETTABLE:
-        luaV_settable(S->top-3-(*pc++), 2);
-        break;
-
-      case SETLISTW:
-        aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist;
-
-      case SETLIST:
-        aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist;
-
-      case SETLIST0:
-        aux = 0;
-      setlist: {
-        int n = *(pc++);
-        TObject *arr = S->top-n-1;
-        for (; n; n--) {
-          ttype(S->top) = LUA_T_NUMBER;
-          nvalue(S->top) = n+aux;
-          *(luaH_set(avalue(arr), S->top)) = *(S->top-1);
-          S->top--;
-        }
-        break;
-      }
-
-      case SETMAP0:
-        aux = 0; goto setmap;
-
-      case SETMAP:
-        aux = *pc++;
-      setmap: {
-        TObject *arr = S->top-(2*aux)-3;
-        do {
-          *(luaH_set(avalue(arr), S->top-2)) = *(S->top-1);
-          S->top-=2;
-        } while (aux--);
-        break;
-      }
-
-      case POP:
-        aux = *pc++; goto pop;
-
-      case POP0: case POP1:
-        aux -= POP0;
-      pop:
-        S->top -= (aux+1);
-        break;
-
-      case CREATEARRAYW:
-        aux = next_word(pc); goto createarray;
-
-      case CREATEARRAY0: case CREATEARRAY1:
-        aux -= CREATEARRAY0; goto createarray;
-
-      case CREATEARRAY:
-        aux = *pc++;
-      createarray:
+      case CREATEARRAYW: aux += highbyte(*pc++);
+      case CREATEARRAY:  aux += *pc++;
         luaC_checkGC();
         avalue(S->top) = luaH_new(aux);
         ttype(S->top) = LUA_T_ARRAY;
         S->top++;
         break;
 
-      case EQOP: case NEQOP: {
+      case SETLOCAL: aux = *pc++;
+        *((S->stack+base) + aux) = *(--S->top);
+        break;
+
+      case SETGLOBALW: aux += highbyte(*pc++);
+      case SETGLOBAL:  aux += *pc++;
+        luaV_setglobal(tsvalue(&consts[aux]));
+        break;
+
+      case SETTABLEPOP:
+        luaV_settable(S->top-3);
+        S->top -= 2;  /* pop table and index */
+        break;
+
+      case SETTABLE:
+        luaV_settable(S->top-3-(*pc++));
+        break;
+
+      case SETLISTW: aux += highbyte(*pc++);
+      case SETLIST:  aux += *pc++; {
+        int n = *(pc++);
+        TObject *arr = S->top-n-1;
+        aux *= LFIELDS_PER_FLUSH;
+        for (; n; n--)
+          luaH_setint(avalue(arr), n+aux, --S->top);
+        break;
+      }
+
+      case SETMAP:  aux = *pc++; {
+        TObject *arr = S->top-(2*aux)-3;
+        do {
+          luaH_set(avalue(arr), S->top-2, S->top-1);
+          S->top-=2;
+        } while (aux--);
+        break;
+      }
+
+      case NEQOP: aux = 1;
+      case EQOP: {
         int res = luaO_equalObj(S->top-2, S->top-1);
+        if (aux) res = !res;
         S->top--;
-        if (aux == NEQOP) res = !res;
         ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
         nvalue(S->top-1) = 1;
         break;
       }
 
        case LTOP:
-         comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
+         luaV_comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
          break;
 
       case LEOP:
-        comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
+        luaV_comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
         break;
 
       case GTOP:
-        comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
+        luaV_comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
         break;
 
       case GEOP:
-        comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
+        luaV_comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
         break;
 
       case ADDOP: {
@@ -573,7 +530,7 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
       }
 
       case POWOP:
-        call_arith(IM_POW);
+        call_binTM(IM_POW, "undefined operation");
         break;
 
       case CONCOP: {
@@ -582,7 +539,7 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
         if (tostring(l) || tostring(r))
           call_binTM(IM_CONCAT, "unexpected type for concatenation");
         else {
-          tsvalue(l) = strconc(svalue(l), svalue(r));
+          tsvalue(l) = strconc(tsvalue(l), tsvalue(r));
           --S->top;
         }
         luaC_checkGC();
@@ -605,97 +562,47 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
         nvalue(S->top-1) = 1;
         break;
 
-      case ONTJMPW:
-        aux = next_word(pc); goto ontjmp;
-
-      case ONTJMP:
-        aux = *pc++;
-      ontjmp:
+      case ONTJMPW: aux += highbyte(*pc++);
+      case ONTJMP:  aux += *pc++;
         if (ttype(S->top-1) != LUA_T_NIL) pc += aux;
         else S->top--;
         break;
 
-      case ONFJMPW:
-        aux = next_word(pc); goto onfjmp;
-
-      case ONFJMP:
-        aux = *pc++;
-      onfjmp:
+      case ONFJMPW: aux += highbyte(*pc++);
+      case ONFJMP:  aux += *pc++;
         if (ttype(S->top-1) == LUA_T_NIL) pc += aux;
         else S->top--;
         break;
 
-      case JMPW:
-        aux = next_word(pc); goto jmp;
-
-      case JMP:
-        aux = *pc++;
-      jmp:
+      case JMPW: aux += highbyte(*pc++);
+      case JMP:  aux += *pc++;
         pc += aux;
         break;
 
-      case IFFJMPW:
-        aux = next_word(pc); goto iffjmp;
-
-      case IFFJMP:
-        aux = *pc++;
-      iffjmp:
+      case IFFJMPW: aux += highbyte(*pc++);
+      case IFFJMP:  aux += *pc++;
         if (ttype(--S->top) == LUA_T_NIL) pc += aux;
         break;
 
-      case IFTUPJMPW:
-        aux = next_word(pc); goto iftupjmp;
-
-      case IFTUPJMP:
-        aux = *pc++;
-      iftupjmp:
+      case IFTUPJMPW: aux += highbyte(*pc++);
+      case IFTUPJMP:  aux += *pc++;
         if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
         break;
 
-      case IFFUPJMPW:
-        aux = next_word(pc); goto iffupjmp;
-
-      case IFFUPJMP:
-        aux = *pc++;
-      iffupjmp:
+      case IFFUPJMPW: aux += highbyte(*pc++);
+      case IFFUPJMP:  aux += *pc++;
         if (ttype(--S->top) == LUA_T_NIL) pc -= aux;
         break;
 
-      case CLOSURE:
-        aux = *pc++; goto closure;
-
-      case CLOSURE0: case CLOSURE1:
-        aux -= CLOSURE0;
-      closure:
-        luaV_closure(aux);
+      case CLOSUREW: aux += highbyte(*pc++);
+      case CLOSURE:  aux += *pc++;
+        *S->top++ = consts[aux];
+        luaV_closure(*pc++);
         luaC_checkGC();
         break;
 
-      case CALLFUNC:
-        aux = *pc++; goto callfunc;
-
-      case CALLFUNC0: case CALLFUNC1:
-        aux -= CALLFUNC0;
-      callfunc: {
-        StkId newBase = (S->top-S->stack)-(*pc++);
-        luaD_call(newBase, aux);
-        break;
-      }
-
-      case ENDCODE:
-        S->top = S->stack + base;
-        /* goes through */
-      case RETCODE:
-        if (lua_callhook)
-          luaD_callHook(base, NULL, 1);
-        return (base + ((aux==RETCODE) ? *pc : 0));
-
-      case SETLINEW:
-        aux = next_word(pc); goto setline;
-
-      case SETLINE:
-        aux = *pc++;
-      setline:
+      case SETLINEW: aux += highbyte(*pc++);
+      case SETLINE:  aux += *pc++;
         if ((S->stack+base-1)->ttype != LUA_T_LINE) {
           /* open space for LINE value */
           luaD_openstack((S->top-S->stack)-base);
@@ -703,15 +610,23 @@ StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
           (S->stack+base-1)->ttype = LUA_T_LINE;
         }
         (S->stack+base-1)->value.i = aux;
-        if (lua_linehook)
+        if (L->linehook)
           luaD_lineHook(aux);
         break;
 
-#ifdef DEBUG
-      default:
-        lua_error("internal error - opcode doesn't match");
-#endif
+      case LONGARGW: aux += highbyte(*pc++);
+      case LONGARG:  aux += *pc++;
+        aux = highbyte(highbyte(aux));
+        goto switchentry;  /* do not reset "aux" */
+
+      case CHECKSTACK: aux = *pc++;
+        LUA_ASSERT((S->top-S->stack)-base == aux, "wrong stack size");
+        break;
+
     }
-  }
+  } ret:
+  if (L->callhook)
+    luaD_callHook(0, NULL, 1);
+  return base;
 }
 

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.3 1997/10/16 10:59:34 roberto Exp roberto $
+** $Id: lvm.h,v 1.7 1998/12/30 17:26:49 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -10,6 +10,7 @@
 
 #include "ldo.h"
 #include "lobject.h"
+#include "ltm.h"
 
 
 #define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0))
@@ -19,11 +20,15 @@
 void luaV_pack (StkId firstel, int nvararg, TObject *tab);
 int luaV_tonumber (TObject *obj);
 int luaV_tostring (TObject *obj);
+void luaV_setn (Hash *t, int val);
 void luaV_gettable (void);
-void luaV_settable (TObject *t, int mode);
+void luaV_settable (TObject *t);
+void luaV_rawsettable (TObject *t);
 void luaV_getglobal (TaggedString *ts);
 void luaV_setglobal (TaggedString *ts);
 StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base);
 void luaV_closure (int nelems);
+void luaV_comparison (lua_Type ttype_less, lua_Type ttype_equal,
+                      lua_Type ttype_great, IMS op);
 
 #endif

lzio.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lzio.c,v 1.2 1997/11/21 19:00:46 roberto Exp roberto $
+** $Id: lzio.c,v 1.6 1999/03/04 14:49:18 roberto Exp roberto $
 ** a generic input stream interface
 ** See Copyright Notice in lua.h
 */
@@ -15,11 +15,11 @@
 
 /* ----------------------------------------------------- memory buffers --- */
 
-static int zmfilbuf (ZIO* z)
-{
+static int zmfilbuf (ZIO* z) {
  return EOZ;
 }
 
+
 ZIO* zmopen (ZIO* z, char* b, int size, char *name)
 {
  if (b==NULL) return NULL;
@@ -41,9 +41,10 @@ ZIO* zsopen (ZIO* z, char* s, char *name)
 
 /* -------------------------------------------------------------- FILEs --- */
 
-static int zffilbuf (ZIO* z)
-{
- int n=fread(z->buffer,1,ZBSIZE,z->u);
+static int zffilbuf (ZIO* z) {
+ int n;
+ if (feof((FILE *)z->u)) return EOZ;
+ n=fread(z->buffer,1,ZBSIZE,z->u);
  if (n==0) return EOZ;
  z->n=n-1;
  z->p=z->buffer;
@@ -64,16 +65,15 @@ ZIO* zFopen (ZIO* z, FILE* f, char *name)
 
 
 /* --------------------------------------------------------------- read --- */
-int zread (ZIO *z, void *b, int n)
-{
+int zread (ZIO *z, void *b, int n) {
   while (n) {
     int m;
     if (z->n == 0) {
       if (z->filbuf(z) == EOZ)
-        return n;  /* retorna quantos faltaram ler */
-      zungetc(z);  /* poe o resultado de filbuf no buffer */
+        return n;  /* return number of missing bytes */
+      zungetc(z);  /* put result from 'filbuf' in the buffer */
     }
-    m = (n <= z->n) ? n : z->n;  /* minimo de n e z->n */
+    m = (n <= z->n) ? n : z->n;  /* min. between n and z->n */
     memcpy(b, z->p, m);
     z->n -= m;
     z->p += m;

makefile

@@ -1,5 +1,5 @@
 #
-## $Id: makefile,v 1.9 1998/01/02 17:46:32 roberto Exp roberto $
+## $Id: makefile,v 1.18 1999/02/23 15:01:29 roberto Exp roberto $
 ## Makefile
 ## See Copyright Notice in lua.h
 #
@@ -12,11 +12,15 @@
 # define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
 #
 # define (undefine) OLD_ANSI if your system does NOT have some new ANSI
-#   facilities (e.g. strerror, locale.h, memmove). Although they are ANSI,
-#   SunOS does not comply; so, add "-DOLD_ANSI" on SunOS
+# facilities (e.g. strerror, locale.h, memmove). SunOS does not comply;
+# so, add "-DOLD_ANSI" on SunOS
 #
 # define LUA_COMPAT2_5 if yous system does need to be compatible with
 # version 2.5 (or older)
+#
+# define LUA_NUM_TYPE if you need numbers to be different from double
+# (for instance, -DLUA_NUM_TYPE=float)
+#
 
 CONFIG = -DPOPEN -D_POSIX_SOURCE
 #CONFIG = -DLUA_COMPAT2_5 -DOLD_ANSI -DDEBUG
@@ -28,6 +32,10 @@ CWARNS = -Wall -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-al
 CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2
 
 
+# To make early versions
+CO_OPTIONS =
+
+
 AR = ar
 ARFLAGS	= rvl
 
@@ -44,8 +52,8 @@ LUAOBJS = \
 	llex.o \
 	lmem.o \
 	lobject.o \
+	lparser.o \
 	lstate.o \
-	lstx.o \
 	lstring.o \
 	ltable.o \
 	ltm.o \
@@ -56,7 +64,9 @@ LUAOBJS = \
 LIBOBJS = 	\
 	liolib.o \
 	lmathlib.o \
-	lstrlib.o
+	lstrlib.o \
+	ldblib.o \
+	linit.o
 
 
 lua : lua.o liblua.a liblualib.a
@@ -73,53 +83,58 @@ liblualib.a : $(LIBOBJS)
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
-lstx.c lstx.h  : lua.stx
-	bison -o lstx.c -p luaY_ -d lua.stx
-#	yacc -d lua.stx
-#	sed -e 's/yy/luaY_/g' -e 's/malloc\.h/stdlib\.h/g' y.tab.c > lstx.c
-#	sed -e 's/yy/luaY_/g' y.tab.h > lstx.h
 
 clear	:
 	rcsclean
 	rm -f *.o
-	rm -f lstx.c lstx.h
-	co lua.h lualib.h luadebug.h
+	rm -f
+	co $(CO_OPTIONS) lua.h lualib.h luadebug.h
 
 
 %.h : RCS/%.h,v
-	co $@
+	co $(CO_OPTIONS) $@
 
 %.c : RCS/%.c,v
-	co $@
+	co $(CO_OPTIONS) $@
 
-lapi.o: lapi.c lapi.h lua.h lobject.h lauxlib.h ldo.h lstate.h lfunc.h \
- lgc.h lmem.h lstring.h ltable.h ltm.h luadebug.h lvm.h
+
+lapi.o: lapi.c lapi.h lua.h lobject.h lauxlib.h ldo.h lstate.h \
+ luadebug.h lfunc.h lgc.h lmem.h lstring.h ltable.h ltm.h lvm.h
 lauxlib.o: lauxlib.c lauxlib.h lua.h luadebug.h
-lbuffer.o: lbuffer.c lauxlib.h lua.h lmem.h lstate.h lobject.h
+lbuffer.o: lbuffer.c lauxlib.h lua.h lmem.h lstate.h lobject.h \
+ luadebug.h
 lbuiltin.o: lbuiltin.c lapi.h lua.h lobject.h lauxlib.h lbuiltin.h \
- ldo.h lstate.h lfunc.h lmem.h lstring.h ltable.h ltm.h
-ldo.o: ldo.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
- lparser.h lzio.h ltm.h luadebug.h lundump.h lvm.h
-lfunc.o: lfunc.c lfunc.h lobject.h lua.h lmem.h lstate.h
-lgc.o: lgc.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
- lstring.h ltable.h ltm.h
+ ldo.h lstate.h luadebug.h lfunc.h lmem.h lstring.h ltable.h ltm.h \
+ lundump.h lzio.h lvm.h
+ldblib.o: ldblib.c lauxlib.h lua.h luadebug.h lualib.h
+ldo.o: ldo.c ldo.h lobject.h lua.h lstate.h luadebug.h lfunc.h lgc.h \
+ lmem.h lparser.h lzio.h lstring.h ltm.h lundump.h lvm.h
+lfunc.o: lfunc.c lfunc.h lobject.h lua.h lmem.h lstate.h luadebug.h
+lgc.o: lgc.c ldo.h lobject.h lua.h lstate.h luadebug.h lfunc.h lgc.h \
+ lmem.h lstring.h ltable.h ltm.h
+linit.o: linit.c lua.h lualib.h
 liolib.o: liolib.c lauxlib.h lua.h luadebug.h lualib.h
 llex.o: llex.c lauxlib.h lua.h llex.h lobject.h lzio.h lmem.h \
- lparser.h lstate.h lstring.h lstx.h luadebug.h
+ lparser.h lstate.h luadebug.h lstring.h
 lmathlib.o: lmathlib.c lauxlib.h lua.h lualib.h
-lmem.o: lmem.c lmem.h lstate.h lobject.h lua.h
+lmem.o: lmem.c lmem.h lstate.h lobject.h lua.h luadebug.h
 lobject.o: lobject.c lobject.h lua.h
-lstate.o: lstate.c lbuiltin.h ldo.h lobject.h lua.h lstate.h lfunc.h \
- lgc.h llex.h lzio.h lmem.h lstring.h ltable.h ltm.h
-lstring.o: lstring.c lmem.h lobject.h lua.h lstate.h lstring.h
+lparser.o: lparser.c lauxlib.h lua.h ldo.h lobject.h lstate.h \
+ luadebug.h lfunc.h llex.h lzio.h lmem.h lopcodes.h lparser.h \
+ lstring.h
+lstate.o: lstate.c lbuiltin.h ldo.h lobject.h lua.h lstate.h \
+ luadebug.h lfunc.h lgc.h llex.h lzio.h lmem.h lstring.h ltable.h \
+ ltm.h
+lstring.o: lstring.c lmem.h lobject.h lua.h lstate.h luadebug.h \
+ lstring.h
 lstrlib.o: lstrlib.c lauxlib.h lua.h lualib.h
-lstx.o: lstx.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h llex.h \
- lzio.h lmem.h lopcodes.h lparser.h lstring.h luadebug.h
-ltable.o: ltable.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltable.h
-ltm.o: ltm.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltm.h lapi.h
+ltable.o: ltable.c lauxlib.h lua.h lmem.h lobject.h lstate.h \
+ luadebug.h ltable.h
+ltm.o: ltm.c lauxlib.h lua.h lmem.h lobject.h lstate.h luadebug.h \
+ ltm.h
 lua.o: lua.c lua.h luadebug.h lualib.h
 lundump.o: lundump.c lauxlib.h lua.h lfunc.h lobject.h lmem.h \
  lstring.h lundump.h lzio.h
-lvm.o: lvm.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h lgc.h \
- lmem.h lopcodes.h lstring.h ltable.h ltm.h luadebug.h lvm.h
+lvm.o: lvm.c lauxlib.h lua.h ldo.h lobject.h lstate.h luadebug.h \
+ lfunc.h lgc.h lmem.h lopcodes.h lstring.h ltable.h ltm.h lvm.h
 lzio.o: lzio.c lzio.h