for security reasons, one cannot change the tag of a udata

from Lua.

auxlib.c

@@ -0,0 +1,81 @@
+char *rcs_auxlib="$Id: auxlib.c,v 1.4 1997/04/07 14:48:53 roberto Exp roberto $";
+
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+
+#include "lua.h"
+#include "auxlib.h"
+#include "luadebug.h"
+
+
+
+int luaI_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_arg_check(int cond, int numarg, char *extramsg)
+{
+  if (!cond) {
+    char *funcname;
+    lua_getobjname(lua_stackedfunction(0), &funcname);
+    if (funcname == NULL)
+      funcname = "???";
+    if (extramsg == NULL)
+      luaL_verror("bad argument #%d to function `%s'", numarg, funcname);
+    else
+      luaL_verror("bad argument #%d to function `%s' (%s)",
+                      numarg, funcname, extramsg);
+  }
+}
+
+char *luaL_check_string (int numArg)
+{
+  lua_Object o = lua_getparam(numArg);
+  luaL_arg_check(lua_isstring(o), numArg, "string expected");
+  return lua_getstring(o);
+}
+
+char *luaL_opt_string (int numArg, char *def)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              luaL_check_string(numArg);
+}
+
+double luaL_check_number (int numArg)
+{
+  lua_Object o = lua_getparam(numArg);
+  luaL_arg_check(lua_isnumber(o), numArg, "number expected");
+  return lua_getnumber(o);
+}
+
+
+double luaL_opt_number (int numArg, double def)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              luaL_check_number(numArg);
+}
+
+void luaL_openlib (struct luaL_reg *l, int n)
+{
+  int i;
+  for (i=0; i<n; i++)
+    lua_register(l[i].name, l[i].func);
+}
+
+
+void luaL_verror (char *fmt, ...)
+{
+  char buff[1000];
+  va_list argp;
+  va_start(argp, fmt);
+  vsprintf(buff, fmt, argp);
+  va_end(argp);
+  lua_error(buff);
+}

auxlib.h

@@ -0,0 +1,30 @@
+/*
+** $Id: auxlib.h,v 1.2 1997/04/06 14:08:08 roberto Exp roberto $
+*/
+
+#ifndef auxlib_h
+#define auxlib_h
+
+#include "lua.h"
+
+struct luaL_reg {
+  char *name;
+  lua_CFunction func;
+};
+
+void luaL_openlib (struct luaL_reg *l, int n);
+void luaL_arg_check(int cond, int numarg, char *extramsg);
+char *luaL_check_string (int numArg);
+char *luaL_opt_string (int numArg, char *def);
+double luaL_check_number (int numArg);
+double luaL_opt_number (int numArg, double def);
+void luaL_verror (char *fmt, ...);
+
+
+
+/* -- private part (only for Lua modules */
+
+int luaI_findstring (char *name, char *list[]);
+
+
+#endif

fallback.c

@@ -3,130 +3,37 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.24 1996/04/22 18:00:37 roberto Exp roberto $";
+char *rcs_fallback="$Id: fallback.c,v 2.8 1997/06/17 17:27:07 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
  
-#include "mem.h"
+#include "auxlib.h"
+#include "luamem.h"
 #include "fallback.h"
 #include "opcode.h"
 #include "lua.h"
 #include "table.h"
+#include "tree.h"
+#include "hash.h"
 
 
-static void errorFB (void);
-static void indexFB (void);
-static void gettableFB (void);
-static void arithFB (void);
-static void concatFB (void);
-static void orderFB (void);
-static void GDFB (void);
-static void funcFB (void);
 
-
-/*
-** Warning: This list must be in the same order as the #define's
-*/
-struct FB  luaI_fallBacks[] = {
-{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0},
-{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
-{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
-{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
-{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
-{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
-{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
-{"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
-{"function", {LUA_T_CFUNCTION, {funcFB}}, -1, -1},
-                                /* no fixed number of params or results */
-{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1}
-                                /* same default behavior of index FB */
-};
-
-#define N_FB  (sizeof(luaI_fallBacks)/sizeof(struct FB))
-
-void luaI_setfallback (void)
-{
-  int i;
-  char *name = lua_getstring(lua_getparam(1));
-  lua_Object func = lua_getparam(2);
-  if (name == NULL || !lua_isfunction(func))
-    lua_error("incorrect argument to function `setfallback'");
-  for (i=0; i<N_FB; i++)
-  {
-    if (strcmp(luaI_fallBacks[i].kind, name) == 0)
-    {
-      luaI_pushobject(&luaI_fallBacks[i].function);
-      luaI_fallBacks[i].function = *luaI_Address(func);
-      return;
-    }
-  }
-  /* name not found */
-  lua_error("incorrect argument to function `setfallback'");
-}
-
-
-static void errorFB (void)
-{
-  lua_Object o = lua_getparam(1);
-  if (lua_isstring(o))
-    fprintf (stderr, "lua: %s\n", lua_getstring(o));
-  else
-    fprintf(stderr, "lua: unknown error\n");
-}
- 
-
-static void indexFB (void)
-{
-  lua_pushnil();
-}
- 
-
-static void gettableFB (void)
-{
-  lua_error("indexed expression not a table");
-}
- 
-
-static void arithFB (void)
-{
-  lua_error("unexpected type at conversion to number");
-}
-
-static void concatFB (void)
-{
-  lua_error("unexpected type at conversion to string");
-}
-
-
-static void orderFB (void)
-{
-  lua_error("unexpected type at comparison");
-}
-
-static void GDFB (void) { }
-
-static void funcFB (void)
-{
-  lua_error("call expression not a function");
-}
-
-
-/*
+/* -------------------------------------------
 ** Reference routines
 */
 
 static struct ref {
-  Object o;
+  TObject o;
   enum {LOCK, HOLD, FREE, COLLECTED} status;
 } *refArray = NULL;
 static int refSize = 0;
 
-int luaI_ref (Object *object, int lock)
+int luaI_ref (TObject *object, int lock)
 {
   int i;
   int oldSize;
-  if (tag(object) == LUA_T_NIL)
+  if (ttype(object) == LUA_T_NIL)
     return -1;   /* special ref for nil */
   for (i=0; i<refSize; i++)
     if (refArray[i].status == FREE)
@@ -151,9 +58,9 @@ void lua_unref (int ref)
 }
 
 
-Object *luaI_getref (int ref)
+TObject *luaI_getref (int ref)
 {
-  static Object nul = {LUA_T_NIL, {0}};
+  static TObject nul = {LUA_T_NIL, {0}};
   if (ref == -1)
     return &nul;
   if (ref >= 0 && ref < refSize &&
@@ -164,7 +71,7 @@ Object *luaI_getref (int ref)
 }
 
 
-void luaI_travlock (int (*fn)(Object *))
+void luaI_travlock (int (*fn)(TObject *))
 {
   int i;
   for (i=0; i<refSize; i++)
@@ -181,11 +88,281 @@ void luaI_invalidaterefs (void)
       refArray[i].status = COLLECTED;
 }
 
-char *luaI_travfallbacks (int (*fn)(Object *))
+
+/* -------------------------------------------
+* Internal Methods 
+*/
+
+char *luaI_eventname[] = {  /* ORDER IM */
+  "gettable", "settable", "index", "getglobal", "setglobal", "add",
+  "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
+  "concat", "gc", "function",
+  NULL
+};
+
+
+
+static int luaI_checkevent (char *name, char *list[])
+{
+  int e = luaI_findstring(name, list);
+  if (e < 0)
+    luaL_verror("`%s' is not a valid event name", name);
+  return e;
+}
+
+
+struct IM *luaI_IMtable = NULL;
+
+static int IMtable_size = 0;
+static int last_tag = LUA_T_NIL;  /* ORDER LUA_T */
+
+
+/* events in LUA_T_LINE are all allowed, since this is used as a
+*  'placeholder' for "default" fallbacks
+*/
+static char validevents[NUM_TYPES][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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_LINE */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* LUA_T_CMARK */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* LUA_T_MARK */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CFUNCTION */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_FUNCTION */
+{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_ARRAY */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_NUMBER */
+{1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}   /* LUA_T_NIL */
+};
+
+static int validevent (lua_Type t, int e)
+{ /* ORDER LUA_T */
+  return (t < LUA_T_NIL) ?  1 : validevents[-t][e];
+}
+
+
+static void init_entry (int tag)
 {
   int i;
-  for (i=0; i<N_FB; i++)
-    if (fn(&luaI_fallBacks[i].function))
-      return luaI_fallBacks[i].kind;
+  for (i=0; i<IM_N; i++)
+    ttype(luaI_getim(tag, i)) = LUA_T_NIL;
+}
+
+void luaI_initfallbacks (void)
+{
+  if (luaI_IMtable == NULL) {
+    int i;
+    IMtable_size = NUM_TYPES+10;
+    luaI_IMtable = newvector(IMtable_size, struct IM);
+    for (i=LUA_T_NIL; i<=LUA_T_USERDATA; i++)
+      init_entry(i);
+  }
+}
+
+int lua_newtag (void)
+{
+  --last_tag;
+  if ((-last_tag) >= IMtable_size) {
+    luaI_initfallbacks();
+    IMtable_size = growvector(&luaI_IMtable, IMtable_size,
+                              struct IM, memEM, MAX_INT);
+  }
+  init_entry(last_tag);
+  return last_tag;
+}
+
+
+static void checktag (int tag)
+{
+  if (!(last_tag <= tag && tag <= 0))
+    luaL_verror("%d is not a valid tag", tag);
+}
+
+void luaI_realtag (int tag)
+{
+  if (!(last_tag <= tag && tag < LUA_T_NIL))
+    luaL_verror("tag %d is not result of `newtag'", tag);
+}
+
+
+void luaI_settag (int tag, TObject *o)
+{
+  luaI_realtag(tag);
+  switch (ttype(o)) {
+    case LUA_T_ARRAY:
+      o->value.a->htag = tag;
+      break;
+    case LUA_T_USERDATA:
+      o->value.ts->tag = tag;
+      break;
+    default:
+      luaL_verror("cannot change the tag of a %s", luaI_typenames[-ttype(o)]);
+  }
+}
+
+
+int luaI_efectivetag (TObject *o)
+{
+  lua_Type t = ttype(o);
+  if (t == LUA_T_USERDATA) {
+    int tag = o->value.ts->tag;
+    return (tag >= 0) ? LUA_T_USERDATA : tag;
+  }
+  else if (t == LUA_T_ARRAY)
+    return o->value.a->htag;
+  else return t;
+}
+
+
+void luaI_gettagmethod (void)
+{
+  int t = (int)luaL_check_number(1);
+  int e = luaI_checkevent(luaL_check_string(2), luaI_eventname);
+  checktag(t);
+  if (validevent(t, e))
+    luaI_pushobject(luaI_getim(t,e));
+}
+
+
+void luaI_settagmethod (void)
+{
+  int t = (int)luaL_check_number(1);
+  int e = luaI_checkevent(luaL_check_string(2), luaI_eventname);
+  lua_Object func = lua_getparam(3);
+  checktag(t);
+  if (!validevent(t, e))
+    luaL_verror("cannot change internal method `%s' for tag %d",
+                luaI_eventname[e], t);
+  luaL_arg_check(lua_isnil(func) || lua_isfunction(func),
+                 3, "function expected");
+  luaI_pushobject(luaI_getim(t,e));
+  *luaI_getim(t, e) = *luaI_Address(func);
+}
+
+
+static void stderrorim (void)
+{
+  lua_Object s = lua_getparam(1);
+  if (lua_isstring(s))
+    fprintf(stderr, "lua: %s\n", lua_getstring(s));
+}
+
+static TObject errorim = {LUA_T_CFUNCTION, {stderrorim}};
+
+
+TObject *luaI_geterrorim (void)
+{
+  return &errorim;
+}
+
+void luaI_seterrormethod (void)
+{
+  lua_Object func = lua_getparam(1);
+  luaL_arg_check(lua_isnil(func) || lua_isfunction(func),
+                 1, "function expected");
+  luaI_pushobject(&errorim);
+  errorim = *luaI_Address(func);
+}
+
+char *luaI_travfallbacks (int (*fn)(TObject *))
+{
+  int e;
+  if (fn(&errorim))
+    return "error";
+  for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {  /* ORDER IM */
+    int t;
+    for (t=0; t>=last_tag; t--)
+      if (fn(luaI_getim(t,e)))
+        return luaI_eventname[e];
+  }
   return NULL;
 }
+
+
+/*
+* ===================================================================
+* compatibility with old fallback system
+*/
+#if	LUA_COMPAT2_5
+
+static void errorFB (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isstring(o))
+    fprintf (stderr, "lua: %s\n", lua_getstring(o));
+  else
+    fprintf(stderr, "lua: unknown error\n");
+}
+ 
+
+static void nilFB (void) { }
+ 
+
+static void typeFB (void)
+{
+  lua_error("unexpected type");
+}
+
+
+static void fillvalids (IMS e, TObject *func)
+{
+  int t;
+  for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
+    if (validevent(t, e))
+      *luaI_getim(t, e) = *func;
+}
+
+
+void luaI_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);
+  luaI_initfallbacks();
+  luaL_arg_check(lua_isfunction(func), 2, "function expected");
+  switch (luaI_findstring(name, oldnames)) {
+    case 0:  /* old error fallback */
+      oldfunc = errorim;
+      errorim = *luaI_Address(func);
+      replace = errorFB;
+      break;
+    case 1:  /* old getglobal fallback */
+      oldfunc = *luaI_getim(LUA_T_NIL, IM_GETGLOBAL);
+      *luaI_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaI_Address(func);
+      replace = nilFB;
+      break;
+    case 2: {  /* old arith fallback */
+      int i;
+      oldfunc = *luaI_getim(LUA_T_NUMBER, IM_POW);
+      for (i=IM_ADD; i<=IM_UNM; i++)  /* ORDER IM */
+        fillvalids(i, luaI_Address(func));
+      replace = typeFB;
+      break;
+    }
+    case 3: {  /* old order fallback */
+      int i;
+      oldfunc = *luaI_getim(LUA_T_LINE, IM_LT);
+      for (i=IM_LT; i<=IM_GE; i++)  /* ORDER IM */
+        fillvalids(i, luaI_Address(func));
+      replace = typeFB;
+      break;
+    }
+    default: {
+      int e;
+      if ((e = luaI_findstring(name, luaI_eventname)) >= 0) {
+        oldfunc = *luaI_getim(LUA_T_LINE, e);
+        fillvalids(e, luaI_Address(func));
+        replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
+      }
+      else {
+        luaL_verror("`%s' is not a valid fallback name", name);
+        replace = NULL;  /* to avoid warnings */
+      }
+    }
+  }
+  if (oldfunc.ttype != LUA_T_NIL)
+    luaI_pushobject(&oldfunc);
+  else
+    lua_pushcfunction(replace);
+}
+#endif 

fallback.h

@@ -1,5 +1,5 @@
 /*
-** $Id: fallback.h,v 1.12 1996/04/22 18:00:37 roberto Exp roberto $
+** $Id: fallback.h,v 1.22 1997/04/04 22:24:51 roberto Exp roberto $
 */
  
 #ifndef fallback_h
@@ -8,30 +8,58 @@
 #include "lua.h"
 #include "opcode.h"
 
-extern struct FB {
-  char *kind;
-  Object function;
-  int nParams;
-  int nResults;
-} luaI_fallBacks[];
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER IM"
+*/
+typedef enum {
+  IM_GETTABLE = 0,
+  IM_SETTABLE,
+  IM_INDEX,
+  IM_GETGLOBAL,
+  IM_SETGLOBAL,
+  IM_ADD,
+  IM_SUB,
+  IM_MUL,
+  IM_DIV,
+  IM_POW,
+  IM_UNM,
+  IM_LT,
+  IM_LE,
+  IM_GT,
+  IM_GE,
+  IM_CONCAT,
+  IM_GC,
+  IM_FUNCTION
+} IMS;
 
-#define FB_ERROR  0
-#define FB_INDEX  1
-#define FB_GETTABLE  2
-#define FB_ARITH  3
-#define FB_ORDER  4
-#define FB_CONCAT  5
-#define FB_SETTABLE  6
-#define FB_GC 7
-#define FB_FUNCTION 8
-#define FB_GETGLOBAL 9
+#define IM_N 18
+
+
+extern struct IM {
+  TObject int_method[IM_N];
+} *luaI_IMtable;
+
+extern char *luaI_eventname[];
+
+#define luaI_getim(tag,event) (&luaI_IMtable[-(tag)].int_method[event])
+#define luaI_getimbyObj(o,e)  (luaI_getim(luaI_efectivetag(o),(e)))
 
 void luaI_setfallback (void);
-int luaI_ref (Object *object, int lock);
-Object *luaI_getref (int ref);
-void luaI_travlock (int (*fn)(Object *));
+int luaI_ref (TObject *object, int lock);
+TObject *luaI_getref (int ref);
+void luaI_travlock (int (*fn)(TObject *));
 void luaI_invalidaterefs (void);
-char *luaI_travfallbacks (int (*fn)(Object *));
+char *luaI_travfallbacks (int (*fn)(TObject *));
+
+void luaI_settag (int tag, TObject *o);
+void luaI_realtag (int tag);
+TObject *luaI_geterrorim (void);
+int luaI_efectivetag (TObject *o);
+void luaI_settagmethod (void);
+void luaI_gettagmethod (void);
+void luaI_seterrormethod (void);
+void luaI_initfallbacks (void);
 
 #endif
 

func.c

@@ -2,9 +2,10 @@
 
 #include "luadebug.h"
 #include "table.h"
-#include "mem.h"
+#include "luamem.h"
 #include "func.h"
 #include "opcode.h"
+#include "inout.h"
 
 
 static TFunc *function_root = NULL;
@@ -23,7 +24,7 @@ void luaI_initTFunc (TFunc *f)
   f->size = 0;
   f->code = NULL;
   f->lineDefined = 0;
-  f->fileName = NULL;
+  f->fileName = lua_parsedfile;
   f->locvars = NULL;
 }
 
@@ -49,47 +50,56 @@ void luaI_freefunc (TFunc *f)
   luaI_free (f);
 }
 
+
+void luaI_funcfree (TFunc *l)
+{
+  while (l) {
+    TFunc *next = l->next;
+    luaI_freefunc(l);
+    l = next;
+  }
+}
+
 /*
 ** Garbage collection function.
-** This function traverse the function list freeing unindexed functions
 */
-Long luaI_funccollector (void)
+TFunc *luaI_funccollector (long *acum)
 {
   TFunc *curr = function_root;
   TFunc *prev = NULL;
-  Long counter = 0;
-  while (curr)
-  {
+  TFunc *frees = NULL;
+  long counter = 0;
+  while (curr) {
     TFunc *next = curr->next;
-    if (!curr->marked)
-    {
+    if (!curr->marked) {
       if (prev == NULL)
         function_root = next;
       else
         prev->next = next;
-      luaI_freefunc (curr);
+      curr->next = frees;
+      frees = curr;
       ++counter;
     }
-    else
-    {
+    else {
       curr->marked = 0;
       prev = curr;
     } 
     curr = next;
   }
-  return counter;
+  *acum += counter;
+  return frees;
 }
 
 
 void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
 {
-  Object *f = luaI_Address(func);
-  if (f->tag == LUA_T_MARK || f->tag == LUA_T_FUNCTION)
+  TObject *f = luaI_Address(func);
+  if (f->ttype == LUA_T_MARK || f->ttype == LUA_T_FUNCTION)
   {
     *filename = f->value.tf->fileName;
     *linedefined = f->value.tf->lineDefined;
   }
-  else if (f->tag == LUA_T_CMARK || f->tag == LUA_T_CFUNCTION)
+  else if (f->ttype == LUA_T_CMARK || f->ttype == LUA_T_CFUNCTION)
   {
     *filename = "(C)";
     *linedefined = -1;

func.h

@@ -1,5 +1,5 @@
 /*
-** $Id: func.h,v 1.7 1996/03/08 12:04:04 roberto Exp roberto $
+** $Id: func.h,v 1.8 1996/03/14 15:54:20 roberto Exp roberto $
 */
 
 #ifndef func_h
@@ -30,7 +30,8 @@ typedef struct TFunc
   LocVar        *locvars;
 } TFunc;
 
-Long luaI_funccollector (void);
+TFunc *luaI_funccollector (long *cont);
+void luaI_funcfree (TFunc *l);
 void luaI_insertfunction (TFunc *f);
 
 void luaI_initTFunc (TFunc *f);

hash.c

@@ -3,14 +3,15 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.31 1996/07/12 20:00:26 roberto Exp roberto $";
+char *rcs_hash="$Id: hash.c,v 2.42 1997/05/08 20:43:30 roberto Exp roberto $";
 
 
-#include "mem.h"
+#include "luamem.h"
 #include "opcode.h"
 #include "hash.h"
 #include "table.h"
 #include "lua.h"
+#include "auxlib.h"
 
 
 #define nhash(t)	((t)->nhash)
@@ -24,13 +25,15 @@ char *rcs_hash="$Id: hash.c,v 2.31 1996/07/12 20:00:26 roberto Exp roberto $";
 
 #define REHASH_LIMIT    0.70    /* avoid more than this % full */
 
+#define TagDefault LUA_T_ARRAY;
+
 
 static Hash *listhead = NULL;
 
 
 /* hash dimensions values */
 static Long dimensions[] = 
- {3L, 5L, 7L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
+ {5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
   12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
   1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
 
@@ -46,16 +49,32 @@ int luaI_redimension (int nhash)
  return 0;  /* to avoid warnings */
 }
 
-static int hashindex (Hash *t, Object *ref)		/* hash function */
+
+int lua_equalObj (TObject *t1, TObject *t2)
+{
+  if (ttype(t1) != ttype(t2)) return 0;
+  switch (ttype(t1))
+  {
+    case LUA_T_NIL: return 1;
+    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
+    case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
+    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
+    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
+    case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
+    default:
+     lua_error("internal error in `lua_equalObj'");
+     return 0; /* UNREACHEABLE */
+  }
+}
+
+
+static long int hashindex (TObject *ref)
 {
   long int h;
-  switch (tag(ref)) {
-    case LUA_T_NIL:
-      lua_error ("unexpected type to index table");
-      h = 0;  /* UNREACHEABLE */
+  switch (ttype(ref)) {
     case LUA_T_NUMBER:
       h = (long int)nvalue(ref); break;
-    case LUA_T_STRING:
+    case LUA_T_STRING: case LUA_T_USERDATA:
       h = tsvalue(ref)->hash; break;
     case LUA_T_FUNCTION:
       h = (IntPoint)ref->value.tf; break;
@@ -63,38 +82,29 @@ static int hashindex (Hash *t, Object *ref)		/* hash function */
       h = (IntPoint)fvalue(ref); break;
     case LUA_T_ARRAY:
       h = (IntPoint)avalue(ref); break;
-    default:  /* user data */
-      h = (IntPoint)uvalue(ref); break;
+    default:
+      lua_error ("unexpected type to index table");
+      h = 0;  /* UNREACHEABLE */
   }
   if (h < 0) h = -h;
-  return h%nhash(t);  /* make it a valid index */
+  return h;
 }
 
-int lua_equalObj (Object *t1, Object *t2)
+
+static int present (Hash *t, TObject *key)
 {
-  if (tag(t1) != tag(t2)) return 0;
-  switch (tag(t1))
-  {
-    case LUA_T_NIL: return 1;
-    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
-    case LUA_T_STRING: return svalue(t1) == svalue(t2);
-    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
-    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
-    case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
-    default: return uvalue(t1) == uvalue(t2);
+  long int h = hashindex(key);
+  int tsize = nhash(t);
+  int h1 = h%tsize;
+  TObject *rf = ref(node(t, h1));
+  if (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf)) {
+    int h2 = h%(tsize-2) + 1;
+    do {
+      h1 = (h1+h2)%tsize;
+      rf = ref(node(t, h1));
+    } while (ttype(rf) != LUA_T_NIL && !lua_equalObj(key, rf));
   }
-}
-
-static int present (Hash *t, Object *ref)
-{ 
- int h = hashindex(t, ref);
- while (tag(ref(node(t, h))) != LUA_T_NIL)
- {
-  if (lua_equalObj(ref, ref(node(t, h))))
-    return h;
-  h = (h+1) % nhash(t);
- }
- return h;
+  return h1;
 }
 
 
@@ -106,7 +116,7 @@ static Node *hashnodecreate (int nhash)
  int i;
  Node *v = newvector (nhash, Node);
  for (i=0; i<nhash; i++)
-   tag(ref(&v[i])) = LUA_T_NIL;
+   ttype(ref(&v[i])) = LUA_T_NIL;
  return v;
 }
 
@@ -121,6 +131,7 @@ static Hash *hashcreate (int nhash)
  nhash(t) = nhash;
  nuse(t) = 0;
  markarray(t) = 0;
+ t->htag = TagDefault;
  return t;
 }
 
@@ -146,7 +157,7 @@ void lua_hashmark (Hash *h)
   for (i=0; i<nhash(h); i++)
   {
    Node *n = node(h,i);
-   if (tag(ref(n)) != LUA_T_NIL)
+   if (ttype(ref(n)) != LUA_T_NIL)
    {
     lua_markobject(&n->ref);
     lua_markobject(&n->val);
@@ -156,49 +167,50 @@ void lua_hashmark (Hash *h)
 }
 
 
-static void call_fallbacks (void)
+void luaI_hashcallIM (Hash *l)
 {
-  Hash *curr_array;
-  Object t;
-  tag(&t) = LUA_T_ARRAY;
-  for (curr_array = listhead; curr_array; curr_array = curr_array->next)
-    if (markarray(curr_array) != 1)
-    {
-      avalue(&t) = curr_array;
-      luaI_gcFB(&t);
-    }
-  tag(&t) = LUA_T_NIL;
-  luaI_gcFB(&t);  /* end of list */
+  TObject t;
+  ttype(&t) = LUA_T_ARRAY;
+  for (; l; l=l->next) {
+    avalue(&t) = l;
+    luaI_gcIM(&t);
+  }
+}
+
+
+void luaI_hashfree (Hash *frees)
+{
+  while (frees) {
+    Hash *next = frees->next;
+    hashdelete(frees);
+    frees = next;
+  }
 }
 
  
-/*
-** Garbage collection to arrays
-** Delete all unmarked arrays.
-*/
-Long lua_hashcollector (void)
+Hash *luaI_hashcollector (long *acum)
 {
- Hash *curr_array = listhead, *prev = NULL;
- Long counter = 0;
- call_fallbacks();
- while (curr_array != NULL)
- {
-  Hash *next = curr_array->next;
-  if (markarray(curr_array) != 1)
-  {
-   if (prev == NULL) listhead = next;
-   else              prev->next = next;
-   hashdelete(curr_array);
-   ++counter;
+  Hash *curr_array = listhead, *prev = NULL, *frees = NULL;
+  long counter = 0;
+  while (curr_array != NULL) {
+    Hash *next = curr_array->next;
+    if (markarray(curr_array) != 1) {
+      if (prev == NULL)
+        listhead = next;
+      else
+        prev->next = next;
+      curr_array->next = frees;
+      frees = curr_array;
+      ++counter;
+    }
+    else {
+      markarray(curr_array) = 0;
+      prev = curr_array;
+    }
+    curr_array = next;
   }
-  else
-  {
-   markarray(curr_array) = 0;
-   prev = curr_array;
-  }
-  curr_array = next;
- }
- return counter;
+  *acum += counter;
+  return frees;
 }
 
 
@@ -220,32 +232,45 @@ Hash *lua_createarray (int nhash)
 
 
 /*
-** Re-hash
+** 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)
+{
+  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;
+  }
+  return 0;
+}
+
 static void rehash (Hash *t)
 {
- int i;
- int   nold = nhash(t);
- Node *vold = nodevector(t);
- nhash(t) = luaI_redimension(nhash(t));
- nodevector(t) = hashnodecreate(nhash(t));
- for (i=0; i<nold; i++)
- {
-  Node *n = vold+i;
-  if (tag(ref(n)) != LUA_T_NIL && tag(val(n)) != LUA_T_NIL)
-   *node(t, present(t, ref(n))) = *n;  /* copy old node to new hahs */
- }
- luaI_free(vold);
+  int   nold = nhash(t);
+  Node *vold = nodevector(t);
+  int i;
+  if (!emptyslots(t))
+    nhash(t) = luaI_redimension(nhash(t));
+  nodevector(t) = hashnodecreate(nhash(t));
+  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 new hash */
+  }
+  luaI_free(vold);
 }
 
 /*
 ** If the hash node is present, return its pointer, otherwise return
 ** null.
 */
-Object *lua_hashget (Hash *t, Object *ref)
+TObject *lua_hashget (Hash *t, TObject *ref)
 {
  int h = present(t, ref);
- if (tag(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
  else return NULL;
 }
 
@@ -254,25 +279,19 @@ Object *lua_hashget (Hash *t, Object *ref)
 ** If the hash node is present, return its pointer, otherwise create a new
 ** node for the given reference and also return its pointer.
 */
-Object *lua_hashdefine (Hash *t, Object *ref)
+TObject *lua_hashdefine (Hash *t, TObject *ref)
 {
- int   h;
- Node *n;
- h = present(t, ref);
- n = node(t, h);
- if (tag(ref(n)) == LUA_T_NIL)
- {
-  nuse(t)++;
-  if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT)
-  {
-   rehash(t);
-   h = present(t, ref);
-   n = node(t, h);
+  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;
   }
-  *ref(n) = *ref;
-  tag(val(n)) = LUA_T_NIL;
- }
- return (val(n));
+  return (val(n));
 }
 
 
@@ -284,36 +303,30 @@ Object *lua_hashdefine (Hash *t, Object *ref)
 */
 static void hashnext (Hash *t, int i)
 {
- if (i >= nhash(t))
-  return;
- while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
- {
-  if (++i >= nhash(t))
-   return;
- }
- luaI_pushobject(ref(node(t,i)));
- luaI_pushobject(val(node(t,i)));
+  Node *n;
+  int tsize = nhash(t);
+  if (i >= tsize)
+    return;
+  n = node(t, i);
+  while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
+    if (++i >= tsize)
+      return;
+    n = node(t, i);
+  }
+  luaI_pushobject(ref(node(t,i)));
+  luaI_pushobject(val(node(t,i)));
 }
 
 void lua_next (void)
 {
- Hash   *t;
- lua_Object o = lua_getparam(1);
- lua_Object r = lua_getparam(2);
- if (o == LUA_NOOBJECT || r == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `next'");
- if (lua_getparam(3) != LUA_NOOBJECT)
-   lua_error ("too many arguments to function `next'");
- if (!lua_istable(o))
-   lua_error ("first argument of function `next' is not a table");
- t = avalue(luaI_Address(o));
- if (lua_isnil(r))
- {
-  hashnext(t, 0);
- }
- else
- {
-  int h = present (t, luaI_Address(r));
-  hashnext(t, h+1);
- }
+  Hash *t;
+  lua_Object o = lua_getparam(1);
+  lua_Object r = lua_getparam(2);
+  luaL_arg_check(lua_istable(o), 1, "table expected");
+  luaL_arg_check(r != LUA_NOOBJECT, 2, "value expected");
+  t = avalue(luaI_Address(o));
+  if (lua_isnil(r))
+    hashnext(t, 0);
+  else
+    hashnext(t, present(t, luaI_Address(r))+1);
 }

hash.h

@@ -1,7 +1,7 @@
 /*
 ** hash.h
 ** hash manager for lua
-** $Id: hash.h,v 2.11 1996/03/08 12:04:04 roberto Exp roberto $
+** $Id: hash.h,v 2.15 1997/03/31 14:02:58 roberto Exp roberto $
 */
 
 #ifndef hash_h
@@ -10,29 +10,30 @@
 #include "types.h"
 #include "opcode.h"
 
-typedef struct node
-{
- Object ref;
- Object val;
+typedef struct node {
+ TObject ref;
+ TObject val;
 } Node;
 
-typedef struct Hash
-{
- struct Hash   *next;
- Node          *node;
- int           nhash;
- int            nuse;
- char           mark;
+typedef struct Hash {
+  struct Hash *next;
+  Node *node;
+  int nhash;
+  int nuse;
+  int htag;
+  char mark;
 } Hash;
 
 
-int      lua_equalObj (Object *t1, Object *t2);
+int      lua_equalObj (TObject *t1, TObject *t2);
 int      luaI_redimension (int nhash);
 Hash    *lua_createarray (int nhash);
 void     lua_hashmark (Hash *h);
-Long     lua_hashcollector (void);
-Object  *lua_hashget (Hash *t, Object *ref);
-Object 	*lua_hashdefine (Hash *t, Object *ref);
+Hash    *luaI_hashcollector (long *count);
+void luaI_hashcallIM (Hash *l);
+void luaI_hashfree (Hash *frees);
+TObject  *lua_hashget (Hash *t, TObject *ref);
+TObject 	*lua_hashdefine (Hash *t, TObject *ref);
 void     lua_next (void);
 
 #endif

inout.c

@@ -5,18 +5,24 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.42 1996/09/24 21:46:44 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.68 1997/06/26 20:47:43 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
 
-#include "lex.h"
-#include "opcode.h"
+#include "auxlib.h"
+#include "fallback.h"
+#include "hash.h"
 #include "inout.h"
+#include "lex.h"
+#include "lua.h"
+#include "luamem.h"
+#include "luamem.h"
+#include "opcode.h"
 #include "table.h"
 #include "tree.h"
-#include "lua.h"
-#include "mem.h"
+#include "undump.h"
+#include "zio.h"
 
 
 /* Exported variables */
@@ -24,92 +30,93 @@ Word lua_linenumber;
 char *lua_parsedfile;
 
 
-static FILE *fp;
-static char *st;
+char *luaI_typenames[] = { /* ORDER LUA_T */
+  "userdata", "line", "cmark", "mark", "function",
+  "function", "table", "string", "number", "nil",
+  NULL
+};
 
-/*
-** Function to get the next character from the input file
-*/
-static int fileinput (void)
-{
-  int c = fgetc(fp);
-  return (c == EOF) ? 0 : c;
-}
 
-/*
-** Function to get the next character from the input string
-*/
-static int stringinput (void)
-{
- return *st++;
-}
 
-/*
-** Function to open a file to be input unit. 
-** Return the file.
-*/
-FILE *lua_openfile (char *fn)
-{
- lua_setinput (fileinput);
- if (fn == NULL)
- {
-   fp = stdin;
-   fn = "(stdin)";
- }
- else
-   fp = fopen (fn, "r");
- if (fp == NULL)
-   return NULL;
- lua_parsedfile = luaI_createfixedstring(fn)->str;
- return fp;
-}
-
-/*
-** Function to close an opened file
-*/
-void lua_closefile (void)
-{
- if (fp != NULL && fp != stdin)
- {
-  fclose (fp);
-  fp = NULL;
- }
-}
-
-/*
-** Function to open a string to be input unit
-*/
-#define SIZE_PREF 20  /* size of string prefix to appear in error messages */
-void lua_openstring (char *s)
-{
-  char buff[SIZE_PREF+25];
-  lua_setinput(stringinput);
-  st = s;
-  strcpy(buff, "(dostring) >> ");
-  strncat(buff, s, SIZE_PREF);
-  if (strlen(s) > SIZE_PREF) strcat(buff, "...");
-  lua_parsedfile = luaI_createfixedstring(buff)->str;
-}
-
-/*
-** Function to close an opened string
-*/
-void lua_closestring (void)
+void luaI_setparsedfile (char *name)
 {
+  lua_parsedfile = luaI_createfixedstring(name)->str;
 }
 
 
-static void check_arg (int cond, char *func)
+int lua_doFILE (FILE *f, int bin)
 {
-  if (!cond)
-  {
-    char buff[100];
-    sprintf(buff, "incorrect argument to function `%s'", func);
-    lua_error(buff);
+  ZIO z;
+  luaZ_Fopen(&z, f);
+  if (bin)
+    return luaI_undump(&z);
+  else {
+    lua_setinput(&z);
+    return lua_domain();
   }
+}                      
+
+
+int lua_dofile (char *filename)
+{
+  int status;
+  int c;
+  FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
+  if (f == NULL)
+    return 2;
+  luaI_setparsedfile(filename?filename:"(stdin)");
+  c = fgetc(f);
+  ungetc(c, f);
+  if (c == ID_CHUNK) {
+    f = freopen(filename, "rb", f);  /* set binary mode */
+    status = lua_doFILE(f, 1);
+  }
+  else {
+    if (c == '#')
+      while ((c=fgetc(f)) != '\n') /* skip first line */;
+    status = lua_doFILE(f, 0);
+  }
+  if (f != stdin)
+    fclose(f);
+  return status;
+}                      
+
+
+
+#define SIZE_PREF 20  /* size of string prefix to appear in error messages */
+
+
+int lua_dobuffer (char *buff, int size)
+{
+  int status;
+  ZIO z;
+  luaI_setparsedfile("(buffer)");
+  luaZ_mopen(&z, buff, size);
+  status = luaI_undump(&z);
+  return status;
 }
 
 
+int lua_dostring (char *str)
+{
+  int status;
+  char buff[SIZE_PREF+25];
+  char *temp;
+  ZIO z;
+  if (str == NULL) return 1;
+  sprintf(buff, "(dostring) >> %.20s", str);
+  temp = strchr(buff, '\n');
+  if (temp) *temp = 0;  /* end string after first line */
+  luaI_setparsedfile(buff);
+  luaZ_sopen(&z, str);
+  lua_setinput(&z);
+  status = lua_domain();
+  return status;
+}
+
+
+
+
 static int passresults (void)
 {
   int arg = 0;
@@ -118,30 +125,53 @@ static int passresults (void)
     lua_pushobject(obj);
   return arg-1;
 }
+
+
+static void packresults (void)
+{
+  int arg = 0;
+  lua_Object obj;
+  lua_Object table = lua_createtable();
+  while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT) {
+    lua_pushobject(table);
+    lua_pushnumber(arg);
+    lua_pushobject(obj);
+    lua_rawsettable();
+  }
+  lua_pushobject(table);
+  lua_pushstring("n");
+  lua_pushnumber(arg-1);
+  lua_rawsettable();
+  lua_pushobject(table);  /* final result */
+}
  
 /*
 ** Internal function: do a string
 */
-void lua_internaldostring (void)
+static void lua_internaldostring (void)
 {
-  lua_Object obj = lua_getparam (1);
-  if (lua_isstring(obj) && lua_dostring(lua_getstring(obj)) == 0)
+  lua_Object err = lua_getparam(2);
+  if (err != LUA_NOOBJECT) {  /* set new error method */
+    luaL_arg_check(lua_isnil(err) || lua_isfunction(err), 2,
+                   "must be a valid error handler");
+    lua_pushobject(err);
+    err = lua_seterrormethod();
+  }
+  if (lua_dostring(luaL_check_string(1)) == 0)
     if (passresults() == 0)
       lua_pushuserdata(NULL);  /* at least one result to signal no errors */
+  if (err != LUA_NOOBJECT) {  /* restore old error method */
+    lua_pushobject(err);
+    lua_seterrormethod();
+  }
 }
 
 /*
 ** Internal function: do a file
 */
-void lua_internaldofile (void)
+static void lua_internaldofile (void)
 {
- lua_Object obj = lua_getparam (1);
- char *fname = NULL;
- if (lua_isstring(obj))
-   fname = lua_getstring(obj);
- else if (obj != LUA_NOOBJECT)
-   lua_error("invalid argument to function `dofile'");
- /* else fname = NULL */
+ char *fname = luaL_opt_string(1, NULL);
  if (lua_dofile(fname) == 0)
     if (passresults() == 0)
       lua_pushuserdata(NULL);  /* at least one result to signal no errors */
@@ -150,36 +180,28 @@ void lua_internaldofile (void)
 
 static char *tostring (lua_Object obj)
 {
-  char *buff = luaI_buffer(20);
-  if (lua_isstring(obj))   /* get strings and numbers */
-    return lua_getstring(obj);
-  else switch(lua_type(obj))
-  {
-    case LUA_T_FUNCTION:
-      sprintf(buff, "function: %p", (luaI_Address(obj))->value.tf);
-      break;
-    case LUA_T_CFUNCTION:
-      sprintf(buff, "cfunction: %p", lua_getcfunction(obj));
-      break;
-    case LUA_T_ARRAY:
-      sprintf(buff, "table: %p", avalue(luaI_Address(obj)));
-      break;
-    case LUA_T_NIL:
-      sprintf(buff, "nil");
-      break;
-    default:
-      sprintf(buff, "userdata: %p", lua_getuserdata(obj));
-      break;
+  TObject *o = luaI_Address(obj);
+  switch (ttype(o)) {
+    case LUA_T_NUMBER:  case LUA_T_STRING:
+      return lua_getstring(obj);
+    case LUA_T_ARRAY: case LUA_T_FUNCTION:
+    case LUA_T_CFUNCTION: case LUA_T_NIL:
+      return luaI_typenames[-ttype(o)];
+    case LUA_T_USERDATA: {
+      char *buff = luaI_buffer(30);
+      sprintf(buff, "userdata: %p", o->value.ts->u.v);
+      return buff;
+    }
+    default: return "<unknown object>";
   }
-  return buff;
 }
 
-void luaI_tostring (void)
+static void luaI_tostring (void)
 {
   lua_pushstring(tostring(lua_getparam(1)));
 }
 
-void luaI_print (void)
+static void luaI_print (void)
 {
   int i = 1;
   lua_Object obj;
@@ -187,45 +209,18 @@ void luaI_print (void)
     printf("%s\n", tostring(obj));
 }
 
-/*
-** Internal function: return an object type.
-*/
-void luaI_type (void)
+static void luaI_type (void)
 {
   lua_Object o = lua_getparam(1);
-  int t;
-  if (o == LUA_NOOBJECT)
-    lua_error("no parameter to function 'type'");
-  t = lua_type(o);
-  switch (t)
-  {
-    case LUA_T_NIL :
-      lua_pushliteral("nil");
-      break;
-    case LUA_T_NUMBER :
-      lua_pushliteral("number");
-      break;
-    case LUA_T_STRING :
-      lua_pushliteral("string");
-      break;
-    case LUA_T_ARRAY :
-      lua_pushliteral("table");
-      break;
-    case LUA_T_FUNCTION :
-    case LUA_T_CFUNCTION :
-      lua_pushliteral("function");
-      break;
-    default :
-      lua_pushliteral("userdata");
-      break;
-  }
-  lua_pushnumber(t);
+  luaL_arg_check(o != LUA_NOOBJECT, 1, "no argument");
+  lua_pushstring(luaI_typenames[-ttype(luaI_Address(o))]);
+  lua_pushnumber(lua_tag(o));
 }
- 
+
 /*
 ** Internal function: convert an object to a number
 */
-void lua_obj2number (void)
+static void lua_obj2number (void)
 {
   lua_Object o = lua_getparam(1);
   if (lua_isnumber(o))
@@ -233,68 +228,181 @@ void lua_obj2number (void)
 }
 
 
-void luaI_error (void)
+static void luaI_error (void)
 {
   char *s = lua_getstring(lua_getparam(1));
   if (s == NULL) s = "(no message)";
   lua_error(s);
 }
 
-void luaI_assert (void)
+static void luaI_assert (void)
 {
   lua_Object p = lua_getparam(1);
   if (p == LUA_NOOBJECT || lua_isnil(p))
     lua_error("assertion failed!");
 }
 
-void luaI_setglobal (void)
+static void luaI_setglobal (void)
 {
-  lua_Object name = lua_getparam(1);
   lua_Object value = lua_getparam(2);
-  check_arg(lua_isstring(name), "setglobal");
+  luaL_arg_check(value != LUA_NOOBJECT, 2, NULL);
   lua_pushobject(value);
-  lua_storeglobal(lua_getstring(name));
+  lua_setglobal(luaL_check_string(1));
   lua_pushobject(value);  /* return given value */
 }
 
-void luaI_getglobal (void)
+static void luaI_rawsetglobal (void)
 {
-  lua_Object name = lua_getparam(1);
-  check_arg(lua_isstring(name), "getglobal");
-  lua_pushobject(lua_getglobal(lua_getstring(name)));
+  lua_Object value = lua_getparam(2);
+  luaL_arg_check(value != LUA_NOOBJECT, 2, NULL);
+  lua_pushobject(value);
+  lua_rawsetglobal(luaL_check_string(1));
+  lua_pushobject(value);  /* return given value */
 }
 
-#define MAXPARAMS	256
-void luaI_call (void)
+static void luaI_getglobal (void)
+{
+  lua_pushobject(lua_getglobal(luaL_check_string(1)));
+}
+
+static void luaI_rawgetglobal (void)
+{
+  lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
+}
+
+static void 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_gettable();
+  return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_WORD);
+}
+
+static void luaI_call (void)
 {
   lua_Object f = lua_getparam(1);
   lua_Object arg = lua_getparam(2);
-  lua_Object temp, params[MAXPARAMS];
+  int withtable = (strcmp(luaL_opt_string(3, ""), "pack") == 0);
   int narg, i;
-  check_arg(lua_istable(arg), "call");
-  check_arg(lua_isfunction(f), "call");
-  /* narg = arg.n */
-  lua_pushobject(arg);
-  lua_pushstring("n");
-  temp = lua_getsubscript();
-  narg = lua_isnumber(temp) ? lua_getnumber(temp) : MAXPARAMS+1;
-  /* read arg[1...n] */
+  luaL_arg_check(lua_isfunction(f), 1, "function expected");
+  luaL_arg_check(lua_istable(arg), 2, "table expected");
+  narg = getnarg(arg);
+  /* push arg[1...n] */
   for (i=0; i<narg; i++) {
-    if (i>=MAXPARAMS)
-      lua_error("argument list too long in function `call'");
-    lua_pushobject(arg);
-    lua_pushnumber(i+1);
-    params[i] = lua_getsubscript();
-    if (narg == MAXPARAMS+1 && lua_isnil(params[i])) {
-      narg = i;
+    lua_Object temp;
+    /* temp = arg[i+1] */
+    lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_gettable();
+    if (narg == MAX_WORD && lua_isnil(temp))
       break;
-    }
+    lua_pushobject(temp);
   }
-  /* push parameters and do the call */
-  for (i=0; i<narg; i++)
-    lua_pushobject(params[i]);
   if (lua_callfunction(f))
     lua_error(NULL);
+  else if (withtable)
+    packresults();
   else
     passresults();
 }
+
+static void luaIl_settag (void)
+{
+  lua_Object o = lua_getparam(1);
+  luaL_arg_check(lua_istable(o), 1, "table expected");
+  lua_pushobject(o);
+  lua_settag(luaL_check_number(2));
+}
+
+static void luaIl_newtag (void)
+{
+  lua_pushnumber(lua_newtag());
+}
+
+static void rawgettable (void)
+{
+  lua_Object t = lua_getparam(1);
+  lua_Object i = lua_getparam(2);
+  luaL_arg_check(t != LUA_NOOBJECT, 1, NULL);
+  luaL_arg_check(i != LUA_NOOBJECT, 2, NULL);
+  lua_pushobject(t);
+  lua_pushobject(i);
+  lua_pushobject(lua_rawgettable());
+}
+
+static void rawsettable (void)
+{
+  lua_Object t = lua_getparam(1);
+  lua_Object i = lua_getparam(2);
+  lua_Object v = lua_getparam(3);
+  luaL_arg_check(t != LUA_NOOBJECT && i != LUA_NOOBJECT && v != LUA_NOOBJECT,
+                 0, NULL);
+  lua_pushobject(t);
+  lua_pushobject(i);
+  lua_pushobject(v);
+  lua_rawsettable();
+}
+
+
+static void luaI_collectgarbage (void)
+{
+  lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
+}
+
+
+/*
+** Internal functions
+*/
+static struct {
+  char *name;
+  lua_CFunction func;
+} int_funcs[] = {
+  {"assert", luaI_assert},
+  {"call", luaI_call},
+  {"collectgarbage", luaI_collectgarbage},
+  {"dofile", lua_internaldofile},
+  {"dostring", lua_internaldostring},
+  {"error", luaI_error},
+  {"getglobal", luaI_getglobal},
+  {"newtag", luaIl_newtag},
+  {"next", lua_next},
+  {"nextvar", luaI_nextvar},
+  {"print", luaI_print},
+  {"rawgetglobal", luaI_rawgetglobal},
+  {"rawgettable", rawgettable},
+  {"rawsetglobal", luaI_rawsetglobal},
+  {"rawsettable", rawsettable},
+  {"seterrormethod", luaI_seterrormethod},
+#if LUA_COMPAT2_5
+  {"setfallback", luaI_setfallback},
+#endif
+  {"setglobal", luaI_setglobal},
+  {"settagmethod", luaI_settagmethod},
+  {"gettagmethod", luaI_gettagmethod},
+  {"settag", luaIl_settag},
+  {"tonumber", lua_obj2number},
+  {"tostring", luaI_tostring},
+  {"tag", luatag},
+  {"type", luaI_type}
+};
+
+#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+
+
+void luaI_predefine (void)
+{
+  int i;
+  Word n;
+  for (i=0; i<INTFUNCSIZE; i++) {
+    n = luaI_findsymbolbyname(int_funcs[i].name);
+    s_ttype(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
+  }
+  n = luaI_findsymbolbyname("_VERSION");
+  s_ttype(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
+}
+
+

inout.h

@@ -1,5 +1,5 @@
 /*
-** $Id: inout.h,v 1.15 1996/03/15 18:21:58 roberto Exp roberto $
+** $Id: inout.h,v 1.19 1997/06/18 20:35:49 roberto Exp roberto $
 */
 
 
@@ -14,21 +14,12 @@ extern Word lua_linenumber;
 extern Word lua_debugline;
 extern char *lua_parsedfile;
 
-FILE *lua_openfile     (char *fn);
-void lua_closefile    (void);
-void lua_openstring   (char *s);
-void lua_closestring  (void);
+void luaI_setparsedfile (char *name);
+
+void luaI_predefine (void);
+
+int lua_dobuffer (char *buff, int size);
+int lua_doFILE (FILE *f, int bin);
 
-void    lua_internaldofile (void);
-void    lua_internaldostring (void);
-void    luaI_tostring   (void);
-void    luaI_print      (void);
-void    luaI_type       (void);
-void    lua_obj2number (void);
-void	luaI_error     (void);
-void    luaI_assert    (void);
-void	luaI_setglobal (void);
-void	luaI_getglobal (void);
-void	luaI_call	(void);
 
 #endif

iolib.c

@@ -1,16 +1,16 @@
 #include <stdio.h>
-#include <ctype.h>
 #include <string.h>
 #include <time.h>
 #include <stdlib.h>
 #include <errno.h>
 
 #include "lua.h"
+#include "auxlib.h"
 #include "luadebug.h"
 #include "lualib.h"
 
 
-FILE *lua_infile, *lua_outfile;
+int lua_tagio;
 
 
 #ifdef POPEN
@@ -31,76 +31,95 @@ static void pushresult (int i)
 #ifndef NOSTRERROR
     lua_pushstring(strerror(errno));
 #else
-    lua_pushstring("system unable to define the error");
+    lua_pushstring("O.S. unable to define the error");
 #endif
   }
 }
 
 
-static void closefile (FILE *f)
+
+static FILE *getfile (char *name)
 {
-  if (f == stdin || f == stdout)
-    return;
-  if (f == lua_infile)
-    lua_infile = stdin;
-  if (f == lua_outfile)
-    lua_outfile = stdout;
+  lua_Object f = lua_getglobal(name);
+  if (!lua_isuserdata(f) || lua_tag(f) != lua_tagio)
+    luaL_verror("global variable %s is not a file handle", name);
+  return lua_getuserdata(f);
+}
+
+
+static void closefile (char *name)
+{
+  FILE *f = getfile(name);
+  if (f == stdin || f == stdout) return;
   if (pclose(f) == -1)
     fclose(f);
 }
 
 
+static void setfile (FILE *f, char *name)
+{
+  lua_pushusertag(f, lua_tagio);
+  lua_setglobal(name);
+}
+
+
+static void setreturn (FILE *f, char *name)
+{
+  setfile(f, name);
+  lua_pushusertag(f, lua_tagio);
+}
+
 
 static void io_readfrom (void)
 {
+  FILE *current;
   lua_Object f = lua_getparam(1);
-  if (f == LUA_NOOBJECT)
-    closefile(lua_infile);  /* restore standart input */
-  else if (lua_isuserdata(f))
-    lua_infile = lua_getuserdata(f);
+  if (f == LUA_NOOBJECT) {
+    closefile("_INPUT");
+    current = stdin;
+  }
+  else if (lua_tag(f) == lua_tagio)
+    current = lua_getuserdata(f);
   else {
-    char *s = lua_check_string(1, "readfrom");
-    FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
-    if (fp)
-      lua_infile = fp;
-    else {
+    char *s = luaL_check_string(1);
+    current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
+    if (current == NULL) {
       pushresult(0);
       return;
     }
   }
-  lua_pushuserdata(lua_infile);
+  setreturn(current, "_INPUT");
 }
 
 
 static void io_writeto (void)
 {
+  FILE *current;
   lua_Object f = lua_getparam(1);
-  if (f == LUA_NOOBJECT)
-    closefile(lua_outfile);  /* restore standart output */
-  else if (lua_isuserdata(f))
-    lua_outfile = lua_getuserdata(f);
+  if (f == LUA_NOOBJECT) {
+    closefile("_OUTPUT");
+    current = stdout;
+  }
+  else if (lua_tag(f) == lua_tagio)
+    current = lua_getuserdata(f);
   else {
-    char *s = lua_check_string(1, "writeto");
-    FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
-    if (fp)
-      lua_outfile = fp;
-    else {
+    char *s = luaL_check_string(1);
+    current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
+    if (current == NULL) {
       pushresult(0);
       return;
     }
   }
-  lua_pushuserdata(lua_outfile);
+  setreturn(current, "_OUTPUT");
 }
 
 
 static void io_appendto (void)
 {
-  char *s = lua_check_string(1, "appendto");
+  char *s = luaL_check_string(1);
   FILE *fp = fopen (s, "a");
-  if (fp != NULL) {
-    lua_outfile = fp;
-    lua_pushuserdata(lua_outfile);
-  }
+  if (fp != NULL)
+    setreturn(fp, "_OUTPUT");
   else
     pushresult(0);
 }
@@ -110,23 +129,30 @@ static void io_appendto (void)
 
 static void io_read (void)
 {
+  FILE *f = getfile("_INPUT");
   char *buff;
-  char *p = lua_opt_string(1, "[^\n]*{\n}", "read");
+  char *p = luaL_opt_string(1, "[^\n]*{\n}");
   int inskip = 0;  /* to control {skips} */
   int c = NEED_OTHER;
-  luaI_addchar(0);
+  luaI_emptybuff();
   while (*p) {
-    if (*p == '{' || *p == '}') {
-      inskip = (*p == '{');
+    if (*p == '{') {
+      inskip++;
+      p++;
+    }
+    else if (*p == '}') {
+      if (inskip == 0)
+        lua_error("unbalanced braces in read pattern");
+      inskip--;
       p++;
     }
     else {
-      char *ep = item_end(p);  /* get what is next */
+      char *ep = luaL_item_end(p);  /* get what is next */
       int m;  /* match result */
-      if (c == NEED_OTHER) c = getc(lua_infile);
-      m = (c == EOF) ? 0 : singlematch((char)c, p);
+      if (c == NEED_OTHER) c = getc(f);
+      m = (c == EOF) ? 0 : luaL_singlematch((char)c, p);
       if (m) {
-        if (!inskip) luaI_addchar(c);
+        if (inskip == 0) luaI_addchar(c);
         c = NEED_OTHER;
       }
       switch (*ep) {
@@ -144,7 +170,7 @@ static void io_read (void)
     }
   } break_while:
   if (c >= 0)  /* not EOF nor NEED_OTHER? */
-     ungetc(c, lua_infile);
+     ungetc(c, f);
   buff = luaI_addchar(0);
   if (*buff != 0 || *p == 0)  /* read something or did not fail? */
     lua_pushstring(buff);
@@ -153,31 +179,32 @@ static void io_read (void)
 
 static void io_write (void)
 {
+  FILE *f = getfile("_OUTPUT");
   int arg = 1;
   int status = 1;
   char *s;
-  while ((s = lua_opt_string(arg++, NULL, "write")) != NULL)
-    status = status && (fputs(s, lua_outfile) != EOF);
+  while ((s = luaL_opt_string(arg++, NULL)) != NULL)
+    status = status && (fputs(s, f) != EOF);
   pushresult(status);
 }
 
 
 static void io_execute (void)
 {
-  lua_pushnumber(system(lua_check_string(1, "execute")));
+  lua_pushnumber(system(luaL_check_string(1)));
 }
 
 
 static void io_remove  (void)
 {
-  pushresult(remove(lua_check_string(1, "remove")) == 0);
+  pushresult(remove(luaL_check_string(1)) == 0);
 }
 
 
 static void io_rename (void)
 {
-  pushresult(rename(lua_check_string(1, "rename"),
-                    lua_check_string(2, "rename")) == 0);
+  pushresult(rename(luaL_check_string(1),
+                    luaL_check_string(2)) == 0);
 }
 
 
@@ -190,7 +217,7 @@ static void io_tmpname (void)
 
 static void io_getenv (void)
 {
-  lua_pushstring(getenv(lua_check_string(1, "getenv"))); /* if NULL push nil */
+  lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */
 }
 
 
@@ -198,7 +225,7 @@ static void io_date (void)
 {
   time_t t;
   struct tm *tm;
-  char *s = lua_opt_string(1, "%c", "date");
+  char *s = luaL_opt_string(1, "%c");
   char b[BUFSIZ];
   time(&t); tm = localtime(&t);
   if (strftime(b,sizeof(b),s,tm))
@@ -229,34 +256,36 @@ static void io_debug (void)
 
 static void lua_printstack (FILE *f)
 {
-  int level = 0;
+  int level = 1;  /* skip level 0 (it's this function) */
   lua_Object func;
-  fprintf(f, "Active Stack:\n");
   while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
     char *name;
     int currentline;
-    fprintf(f, "\t");
+    char *filename;
+    int linedefined;
+    lua_funcinfo(func, &filename, &linedefined);
+    fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t");
     switch (*lua_getobjname(func, &name)) {
       case 'g':
         fprintf(f, "function %s", name);
         break;
-      case 'f':
-        fprintf(f, "`%s' fallback", name);
+      case 't':
+        fprintf(f, "`%s' tag method", name);
         break;
       default: {
-        char *filename;
-        int linedefined;
-        lua_funcinfo(func, &filename, &linedefined);
         if (linedefined == 0)
           fprintf(f, "main of %s", filename);
         else if (linedefined < 0)
           fprintf(f, "%s", filename);
         else
           fprintf(f, "function (%s:%d)", filename, linedefined);
+        filename = NULL;
       }
     }
     if ((currentline = lua_currentline(func)) > 0)
       fprintf(f, " at line %d", currentline);
+    if (filename)
+      fprintf(f, " [in file %s]", filename);
     fprintf(f, "\n");
   }
 }
@@ -264,13 +293,13 @@ static void lua_printstack (FILE *f)
 
 static void errorfb (void)
 {
-  char *s = lua_opt_string(1, "(no messsage)", NULL);
-  fprintf(stderr, "lua: %s\n", s);
+  fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1)));
   lua_printstack(stderr);
 }
 
 
-static struct lua_reg iolib[] = {
+
+static struct luaL_reg iolib[] = {
 {"readfrom", io_readfrom},
 {"writeto",  io_writeto},
 {"appendto", io_appendto},
@@ -289,7 +318,13 @@ static struct lua_reg iolib[] = {
 
 void iolib_open (void)
 {
-  lua_infile=stdin; lua_outfile=stdout;
-  luaI_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
-  lua_setfallback("error", errorfb);
+  lua_tagio = lua_newtag();
+  setfile(stdin, "_INPUT");
+  setfile(stdout, "_OUTPUT");
+  setfile(stdin, "_STDIN");
+  setfile(stdout, "_STDOUT");
+  setfile(stderr, "_STDERR");
+  luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
+  lua_pushcfunction(errorfb);
+  lua_seterrormethod();
 }

lex.c

@@ -1,10 +1,11 @@
-char *rcs_lex = "$Id: lex.c,v 2.38 1996/11/08 12:49:35 roberto Exp roberto $";
+char *rcs_lex = "$Id: lex.c,v 3.4 1997/06/11 18:56:02 roberto Exp roberto $";
 
 
 #include <ctype.h>
 #include <string.h>
 
-#include "mem.h"
+#include "auxlib.h"
+#include "luamem.h"
 #include "tree.h"
 #include "table.h"
 #include "lex.h"
@@ -12,33 +13,58 @@ char *rcs_lex = "$Id: lex.c,v 2.38 1996/11/08 12:49:35 roberto Exp roberto $";
 #include "luadebug.h"
 #include "parser.h"
 
-#define MINBUFF 260
+#define MINBUFF 250
 
-#define next() (current = input())
+static int current;  /* look ahead character */
+static ZIO *lex_z;
+
+
+#define next() (current = zgetc(lex_z))
 #define save(x) (yytext[tokensize++] = (x))
 #define save_and_next()  (save(current), next())
 
 
-static int current;  /* look ahead character */
-static Input input;  /* input function */
+#define MAX_IFS	5
+
+/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
+
+static struct {
+  int elsepart;  /* true if its in the $else part */
+  int condition;  /* true if $if condition is true */
+  int skip;  /* true if part must be skiped */
+} ifstate[MAX_IFS];
+
+static int iflevel;  /* level of nested $if's */
 
 
-void lua_setinput (Input fn)
+void lua_setinput (ZIO *z)
 {
   current = '\n';
   lua_linenumber = 0;
-  input = fn;
+  iflevel = 0;
+  ifstate[0].skip = 0;
+  ifstate[0].elsepart = 1;  /* to avoid a free $else */
+  lex_z = z;
+}
+
+
+static void luaI_auxsyntaxerror (char *s)
+{
+  luaL_verror("%s;\n> at line %d in file %s",
+               s, lua_linenumber, lua_parsedfile);
+}
+
+static void luaI_auxsynterrbf (char *s, char *token)
+{
+  if (token[0] == 0)
+    token = "<eof>";
+  luaL_verror("%s;\n> last token read: \"%s\" at line %d in file %s",
+           s, token, lua_linenumber, lua_parsedfile);
 }
 
 void luaI_syntaxerror (char *s)
 {
-  char msg[256];
-  char *token = luaI_buffer(1);
-  if (token[0] == 0)
-    token = "<eof>";
-  sprintf (msg,"%s;\n> last token read: \"%s\" at line %d in file %s",
-           s, token, lua_linenumber, lua_parsedfile);
-  lua_error (msg);
+  luaI_auxsynterrbf(s, luaI_buffer(1));
 }
 
 
@@ -78,26 +104,122 @@ void luaI_addReserved (void)
   }
 }
 
-static int inclinenumber (int pragma_allowed)
+
+/*
+** Pragma handling
+*/
+
+#define PRAGMASIZE	20
+
+static void skipspace (void)
 {
-  ++lua_linenumber;
-  if (pragma_allowed && current == '$') {  /* is a pragma? */
-    char *buff = luaI_buffer(MINBUFF+1);
-    int i = 0;
-    next();  /* skip $ */
-    while (isalnum(current)) {
-      if (i >= MINBUFF) luaI_syntaxerror("pragma too long");
-      buff[i++] = current;
-      next();
-    }
-    buff[i] = 0;
-    if (strcmp(buff, "debug") == 0)
-      lua_debug = 1;
-    else if (strcmp(buff, "nodebug") == 0)
-      lua_debug = 0;
-    else luaI_syntaxerror("invalid pragma");
+  while (current == ' ' || current == '\t') next();
+}
+
+
+static int checkcond (char *buff)
+{
+  static char *opts[] = {"nil", "1"};
+  int i = luaI_findstring(buff, opts); 
+  if (i >= 0) return i;
+  else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
+    return luaI_globaldefined(buff);
+  else {
+    luaI_auxsynterrbf("invalid $if condition", buff);
+    return 0;  /* to avoid warnings */
+  }
+}
+
+
+static void readname (char *buff)
+{
+  int i = 0;
+  skipspace();
+  while (isalnum((unsigned char)current) || current == '_') {
+    if (i >= PRAGMASIZE) {
+      buff[PRAGMASIZE] = 0;
+      luaI_auxsynterrbf("pragma too long", buff);
+    }
+    buff[i++] = current;
+    next();
+  }
+  buff[i] = 0;
+}
+
+
+static void inclinenumber (void);
+
+
+static void ifskip (void)
+{
+  while (ifstate[iflevel].skip) {
+    if (current == '\n')
+      inclinenumber();
+    else if (current == EOZ)
+      luaI_auxsyntaxerror("input ends inside a $if");
+    else next();
+  }
+}
+
+
+static void inclinenumber (void)
+{
+  static char *pragmas [] = 
+    {"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
+  next();  /* skip '\n' */
+  ++lua_linenumber;
+  if (current == '$') {  /* is a pragma? */
+    char buff[PRAGMASIZE+1];
+    int ifnot = 0;
+    int skip = ifstate[iflevel].skip;
+    next();  /* skip $ */
+    readname(buff);
+    switch (luaI_findstring(buff, pragmas)) {
+      case 0:  /* debug */
+        if (!skip) lua_debug = 1;
+        break;
+      case 1:  /* nodebug */
+        if (!skip) lua_debug = 0;
+        break;
+      case 2:  /* endinput */
+        if (!skip) {
+          current = EOZ;
+          iflevel = 0;  /* to allow $endinput inside a $if */
+        }
+        break;
+      case 3:  /* end */
+        if (iflevel-- == 0)
+          luaI_auxsyntaxerror("unmatched $endif");
+        break;
+      case 4:  /* ifnot */
+        ifnot = 1;
+        /* go through */
+      case 5:  /* if */
+        if (iflevel == MAX_IFS-1)
+          luaI_auxsyntaxerror("too many nested `$ifs'");
+        readname(buff);
+        iflevel++;
+        ifstate[iflevel].elsepart = 0;
+        ifstate[iflevel].condition = checkcond(buff) ? !ifnot : ifnot;
+        ifstate[iflevel].skip = skip || !ifstate[iflevel].condition;
+        break;
+      case 6:  /* else */
+        if (ifstate[iflevel].elsepart)
+          luaI_auxsyntaxerror("unmatched $else");
+        ifstate[iflevel].elsepart = 1;
+        ifstate[iflevel].skip =
+                    ifstate[iflevel-1].skip || ifstate[iflevel].condition;
+        break;
+      default:
+        luaI_auxsynterrbf("invalid pragma", buff);
+    }
+    skipspace();
+    if (current == '\n')  /* pragma must end with a '\n' ... */
+      inclinenumber();
+    else if (current != EOZ)  /* or eof */
+      luaI_auxsyntaxerror("invalid pragma format");
+    ifskip();
   }
-  return lua_linenumber;
 }
 
 static int read_long_string (char *yytext, int buffsize)
@@ -110,7 +232,7 @@ static int read_long_string (char *yytext, int buffsize)
       yytext = luaI_buffer(buffsize *= 2);
     switch (current)
     {
-      case 0:
+      case EOZ:
         save(0);
         return WRONGTOKEN;
       case '[':
@@ -131,8 +253,8 @@ static int read_long_string (char *yytext, int buffsize)
         }
         continue;
       case '\n':
-        save_and_next();
-        inclinenumber(0);
+        save('\n');
+        inclinenumber();
         continue;
       default:
         save_and_next();
@@ -162,8 +284,8 @@ int luaY_lex (void)
     switch (current)
     {
       case '\n':
-        next();
-        linelasttoken = inclinenumber(1);
+        inclinenumber();
+        linelasttoken = lua_linenumber;
         continue;
 
       case ' ': case '\t': case '\r':  /* CR: to avoid problems with DOS */
@@ -173,7 +295,7 @@ int luaY_lex (void)
       case '-':
         save_and_next();
         if (current != '-') return '-';
-        do { next(); } while (current != '\n' && current != 0);
+        do { next(); } while (current != '\n' && current != EOZ);
         continue;
 
       case '[':
@@ -216,7 +338,7 @@ int luaY_lex (void)
             yytext = luaI_buffer(buffsize *= 2);
           switch (current)
           {
-            case 0:
+            case EOZ:
             case '\n':
               save(0);
               return WRONGTOKEN;
@@ -227,7 +349,7 @@ int luaY_lex (void)
                 case 'n': save('\n'); next(); break;
                 case 't': save('\t'); next(); break;
                 case 'r': save('\r'); next(); break;
-                case '\n': save_and_next(); inclinenumber(0); break;
+                case '\n': save('\n'); inclinenumber(); break;
                 default : save_and_next(); break;
               }
               break;
@@ -258,7 +380,9 @@ int luaY_lex (void)
       case '_':
       {
         TaggedString *ts;
-        do { save_and_next(); } while (isalnum(current) || current == '_');
+        do {
+          save_and_next();
+        } while (isalnum((unsigned char)current) || current == '_');
         save(0);
         ts = lua_createstring(yytext);
         if (ts->marked > 2)
@@ -280,7 +404,7 @@ int luaY_lex (void)
           }
           else return CONC;   /* .. */
         }
-        else if (!isdigit(current)) return '.';
+        else if (!isdigit((unsigned char)current)) return '.';
         /* current is a digit: goes through to number */
 	a=0.0;
         goto fraction;
@@ -291,7 +415,7 @@ int luaY_lex (void)
         do {
           a=10.0*a+(current-'0');
           save_and_next();
-        } while (isdigit(current));
+        } while (isdigit((unsigned char)current));
         if (current == '.') {
           save_and_next();
           if (current == '.')
@@ -300,7 +424,7 @@ int luaY_lex (void)
         }
       fraction:
 	{ double da=0.1;
-	  while (isdigit(current))
+	  while (isdigit((unsigned char)current))
 	  {
             a+=(current-'0')*da;
             da/=10.0;
@@ -314,11 +438,12 @@ int luaY_lex (void)
             save_and_next();
 	    neg=(current=='-');
             if (current == '+' || current == '-') save_and_next();
-            if (!isdigit(current)) { save(0); return WRONGTOKEN; }
+            if (!isdigit((unsigned char)current)) {
+              save(0); return WRONGTOKEN; }
             do {
               e=10.0*e+(current-'0');
               save_and_next();
-            } while (isdigit(current));
+            } while (isdigit((unsigned char)current));
 	    for (ea=neg?0.1:10.0; e>0; e>>=1)
 	    {
 	      if (e & 1) a*=ea;
@@ -330,11 +455,15 @@ int luaY_lex (void)
           return NUMBER;
         }
 
-      default: 		/* also end of program (0) */
-      {
+      case EOZ:
+        save(0);
+        if (iflevel > 0)
+          luaI_syntaxerror("missing $endif");
+        return 0;
+
+      default:
         save_and_next();
         return yytext[0];
-      }
     }
   }
 }

lex.h

@@ -1,16 +1,15 @@
 /*
 ** lex.h
 ** TecCGraf - PUC-Rio
-** $Id: lex.h,v 1.2 1996/02/14 13:35:51 roberto Exp roberto $
+** $Id: lex.h,v 1.3 1996/11/08 12:49:35 roberto Exp roberto $
 */
 
 #ifndef lex_h
 #define lex_h
 
+#include "zio.h"
 
-typedef int  (*Input) (void);
-
-void    lua_setinput   (Input fn);
+void    lua_setinput   (ZIO *z);
 void luaI_syntaxerror (char *s);
 int     luaY_lex (void);
 void luaI_addReserved (void);

lua.c

@@ -3,12 +3,13 @@
 ** Linguagem para Usuarios de Aplicacao
 */
 
-char *rcs_lua="$Id: lua.c,v 1.13 1996/07/06 20:20:35 roberto Exp roberto $";
+char *rcs_lua="$Id: lua.c,v 1.17 1997/06/18 21:20:45 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
 
 #include "lua.h"
+#include "auxlib.h"
 #include "lualib.h"
 
 
@@ -19,6 +20,74 @@ char *rcs_lua="$Id: lua.c,v 1.13 1996/07/06 20:20:35 roberto Exp roberto $";
 #endif
 
 
+#define DEBUG	0
+
+static void testC (void)
+{
+#if DEBUG
+#define getnum(s)	((*s++) - '0')
+#define getname(s)	(nome[0] = *s++, nome)
+
+  static int locks[10];
+  lua_Object reg[10];
+  char nome[2];
+  char *s = luaL_check_string(1);
+  nome[1] = 0;
+  while (1) {
+    switch (*s++) {
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+        lua_pushnumber(*(s-1) - '0');
+        break;
+
+      case 'c': reg[getnum(s)] = lua_createtable(); break;
+
+      case 'P': reg[getnum(s)] = lua_pop(); break;
+
+      case 'g': { int n = getnum(s); reg[n] = lua_getglobal(getname(s)); break; }
+
+      case 'G': { int n = getnum(s);
+                  reg[n] = lua_rawgetglobal(getname(s));
+                  break;
+                }
+
+      case 'l': locks[getnum(s)] = lua_ref(1); break;
+      case 'L': locks[getnum(s)] = lua_ref(0); break;
+
+      case 'r': { int n = getnum(s); reg[n] = lua_getref(locks[getnum(s)]); break; }
+
+      case 'u': lua_unref(locks[getnum(s)]); break;
+
+      case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
+
+      case '=': lua_setglobal(getname(s)); break;
+
+      case 's': lua_pushstring(getname(s)); break;
+
+      case 'o': lua_pushobject(reg[getnum(s)]); break;
+
+      case 'f': lua_call(getname(s)); break;
+
+      case 'i': reg[getnum(s)] = lua_gettable(); break;
+
+      case 'I': reg[getnum(s)] = lua_rawgettable(); break;
+
+      case 't': lua_settable(); break;
+
+      case 'T': lua_rawsettable(); break;
+
+      default: luaL_verror("unknown command in `testC': %c", *(s-1));
+
+    }
+  if (*s == 0) return;
+  if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
+  }
+#else
+  lua_error("`testC' not active");
+#endif
+}
+
+
 static void manual_input (void)
 {
   if (isatty(0)) {
@@ -41,6 +110,7 @@ int main (int argc, char *argv[])
   iolib_open ();
   strlib_open ();
   mathlib_open ();
+  lua_register("testC", testC);
   if (argc < 2)
     manual_input();
   else for (i=1; i<argc; i++) {
@@ -59,8 +129,8 @@ int main (int argc, char *argv[])
       result = lua_dofile (argv[i]);
       if (result) {
         if (result == 2) {
-          fprintf(stderr, "lua: cannot execute file `%s' - ", argv[i]);
-          perror(NULL);
+          fprintf(stderr, "lua: cannot execute file ");
+          perror(argv[i]);
         }
         return 1;
       }

lua.h

@@ -1,61 +1,50 @@
 /*
-** LUA - Linguagem para Usuarios de Aplicacao
-** Grupo de Tecnologia em Computacao Grafica
-** TeCGraf - PUC-Rio
-** $Id: lua.h,v 3.31 1996/11/12 16:00:16 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
+** $Id: lua.h,v 4.10 1997/06/19 18:03:04 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
-#define LUA_VERSION	"Lua 2.5.1"
-#define LUA_COPYRIGHT	"Copyright (C) 1994-1996 TeCGraf"
+#define LUA_VERSION	"Lua 3.0"
+#define LUA_COPYRIGHT	"Copyright (C) 1994-1997 TeCGraf"
 #define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
 
 
-/* Private Part */
- 
-typedef enum
-{
- LUA_T_NIL	= -1,
- LUA_T_NUMBER	= -2,
- LUA_T_STRING	= -3,
- LUA_T_ARRAY	= -4,
- LUA_T_FUNCTION	= -5,
- LUA_T_CFUNCTION= -6,
- LUA_T_MARK	= -7,
- LUA_T_CMARK	= -8,
- LUA_T_LINE	= -9,
- LUA_T_USERDATA = 0
-} lua_Type;
- 
-
-/* Public Part */
-
 #define LUA_NOOBJECT  0
 
+#define LUA_ANYTAG    (-1)
+
 typedef void (*lua_CFunction) (void);
 typedef unsigned int lua_Object;
 
-lua_Object     lua_setfallback		(char *name, lua_CFunction fallback);
+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);
+void           lua_settag		(int tag); /* In: object */
 
 void           lua_error		(char *s);
-int            lua_dofile 		(char *filename);
-int            lua_dostring 		(char *string);
-int            lua_callfunction		(lua_Object function);
-int	       lua_call			(char *funcname);
+int            lua_dofile 		(char *filename); /* Out: returns */
+int            lua_dostring 		(char *string); /* Out: returns */
+int            lua_callfunction		(lua_Object f);
+					  /* In: parameters; Out: returns */
 
 void	       lua_beginblock		(void);
 void	       lua_endblock		(void);
 
-lua_Object     lua_getparam 		(int number);
-#define	       lua_getresult(_)		lua_getparam(_)
+lua_Object     lua_lua2C 		(int number);
+#define	       lua_getparam(_)		lua_lua2C(_)
+#define	       lua_getresult(_)		lua_lua2C(_)
 
-#define        lua_isnil(_)             (lua_type(_)==LUA_T_NIL)
-#define        lua_istable(_)           (lua_type(_)==LUA_T_ARRAY)
-#define        lua_isuserdata(_)        (lua_type(_)>=LUA_T_USERDATA)
-#define        lua_iscfunction(_)       (lua_type(_)==LUA_T_CFUNCTION)
+int            lua_isnil                (lua_Object object);
+int            lua_istable              (lua_Object object);
+int            lua_isuserdata           (lua_Object object);
+int            lua_iscfunction          (lua_Object object);
 int            lua_isnumber             (lua_Object object);
 int            lua_isstring             (lua_Object object);
 int            lua_isfunction           (lua_Object object);
@@ -63,42 +52,73 @@ int            lua_isfunction           (lua_Object object);
 float          lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
-void          *lua_getuserdata  	(lua_Object object);
+void	      *lua_getuserdata		(lua_Object object);
+
 
 void 	       lua_pushnil 		(void);
 void           lua_pushnumber 		(float n);
 void           lua_pushstring 		(char *s);
 void           lua_pushcfunction	(lua_CFunction fn);
-void           lua_pushusertag     	(void *u, int tag);
+void           lua_pushusertag          (void *u, int tag);
 void           lua_pushobject       	(lua_Object object);
 
+lua_Object     lua_pop			(void);
+
 lua_Object     lua_getglobal 		(char *name);
-void           lua_storeglobal		(char *name);
+lua_Object     lua_rawgetglobal		(char *name);
+void           lua_setglobal		(char *name); /* In: value */
+void           lua_rawsetglobal		(char *name); /* In: value */
 
-void           lua_storesubscript	(void);
-lua_Object     lua_getsubscript         (void);
+void           lua_settable	(void); /* In: table, index, value */
+void           lua_rawsettable	(void); /* In: table, index, value */
+lua_Object     lua_gettable 		(void); /* In: table, index */
+lua_Object     lua_rawgettable		(void); /* In: table, index */
 
-int            lua_type 		(lua_Object object);
+int            lua_tag			(lua_Object object);
 
 
-int            lua_ref			(int lock);
+int            lua_ref			(int lock); /* In: value */
 lua_Object     lua_getref		(int ref);
-void	       lua_pushref		(int ref);
 void	       lua_unref		(int ref);
 
 lua_Object     lua_createtable		(void);
 
+long	       lua_collectgarbage	(long limit);
 
+
+/* =============================================================== */
 /* some useful macros */
 
+#define lua_call(name)		lua_callfunction(lua_getglobal(name))
+
+#define lua_pushref(ref)	lua_pushobject(lua_getref(ref))
+
 #define lua_refobject(o,l)	(lua_pushobject(o), lua_ref(l))
 
-#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_setglobal(n))
 
-#define lua_pushuserdata(u)     lua_pushusertag(u, LUA_T_USERDATA)
+#define lua_pushuserdata(u)     lua_pushusertag(u, 0)
 
 
-/* for compatibility with old versions. Avoid using these macros */
+
+
+/* ========================================================================== 
+** for compatibility with old versions. Avoid using these macros/functions
+** If your program does not use any of these, define LUA_COMPAT2_5 to 0
+*/
+
+#ifndef LUA_COMPAT2_5
+#define LUA_COMPAT2_5	1
+#endif
+
+
+#if LUA_COMPAT2_5
+
+
+lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
+
+#define lua_storeglobal		lua_setglobal
+#define lua_type		lua_tag
 
 #define lua_lockobject(o)  lua_refobject(o,1)
 #define	lua_lock() lua_ref(1)
@@ -108,9 +128,14 @@ lua_Object     lua_createtable		(void);
 
 #define lua_pushliteral(o)  lua_pushstring(o)
 
-#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_getsubscript())
-#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushliteral(f), lua_getsubscript())
+#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_gettable())
+#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushstring(f), lua_gettable())
 
 #define lua_copystring(o) (strdup(lua_getstring(o)))
 
+#define lua_getsubscript  lua_gettable
+#define lua_storesubscript  lua_settable
+
+#endif
+
 #endif

lua.stx

@@ -1,13 +1,13 @@
 %{
 
-char *rcs_luastx = "$Id: lua.stx,v 3.40 1996/09/25 21:52:00 roberto Exp roberto $";
+char *rcs_luastx = "$Id: lua.stx,v 3.46 1997/03/31 14:19:01 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 
 #include "luadebug.h"
-#include "mem.h"
+#include "luamem.h"
 #include "lex.h"
 #include "opcode.h"
 #include "hash.h"
@@ -50,8 +50,6 @@ static TaggedString *localvar[MAXLOCALS];  /* store local variable names */
 static int     nlocalvar=0;	     /* number of local variables */
 
 #define MAXFIELDS FIELDS_PER_FLUSH*2
-static Word    fields[MAXFIELDS];     /* fieldnames to be flushed */
-static int     nfields=0;
 
 int lua_debug = 0;
 
@@ -103,22 +101,11 @@ static void code_word_at (Byte *p, int n)
   memcpy(p, &w, sizeof(Word));
 }
 
-static void push_field (Word name)
-{
-  if (nfields < MAXFIELDS)
-    fields[nfields++] = name;
-  else
-   yyerror ("too many fields in nested constructors");
-}
-
 static void flush_record (int n)
 {
-  int i;
   if (n == 0) return;
-  code_byte(STORERECORD);
+  code_byte(STOREMAP);
   code_byte(n);
-  for (i=0; i<n; i++)
-    code_word(fields[--nfields]);
 }
 
 static void flush_list (int m, int n)
@@ -161,11 +148,22 @@ static void add_varbuffer (Long var)
   yyerror ("variable buffer overflow");
 }
 
+static void code_string (Word w)
+{
+  code_byte(PUSHSTRING);
+  code_word(w);
+}
+
+static void code_constant (TaggedString *s)
+{
+  code_string(luaI_findconstant(s));
+}
+
 static void code_number (float f)
 { 
-  Word i = (Word)f;
-  if (f == (float)i)  /* f has an (short) integer value */
-  {
+  Word i;
+  if (f >= 0 && f <= (float)MAX_WORD && (float)(i=(Word)f) == f) {
+   /* f has an (short) integer value */
    if (i <= 2) code_byte(PUSH0 + i);
    else if (i <= 255)
    {
@@ -459,7 +457,7 @@ void lua_parse (TFunc *tf)
 
 %% /* beginning of rules section */
 
-chunk	: chunklist ret
+chunk	: chunklist ret ;
 
 chunklist : /* empty */
 	  | chunklist stat sc
@@ -477,8 +475,7 @@ function     : FUNCTION funcname body
 funcname	: var { $$ =$1; init_func(); }
 		| varexp ':' NAME
 	{
-	  code_byte(PUSHSTRING);
-	  code_word(luaI_findconstant($3));
+	  code_constant($3);
 	  $$ = 0;  /* indexed variable */
 	  init_func();
 	  add_localvar(luaI_createfixedstring("self"));
@@ -492,7 +489,6 @@ body :  '(' parlist ')' block END
           luaI_initTFunc($$);
 	  $$->size = pc;
 	  $$->code = newvector(pc, Byte);
-	  $$->fileName = lua_parsedfile;
 	  $$->lineDefined = $2;
 	  memcpy($$->code, basepc, pc*sizeof(Byte));
           if (lua_debug)
@@ -540,7 +536,7 @@ stat   : IF expr1 THEN PrepJump block PrepJump elsepart END
 	  lua_codeadjust (0);
 	}
        } 
-       | functioncall
+       | functioncall {;}
        | LOCAL localdeclist decinit
 	{ nlocalvar += $2;
 	  adjust_mult_assign($2, $3, 0);
@@ -605,9 +601,8 @@ expr :  '(' expr ')'  { $$ = $2; }
      |  NUMBER          { code_number($1); $$ = 0; }
      |  STRING
      {
-      code_byte(PUSHSTRING);
-      code_word($1);
-      $$ = 0;
+       code_string($1);
+       $$ = 0;
      }
      |	NIL		{code_byte(PUSHNIL); $$ = 0; }
      |  functioncall    { $$ = $1; }
@@ -723,12 +718,13 @@ ffieldlist1 : ffield			{$$=1;}
 		}
 	   ; 
 
-ffield      : NAME '=' expr1 
-	      { 
-	       push_field(luaI_findconstant($1));
-	      }
+ffield      : ffieldkey '=' expr1
            ;
 
+ffieldkey   : '[' expr1 ']'
+	    | NAME { code_constant($1); }
+	    ;
+
 lfieldlist  : /* empty */ { $$ = 0; }
 	    | lfieldlist1 lastcomma { $$ = $1; }
 	    ;
@@ -762,9 +758,8 @@ var	  :	singlevar { $$ = $1; }
 	  }
 	  |	varexp '.' NAME
 	  {
-	   code_byte(PUSHSTRING);
-	   code_word(luaI_findconstant($3));
-	   $$ = 0;		/* indexed variable */
+	    code_constant($3);
+	    $$ = 0;		/* indexed variable */
 	  }
 	  ;
 		

lualib.h

@@ -2,7 +2,7 @@
 ** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lualib.h,v 1.9 1996/08/01 14:55:33 roberto Exp roberto $
+** $Id: lualib.h,v 1.12 1997/03/18 15:30:50 roberto Exp roberto $
 */
 
 #ifndef lualib_h
@@ -15,24 +15,15 @@ void strlib_open  (void);
 void mathlib_open (void);
 
 
+
 /* auxiliar functions (private) */
 
-struct lua_reg {
-  char *name;
-  lua_CFunction func;
-};
-
-void luaI_openlib (struct lua_reg *l, int n);
-void lua_arg_check(int cond, char *funcname);
-char *lua_check_string (int numArg, char *funcname);
-char *lua_opt_string (int numArg, char *def, char *funcname);
-double lua_check_number (int numArg, char *funcname);
-long lua_opt_number (int numArg, long def, char *funcname);
 char *luaI_addchar (int c);
+void luaI_emptybuff (void);
 void luaI_addquoted (char *s);
 
-char *item_end (char *p);
-int singlematch (int c, char *p);
+char *luaL_item_end (char *p);
+int luaL_singlematch (int c, char *p);
 
 #endif
 

luamem.c

@@ -3,19 +3,23 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_mem = "$Id: mem.c,v 1.12 1996/05/06 16:59:00 roberto Exp roberto $";
+char *rcs_luamem = "$Id: luamem.c,v 1.15 1997/03/31 14:17:09 roberto Exp roberto $";
 
 #include <stdlib.h>
 
-#include "mem.h"
+#include "luamem.h"
 #include "lua.h"
 
 
+#define DEBUG 0
+
+#if !DEBUG
+
 void luaI_free (void *block)
 {
   if (block)
   {
-    *((int *)block) = -1;  /* to catch errors */
+    *((char *)block) = -1;  /* to catch errors */
     free(block);
   }
 }
@@ -56,3 +60,100 @@ void* luaI_buffer (unsigned long size)
   return buffer;
 }
 
+#else
+/* DEBUG */
+
+#include <stdio.h>
+
+# define assert(ex)    {if (!(ex)){(void)fprintf(stderr, \
+    "Assertion failed: file \"%s\", line %d\n", __FILE__, __LINE__);exit(1);}}
+
+#define MARK    55
+
+static unsigned long numblocks = 0;
+static unsigned long totalmem = 0;
+
+
+static void message (void)
+{
+#define inrange(x,y)   ((x) < (((y)*3)/2)  && (x) > (((y)*2)/3))
+  static int count = 0;
+  static unsigned long lastnumblocks = 0;
+  static unsigned long lasttotalmem = 0;
+  if (!inrange(numblocks, lastnumblocks) || !inrange(totalmem, lasttotalmem)
+       || count++ >= 5000)
+  {
+    fprintf(stderr,"blocks = %lu  mem = %luK\n", numblocks, totalmem/1000);
+    count = 0;
+    lastnumblocks = numblocks;
+    lasttotalmem = totalmem;
+  }
+}
+
+
+void luaI_free (void *block)
+{
+  if (block)
+  {
+    unsigned long *b = (unsigned long *)block - 1;
+    unsigned long size = *b;
+    assert(*(((char *)b)+size+sizeof(unsigned long)) == MARK);
+    numblocks--;
+    totalmem -= size;
+    free(b);
+    message();
+  }
+}
+
+
+void *luaI_realloc (void *oldblock, unsigned long size)
+{
+  unsigned long *block;
+  unsigned long realsize = sizeof(unsigned long)+size+sizeof(char);
+  if (realsize != (size_t)realsize)
+    lua_error("Allocation Error: Block too big");
+  if (oldblock)
+  {
+    unsigned long *b = (unsigned long *)oldblock - 1;
+    unsigned long oldsize = *b;
+    assert(*(((char *)b)+oldsize+sizeof(unsigned long)) == MARK);
+    totalmem -= oldsize;
+    numblocks--;
+    block = (unsigned long *)realloc(b, realsize);
+  }
+  else
+    block = (unsigned long *)malloc(realsize);
+  if (block == NULL)
+    lua_error("not enough memory");
+  totalmem += size;
+  numblocks++;
+  *block = size;
+  *(((char *)block)+size+sizeof(unsigned long)) = MARK;
+  message();
+  return block+1;
+}
+
+
+int luaI_growvector (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit)
+{
+  if (nelems >= limit)
+    lua_error(errormsg);
+  nelems = (nelems == 0) ? 20 : nelems*2;
+  if (nelems > limit)
+    nelems = limit;
+  *block = luaI_realloc(*block, nelems*size);
+  return (int)nelems;
+}
+
+
+void* luaI_buffer (unsigned long size)
+{
+  static unsigned long buffsize = 0;
+  static char* buffer = NULL;
+  if (size > buffsize)
+    buffer = luaI_realloc(buffer, buffsize=size);
+  return buffer;
+}
+
+#endif

luamem.h

@@ -1,11 +1,11 @@
 /*
 ** mem.c
 ** memory manager for lua
-** $Id: mem.h,v 1.7 1996/04/22 18:00:37 roberto Exp roberto $
+** $Id: luamem.h,v 1.8 1996/05/24 14:31:10 roberto Exp roberto $
 */
  
-#ifndef mem_h
-#define mem_h
+#ifndef luamem_h
+#define luamem_h
 
 #ifndef NULL
 #define NULL 0

makefile

@@ -1,4 +1,4 @@
-# $Id: makefile,v 1.27 1996/08/28 20:45:48 roberto Exp roberto $
+# $Id: makefile,v 1.35 1997/06/16 16:50:22 roberto Exp roberto $
 
 #configuration
 
@@ -6,10 +6,13 @@
 # define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
 #define (undefine) NOSTRERROR if your system does NOT have function "strerror"
 # (although this is ANSI, SunOS does not comply; so, add "-DNOSTRERROR" on SunOS)
+# define LUA_COMPAT2_5=0 if yous system does not need to be compatible with
+# version 2.5 (or older)
 CONFIG = -DPOPEN -D_POSIX_SOURCE
 # Compilation parameters
 CC = gcc
-CFLAGS = $(CONFIG) -Wall -Wmissing-prototypes -Wshadow -ansi -O2 -pedantic
+CWARNS = -Wall -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-align -Waggregate-return
+CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2 -fomit-frame-pointer
 
 #CC = acc
 #CFLAGS = -fast -I/usr/5include
@@ -28,9 +31,11 @@ LUAOBJS = \
 	inout.o \
 	tree.o \
 	fallback.o \
-	mem.o \
+	luamem.o \
 	func.o \
-	undump.o
+	undump.o \
+	auxlib.o \
+	zio.o
 
 LIBOBJS = 	\
 	iolib.o \
@@ -75,24 +80,32 @@ clear	:
 	co $@
 
 
-fallback.o : fallback.c mem.h fallback.h lua.h opcode.h types.h tree.h func.h \
-  table.h 
-func.o : func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h mem.h 
-hash.o : hash.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h 
-inout.o : inout.c lex.h opcode.h lua.h types.h tree.h func.h inout.h table.h \
-  mem.h 
-iolib.o : iolib.c lua.h luadebug.h lualib.h 
-lex.o : lex.c mem.h tree.h types.h table.h opcode.h lua.h func.h lex.h inout.h \
-  luadebug.h parser.h 
-lua.o : lua.c lua.h lualib.h 
-mathlib.o : mathlib.c lualib.h lua.h 
-mem.o : mem.c mem.h lua.h
-opcode.o : opcode.c luadebug.h lua.h mem.h opcode.h types.h tree.h func.h hash.h \
-  inout.h table.h fallback.h undump.h 
-parser.o : parser.c luadebug.h lua.h mem.h lex.h opcode.h types.h tree.h func.h \
-  hash.h inout.h table.h 
-strlib.o : strlib.c lua.h lualib.h 
-table.o : table.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h \
-  inout.h fallback.h luadebug.h 
-tree.o : tree.c mem.h lua.h tree.h types.h lex.h hash.h opcode.h func.h table.h 
-undump.o : undump.c opcode.h lua.h types.h tree.h func.h mem.h table.h undump.h 
+auxlib.o: auxlib.c lua.h auxlib.h luadebug.h
+fallback.o: fallback.c auxlib.h lua.h luamem.h fallback.h opcode.h \
+ types.h tree.h func.h table.h hash.h
+func.o: func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h \
+ luamem.h
+hash.o: hash.c luamem.h opcode.h lua.h types.h tree.h func.h hash.h \
+ table.h auxlib.h
+inout.o: inout.c auxlib.h lua.h fallback.h opcode.h types.h tree.h \
+ func.h hash.h inout.h lex.h zio.h luamem.h table.h undump.h
+iolib.o: iolib.c lua.h auxlib.h luadebug.h lualib.h
+lex.o: lex.c auxlib.h lua.h luamem.h tree.h types.h table.h opcode.h \
+ func.h lex.h zio.h inout.h luadebug.h parser.h
+lua.o: lua.c lua.h auxlib.h lualib.h
+luamem.o: luamem.c luamem.h lua.h
+mathlib.o: mathlib.c lualib.h lua.h auxlib.h
+opcode.o: opcode.c luadebug.h lua.h luamem.h opcode.h types.h tree.h \
+ func.h hash.h inout.h table.h fallback.h auxlib.h lex.h zio.h
+parser.o: parser.c luadebug.h lua.h luamem.h lex.h zio.h opcode.h \
+ types.h tree.h func.h hash.h inout.h table.h
+strlib.o: strlib.c lua.h auxlib.h lualib.h
+table.o: table.c luamem.h auxlib.h lua.h func.h types.h tree.h \
+ opcode.h hash.h table.h inout.h fallback.h luadebug.h
+tree.o: tree.c luamem.h lua.h tree.h types.h lex.h zio.h hash.h \
+ opcode.h func.h table.h fallback.h
+undump.o: undump.c auxlib.h lua.h opcode.h types.h tree.h func.h \
+ luamem.h table.h undump.h zio.h
+y.tab.o: y.tab.c luadebug.h lua.h luamem.h lex.h zio.h opcode.h \
+ types.h tree.h func.h hash.h inout.h table.h
+zio.o: zio.c zio.h

mathlib.c

@@ -3,12 +3,13 @@
 ** Mathematics library to LUA
 */
 
-char *rcs_mathlib="$Id: mathlib.c,v 1.17 1996/04/30 21:13:55 roberto Exp roberto $";
+char *rcs_mathlib="$Id: mathlib.c,v 1.24 1997/06/09 17:30:10 roberto Exp roberto $";
 
 #include <stdlib.h>
 #include <math.h>
 
 #include "lualib.h"
+#include "auxlib.h"
 #include "lua.h"
 
 #ifndef PI
@@ -19,7 +20,7 @@ char *rcs_mathlib="$Id: mathlib.c,v 1.17 1996/04/30 21:13:55 roberto Exp roberto
 
 static void math_abs (void)
 {
- double d = lua_check_number(1, "abs"); 
+ double d = luaL_check_number(1); 
  if (d < 0) d = -d;
  lua_pushnumber (d);
 }
@@ -27,7 +28,7 @@ static void math_abs (void)
 
 static void math_sin (void)
 {
- double d = lua_check_number(1, "sin");
+ double d = luaL_check_number(1);
  lua_pushnumber (sin(TORAD(d)));
 }
 
@@ -35,7 +36,7 @@ static void math_sin (void)
 
 static void math_cos (void)
 {
- double d = lua_check_number(1, "cos");
+ double d = luaL_check_number(1);
  lua_pushnumber (cos(TORAD(d)));
 }
 
@@ -43,98 +44,82 @@ static void math_cos (void)
 
 static void math_tan (void)
 {
- double d = lua_check_number(1, "tan");
+ double d = luaL_check_number(1);
  lua_pushnumber (tan(TORAD(d)));
 }
 
 
 static void math_asin (void)
 {
- double d = lua_check_number(1, "asin");
+ double d = luaL_check_number(1);
  lua_pushnumber (TODEGREE(asin(d)));
 }
 
 
 static void math_acos (void)
 {
- double d = lua_check_number(1, "acos");
+ double d = luaL_check_number(1);
  lua_pushnumber (TODEGREE(acos(d)));
 }
 
 
 static void math_atan (void)
 {
- double d = lua_check_number(1, "atan");
+ double d = luaL_check_number(1);
  lua_pushnumber (TODEGREE(atan(d)));
 }
 
 
 static void math_atan2 (void)
 {
- double d1 = lua_check_number(1, "atan2");
- double d2 = lua_check_number(2, "atan2");
+ double d1 = luaL_check_number(1);
+ double d2 = luaL_check_number(2);
  lua_pushnumber (TODEGREE(atan2(d1, d2)));
 }
 
 
 static void math_ceil (void)
 {
- double d = lua_check_number(1, "ceil");
+ double d = luaL_check_number(1);
  lua_pushnumber (ceil(d));
 }
 
 
 static void math_floor (void)
 {
- double d = lua_check_number(1, "floor");
+ double d = luaL_check_number(1);
  lua_pushnumber (floor(d));
 }
 
 static void math_mod (void)
 {
-  float x = lua_check_number(1, "mod");
-  float y = lua_check_number(2, "mod");
+  float x = luaL_check_number(1);
+  float y = luaL_check_number(2);
   lua_pushnumber(fmod(x, y));
 }
 
 
 static void math_sqrt (void)
 {
- double d = lua_check_number(1, "sqrt");
+ double d = luaL_check_number(1);
  lua_pushnumber (sqrt(d));
 }
 
-static int old_pow;
 
 static void math_pow (void)
 {
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- lua_Object op = lua_getparam(3);
- if (!lua_isnumber(o1) || !lua_isnumber(o2) || *(lua_getstring(op)) != 'p')
- {
-   lua_Object old = lua_getref(old_pow);
-   lua_pushobject(o1);
-   lua_pushobject(o2);
-   lua_pushobject(op);
-   if (lua_callfunction(old) != 0)
-     lua_error(NULL);
- }
- else
- {
-   double d1 = lua_getnumber(o1);
-   double d2 = lua_getnumber(o2);
-   lua_pushnumber (pow(d1,d2));
- }
+  double d1 = luaL_check_number(1);
+  double d2 = luaL_check_number(2);
+  lua_pushnumber(pow(d1,d2));
 }
 
 static void math_min (void)
 {
  int i=1;
- double dmin = lua_check_number(i, "min");
+ double dmin = luaL_check_number(i);
  while (lua_getparam(++i) != LUA_NOOBJECT)
  {
-  double d = lua_check_number(i, "min");
+  double d = luaL_check_number(i);
   if (d < dmin) dmin = d;
  }
  lua_pushnumber (dmin);
@@ -143,10 +128,10 @@ static void math_min (void)
 static void math_max (void)
 {
  int i=1;
- double dmax = lua_check_number(i, "max");
+ double dmax = luaL_check_number(i);
  while (lua_getparam(++i) != LUA_NOOBJECT)
  {
-  double d = lua_check_number(i, "max");
+  double d = luaL_check_number(i);
   if (d > dmax) dmax = d;
  }
  lua_pushnumber (dmax);
@@ -154,33 +139,33 @@ static void math_max (void)
 
 static void math_log (void)
 {
- double d = lua_check_number(1, "log");
+ double d = luaL_check_number(1);
  lua_pushnumber (log(d));
 }
 
 
 static void math_log10 (void)
 {
- double d = lua_check_number(1, "log10");
+ double d = luaL_check_number(1);
  lua_pushnumber (log10(d));
 }
 
 
 static void math_exp (void)
 {
- double d = lua_check_number(1, "exp");
+ double d = luaL_check_number(1);
  lua_pushnumber (exp(d));
 }
 
 static void math_deg (void)
 {
- float d = lua_check_number(1, "deg");
+ float d = luaL_check_number(1);
  lua_pushnumber (d*180./PI);
 }
 
 static void math_rad (void)
 {
- float d = lua_check_number(1, "rad");
+ float d = luaL_check_number(1);
  lua_pushnumber (d/180.*PI);
 }
 
@@ -191,11 +176,11 @@ static void math_random (void)
 
 static void math_randomseed (void)
 {
-  srand(lua_check_number(1, "randomseed"));
+  srand(luaL_check_number(1));
 }
 
 
-static struct lua_reg mathlib[] = {
+static struct luaL_reg mathlib[] = {
 {"abs",   math_abs},
 {"sin",   math_sin},
 {"cos",   math_cos},
@@ -224,7 +209,9 @@ static struct lua_reg mathlib[] = {
 */
 void mathlib_open (void)
 {
-  luaI_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
-  old_pow = lua_refobject(lua_setfallback("arith", math_pow), 1);
+  luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
+  lua_pushcfunction(math_pow);
+  lua_pushnumber(0);  /* to get its tag */
+  lua_settagmethod(lua_tag(lua_pop()), "pow");
 }
 

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.23 1996/09/26 21:08:41 roberto Exp roberto $
+** $Id: opcode.h,v 3.33 1997/04/11 21:34:53 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -14,6 +14,28 @@
 
 #define FIELDS_PER_FLUSH 40
 
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER LUA_T"
+*/
+typedef enum
+{
+ LUA_T_NIL      = -9,
+ LUA_T_NUMBER   = -8,
+ LUA_T_STRING   = -7,
+ LUA_T_ARRAY    = -6,  /* array==table */
+ LUA_T_FUNCTION = -5,
+ LUA_T_CFUNCTION= -4,
+ LUA_T_MARK     = -3,
+ LUA_T_CMARK    = -2,
+ LUA_T_LINE     = -1,
+ LUA_T_USERDATA = 0
+} lua_Type;
+
+#define NUM_TYPES 10
+
+
+extern char *luaI_typenames[];
 
 typedef enum {
 /* name          parm    before          after           side effect
@@ -38,7 +60,7 @@ PUSHLOCAL6,/*		-		LOC[6]  */
 PUSHLOCAL7,/*		-		LOC[7]  */
 PUSHLOCAL8,/*		-		LOC[8]  */
 PUSHLOCAL9,/*		-		LOC[9]  */
-PUSHLOCAL,/*	w	-		LOC[w]  */
+PUSHLOCAL,/*	b	-		LOC[b]  */
 PUSHGLOBAL,/*	w	-		VAR[w]  */
 PUSHINDEXED,/*		i t		t[i]  */
 PUSHSELF,/*	w	t		t t[STR[w]]  */
@@ -52,14 +74,14 @@ STORELOCAL6,/*		x		-		LOC[6]=x  */
 STORELOCAL7,/*		x		-		LOC[7]=x  */
 STORELOCAL8,/*		x		-		LOC[8]=x  */
 STORELOCAL9,/*		x		-		LOC[9]=x  */
-STORELOCAL,/*	w	x		-		LOC[w]=x  */
+STORELOCAL,/*	b	x		-		LOC[b]=x  */
 STOREGLOBAL,/*	w	x		-		VAR[w]=x  */
 STOREINDEXED0,/*	v i t		-		t[i]=v  */
 STOREINDEXED,/*	b	v a_b...a_1 i t	a_b...a_1 i t	t[i]=v  */
-STORELIST0,/*	w	v_w...v_1 t	-		t[i]=v_i  */
-STORELIST,/*	w n	v_w...v_1 t	-		t[i+n*FPF]=v_i  */
-STORERECORD,/*	n
-		w_n...w_1 v_n...v_1 t	-		t[STR[w_i]]=v_i  */
+STORELIST0,/*	b	v_b...v_1 t	-		t[i]=v_i  */
+STORELIST,/*	b c	v_b...v_1 t	-		t[i+c*FPF]=v_i  */
+STORERECORD,/*	b
+		w_b...w_1 v_b...v_1 t	-		t[STR[w_i]]=v_i  */
 ADJUST0,/*		-		-		TOP=BASE  */
 ADJUST,/*	b	-		-		TOP=BASE+b  */
 CREATEARRAY,/*	w	-		newarray(size = w)  */
@@ -76,19 +98,19 @@ POWOP,/*		y x		x^y  */
 CONCOP,/*		y x		x..y  */
 MINUSOP,/*		x		-x  */
 NOTOP,/*		x		(x==nil)? 1 : nil  */
-ONTJMP,/*		w	x	-		(x!=nil)? PC+=w  */
-ONFJMP,/*		w	x	-		(x==nil)? PC+=w  */
+ONTJMP,/*	w	x		-		(x!=nil)? PC+=w  */
+ONFJMP,/*	w	x		-		(x==nil)? PC+=w  */
 JMP,/*		w	-		-		PC+=w  */
-UPJMP,/*		w	-	-		PC-=w  */
-IFFJMP,/*		w	x	-		(x==nil)? PC+=w  */
+UPJMP,/*	w	-		-		PC-=w  */
+IFFJMP,/*	w	x		-		(x==nil)? PC+=w  */
 IFFUPJMP,/*	w	x		-		(x==nil)? PC-=w  */
 POP,/*			x		-  */
-CALLFUNC,/*	n m	v_n...v_1 f	r_m...r_1	f(v1,...,v_n)  */
+CALLFUNC,/*	b c	v_b...v_1 f	r_c...r_1	f(v1,...,v_b)  */
 RETCODE0,
 RETCODE,/*	b	-		-  */
 SETLINE,/*	w	-		-		LINE=w  */
-VARARGS/*	b	v_n...v_1	{v_1...v_n;n=n}  */
-
+VARARGS,/*	b	v_b...v_1	{v_1...v_b;n=b}  */
+STOREMAP/*	b	v_b k_b ...v_1 k_1 t	-	t[k_i]=v_i  */
 } OpCode;
 
 
@@ -102,29 +124,27 @@ typedef union
  TaggedString *ts;
  TFunc         *tf;
  struct Hash    *a;
- void           *u;
  int	       i;
 } Value;
 
-typedef struct Object
+typedef struct TObject
 {
- lua_Type  tag;
+ lua_Type ttype;
  Value value;
-} Object;
+} TObject;
 
 
 /* Macros to access structure members */
-#define tag(o)		((o)->tag)
+#define ttype(o)	((o)->ttype)
 #define nvalue(o)	((o)->value.n)
 #define svalue(o)	((o)->value.ts->str)
 #define tsvalue(o)	((o)->value.ts)
 #define avalue(o)	((o)->value.a)
 #define fvalue(o)	((o)->value.f)
-#define uvalue(o)	((o)->value.u)
 
 /* Macros to access symbol table */
 #define s_object(i)	(lua_table[i].object)
-#define s_tag(i)	(tag(&s_object(i)))
+#define s_ttype(i)	(ttype(&s_object(i)))
 #define s_nvalue(i)	(nvalue(&s_object(i)))
 #define s_svalue(i)	(svalue(&s_object(i)))
 #define s_tsvalue(i)	(tsvalue(&s_object(i)))
@@ -141,10 +161,11 @@ typedef struct Object
 /* Exported functions */
 void    lua_parse      (TFunc *tf);	/* from "lua.stx" module */
 void	luaI_codedebugline (int line);  /* from "lua.stx" module */
-void    lua_travstack (int (*fn)(Object *));
-Object *luaI_Address (lua_Object o);
-void	luaI_pushobject (Object *o);
-void    luaI_gcFB       (Object *o);
+void    lua_travstack (int (*fn)(TObject *));
+TObject *luaI_Address (lua_Object o);
+void	luaI_pushobject (TObject *o);
+void    luaI_gcIM       (TObject *o);
 int     luaI_dorun (TFunc *tf);
+int     lua_domain (void);
 
 #endif

strlib.c

@@ -3,7 +3,7 @@
 ** String library to LUA
 */
 
-char *rcs_strlib="$Id: strlib.c,v 1.32 1996/11/07 20:26:19 roberto Exp roberto $";
+char *rcs_strlib="$Id: strlib.c,v 1.45 1997/06/19 17:45:28 roberto Exp roberto $";
 
 #include <string.h>
 #include <stdio.h>
@@ -11,6 +11,7 @@ char *rcs_strlib="$Id: strlib.c,v 1.32 1996/11/07 20:26:19 roberto Exp roberto $
 #include <ctype.h>
 
 #include "lua.h"
+#include "auxlib.h"
 #include "lualib.h"
 
 
@@ -23,7 +24,7 @@ struct lbuff {
 static struct lbuff lbuffer = {NULL, 0, 0};
 
 
-static char *lua_strbuffer (unsigned long size)
+static char *strbuffer (unsigned long size)
 {
   if (size > lbuffer.max) {
     /* ANSI "realloc" doesn't need this test, but some machines (Sun!)
@@ -38,55 +39,24 @@ static char *lua_strbuffer (unsigned long size)
 
 static char *openspace (unsigned long size)
 {
-  char *buff = lua_strbuffer(lbuffer.size+size);
+  char *buff = strbuffer(lbuffer.size+size);
   return buff+lbuffer.size;
 }
 
-void lua_arg_check(int cond, char *funcname)
-{
-  if (!cond) {
-    char buff[100];
-    sprintf(buff, "incorrect argument to function `%s'", funcname);
-    lua_error(buff);
-  }
-}
-
-char *lua_check_string (int numArg, char *funcname)
-{
-  lua_Object o = lua_getparam(numArg);
-  lua_arg_check(lua_isstring(o), funcname);
-  return lua_getstring(o);
-}
-
-char *lua_opt_string (int numArg, char *def, char *funcname)
-{
-  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
-                              lua_check_string(numArg, funcname);
-}
-
-double lua_check_number (int numArg, char *funcname)
-{
-  lua_Object o = lua_getparam(numArg);
-  lua_arg_check(lua_isnumber(o), funcname);
-  return lua_getnumber(o);
-}
-
-long lua_opt_number (int numArg, long def, char *funcname)
-{
-  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
-                              (long)lua_check_number(numArg, funcname);
-}
-
 char *luaI_addchar (int c)
 {
   if (lbuffer.size >= lbuffer.max)
-    lua_strbuffer(lbuffer.max == 0 ? 100 : lbuffer.max*2);
+    strbuffer(lbuffer.max == 0 ? 100 : lbuffer.max*2);
   lbuffer.b[lbuffer.size++] = c;
-  if (c == 0)
-    lbuffer.size = 0;  /* prepare for next string */
   return lbuffer.b;
 }
 
+void luaI_emptybuff (void)
+{
+  lbuffer.size = 0;  /* prepare for next string */
+}
+
+
 static void addnchar (char *s, int n)
 {
   char *b = openspace(n);
@@ -99,35 +69,13 @@ static void addstr (char *s)
   addnchar(s, strlen(s));
 }
 
-/*
-** Interface to strtok
-*/
-static void str_tok (void)
-{
-  char *s1 = lua_check_string(1, "strtok");
-  char *del = lua_check_string(2, "strtok");
-  lua_Object t = lua_createtable();
-  int i = 1;
-  /* As strtok changes s1, and s1 is "constant",  make a copy of it */
-  s1 = strcpy(lua_strbuffer(strlen(s1+1)), s1);
-  while ((s1 = strtok(s1, del)) != NULL) {
-    lua_pushobject(t);
-    lua_pushnumber(i++);
-    lua_pushstring(s1);
-    lua_storesubscript();
-    s1 = NULL;  /* prepare for next strtok */
-  }
-  lua_pushobject(t);
-  lua_pushnumber(i-1);  /* total number of tokens */
-}
-
 
 /*
 ** Return the string length
 */
 static void str_len (void)
 {
- lua_pushnumber(strlen(lua_check_string(1, "strlen")));
+ lua_pushnumber(strlen(luaL_check_string(1)));
 }
 
 /*
@@ -135,15 +83,18 @@ static void str_len (void)
 */
 static void str_sub (void)
 {
-  char *s = lua_check_string(1, "strsub");
-  long start = (long)lua_check_number(2, "strsub");
-  long end = lua_opt_number(3, strlen(s), "strsub");
-  if (1 <= start && start <= end && end <= strlen(s)) {
-    luaI_addchar(0);
+  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) {
+    luaI_emptybuff();
     addnchar(s+start-1, end-start+1);
     lua_pushstring(luaI_addchar(0));
   }
-  else lua_pushliteral("");
+  else lua_pushstring("");
 }
 
 /*
@@ -151,10 +102,10 @@ static void str_sub (void)
 */
 static void str_lower (void)
 {
-  char *s = lua_check_string(1, "strlower");
-  luaI_addchar(0);
-  while (*s)
-    luaI_addchar(tolower(*s++));
+  char *s;
+  luaI_emptybuff();
+  for (s = luaL_check_string(1); *s; s++)
+    luaI_addchar(tolower((unsigned char)*s));
   lua_pushstring(luaI_addchar(0));
 }
 
@@ -163,18 +114,18 @@ static void str_lower (void)
 */
 static void str_upper (void)
 {
-  char *s = lua_check_string(1, "strupper");
-  luaI_addchar(0);
-  while (*s)
-    luaI_addchar(toupper(*s++));
+  char *s;
+  luaI_emptybuff();
+  for (s = luaL_check_string(1); *s; s++)
+    luaI_addchar(toupper((unsigned char)*s));
   lua_pushstring(luaI_addchar(0));
 }
 
 static void str_rep (void)
 {
-  char *s = lua_check_string(1, "strrep");
-  int n = (int)lua_check_number(2, "strrep");
-  luaI_addchar(0);
+  char *s = luaL_check_string(1);
+  int n = (int)luaL_check_number(2);
+  luaI_emptybuff();
   while (n-- > 0)
     addstr(s);
   lua_pushstring(luaI_addchar(0));
@@ -185,9 +136,9 @@ static void str_rep (void)
 */
 static void str_ascii (void)
 {
-  char *s = lua_check_string(1, "ascii");
-  long pos = lua_opt_number(2, 1, "ascii") - 1;
-  lua_arg_check(0<=pos && pos<strlen(s), "ascii");
+  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]);
 }
 
@@ -195,23 +146,23 @@ static void str_ascii (void)
 /* pattern matching */
 
 #define ESC	'%'
-#define SPECIALS  "^$*?.([%"
+#define SPECIALS  "^$*?.([%-"
 
 static char *bracket_end (char *p)
 {
   return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
 }
 
-char *item_end (char *p)
+char *luaL_item_end (char *p)
 {
   switch (*p++) {
     case '\0': return p-1;
     case ESC:
-      if (*p == 0) lua_error("incorrect pattern");
+      if (*p == 0) luaL_verror("incorrect pattern (ends with `%c')", ESC);
       return p+1;
     case '[': {
       char *end = bracket_end(p);
-      if (end == NULL) lua_error("incorrect pattern");
+      if (end == NULL) lua_error("incorrect pattern (missing `]')");
       return end+1;
     }
     default:
@@ -222,21 +173,21 @@ char *item_end (char *p)
 static int matchclass (int c, int cl)
 {
   int res;
-  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;
+  switch (tolower((unsigned char)cl)) {
+    case 'a' : res = isalpha((unsigned char)c); break;
+    case 'c' : res = iscntrl((unsigned char)c); break;
+    case 'd' : res = isdigit((unsigned char)c); break;
+    case 'l' : res = islower((unsigned char)c); break;
+    case 'p' : res = ispunct((unsigned char)c); break;
+    case 's' : res = isspace((unsigned char)c); break;
+    case 'u' : res = isupper((unsigned char)c); break;
+    case 'w' : res = isalnum((unsigned char)c); break;
     default: return (cl == c);
   }
-  return (islower(cl) ? res : !res);
+  return (islower((unsigned char)cl) ? res : !res);
 }
 
-int singlematch (int c, char *p)
+int luaL_singlematch (int c, char *p)
 {
   if (c == 0) return 0;
   switch (*p) {
@@ -333,7 +284,7 @@ static char *match (char *s, char *p, int level)
       return res;
     }
     case ESC:
-      if (isdigit(*(p+1))) {  /* capture */
+      if (isdigit((unsigned char)(*(p+1)))) {  /* capture */
         int l = check_cap(*(p+1), level);
         if (strncmp(capture[l].init, s, capture[l].len) == 0) {
           /* return match(p+2, s+capture[l].len, level); */
@@ -358,8 +309,8 @@ static char *match (char *s, char *p, int level)
       }
       else goto dflt;
     default: dflt: {  /* it is a pattern item */
-      int m = singlematch(*s, p);
-      char *ep = item_end(p);  /* get what is next */
+      int m = luaL_singlematch(*s, p);
+      char *ep = luaL_item_end(p);  /* get what is next */
       switch (*ep) {
         case '*': {  /* repetition */
           char *res;
@@ -367,6 +318,17 @@ static char *match (char *s, char *p, int level)
             return res;
           p=ep+1; goto init;  /* else return match(s, ep+1, level); */
         }
+        case '-': {  /* repetition */
+          char *res;
+          if ((res = match(s, ep+1, level)) != 0)
+            return res;
+          else if (m) {
+            s++;
+            goto init;  /* return match(s+1, p, level); */
+          }
+          else
+            return NULL;
+        }
         case '?': {  /* optional */
           char *res;
           if (m && (res = match(s+1, ep+1, level)))
@@ -383,10 +345,10 @@ static char *match (char *s, char *p, int level)
 
 static void str_find (void)
 {
-  char *s = lua_check_string(1, "strfind");
-  char *p = lua_check_string(2, "strfind");
-  long init = lua_opt_number(3, 1, "strfind") - 1;
-  lua_arg_check(0 <= init && init <= strlen(s), "strfind");
+  char *s = luaL_check_string(1);
+  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");
   if (lua_getparam(4) != LUA_NOOBJECT || 
       strpbrk(p, SPECIALS) == NULL) {  /* no special caracters? */
     char *s2 = strstr(s+init, p);
@@ -410,12 +372,12 @@ static void str_find (void)
   }
 }
 
-static void add_s (lua_Object newp)
+static void add_s (lua_Object newp, lua_Object table, int n)
 {
   if (lua_isstring(newp)) {
     char *news = lua_getstring(newp);
     while (*news) {
-      if (*news != ESC || !isdigit(*++news))
+      if (*news != ESC || !isdigit((unsigned char)*++news))
         luaI_addchar(*news++);
       else {
         int l = check_cap(*news++, num_captures);
@@ -426,41 +388,50 @@ static void add_s (lua_Object newp)
   else if (lua_isfunction(newp)) {
     lua_Object res;
     struct lbuff oldbuff;
+    int status;
     lua_beginblock();
+    if (lua_istable(table)) {
+      lua_pushobject(table);
+      lua_pushnumber(n);
+    }
     push_captures();
     /* function may use lbuffer, so save it and create a new one */
     oldbuff = lbuffer;
     lbuffer.b = NULL; lbuffer.max = lbuffer.size = 0;
-    lua_callfunction(newp);
+    status = lua_callfunction(newp);
     /* restore old buffer */
     free(lbuffer.b);
     lbuffer = oldbuff;
+    if (status != 0)
+      lua_error(NULL);
     res = lua_getresult(1);
     addstr(lua_isstring(res) ? lua_getstring(res) : "");
     lua_endblock();
   }
-  else lua_arg_check(0, "gsub");
+  else luaL_arg_check(0, 3, NULL);
 }
 
 static void str_gsub (void)
 {
-  char *src = lua_check_string(1, "gsub");
-  char *p = lua_check_string(2, "gsub");
+  char *src = luaL_check_string(1);
+  char *p = luaL_check_string(2);
   lua_Object newp = lua_getparam(3);
-  int max_s = lua_opt_number(4, strlen(src), "gsub");
+  lua_Object table = lua_getparam(4);
+  int max_s = (int)luaL_opt_number(lua_istable(table)?5:4, strlen(src)+1);
   int anchor = (*p == '^') ? (p++, 1) : 0;
   int n = 0;
-  luaI_addchar(0);
-  while (*src && n < max_s) {
-    char *e;
-    if ((e=match(src, p, 0)) == NULL)
-      luaI_addchar(*src++);
-    else {
-      if (e == src) lua_error("empty pattern in substitution");
-      add_s(newp);
-      src = e;
+  luaI_emptybuff();
+  while (n < max_s) {
+    char *e = match(src, p, 0);
+    if (e) {
       n++;
+      add_s(newp, table, n);
     }
+    if (e && e>src) /* non empty match? */
+      src = e;  /* skip it */
+    else if (*src)
+      luaI_addchar(*src++);
+    else break;
     if (anchor) break;
   }
   addstr(src);
@@ -470,12 +441,12 @@ static void str_gsub (void)
 
 static void str_set (void)
 {
-  char *item = lua_check_string(1, "strset");
+  char *item = luaL_check_string(1);
   int i;
-  lua_arg_check(*item_end(item) == 0, "strset");
-  luaI_addchar(0);
+  luaL_arg_check(*luaL_item_end(item) == 0, 1, "wrong format");
+  luaI_emptybuff();
   for (i=1; i<256; i++)  /* 0 cannot be part of a set */
-    if (singlematch(i, item))
+    if (luaL_singlematch(i, item))
       luaI_addchar(i);
   lua_pushstring(luaI_addchar(0));
 }
@@ -497,8 +468,8 @@ void luaI_addquoted (char *s)
 static void str_format (void)
 {
   int arg = 1;
-  char *strfrmt = lua_check_string(arg++, "format");
-  luaI_addchar(0);  /* initialize */
+  char *strfrmt = luaL_check_string(arg++);
+  luaI_emptybuff();  /* initialize */
   while (*strfrmt) {
     if (*strfrmt != '%')
       luaI_addchar(*strfrmt++);
@@ -510,26 +481,26 @@ static void str_format (void)
       char *initf = strfrmt-1;  /* -1 to include % */
       strfrmt = match(strfrmt, "[-+ #]*(%d*)%.?(%d*)", 0);
       if (capture[0].len > 3 || capture[1].len > 3)  /* < 1000? */
-        lua_error("invalid format (width/precision too long)");
+        lua_error("invalid format (width or precision too long)");
       strncpy(form, initf, strfrmt-initf+1); /* +1 to include convertion */
       form[strfrmt-initf+1] = 0;
       buff = openspace(1000);  /* to store the formated value */
       switch (*strfrmt++) {
         case 'q':
-          luaI_addquoted(lua_check_string(arg++, "format"));
+          luaI_addquoted(luaL_check_string(arg++));
           continue;
         case 's': {
-          char *s = lua_check_string(arg++, "format");
+          char *s = luaL_check_string(arg++);
           buff = openspace(strlen(s));
           sprintf(buff, form, s);
           break;
         }
         case 'c':  case 'd':  case 'i': case 'o':
         case 'u':  case 'x':  case 'X':
-          sprintf(buff, form, (int)lua_check_number(arg++, "format"));
+          sprintf(buff, form, (int)luaL_check_number(arg++));
           break;
         case 'e':  case 'E': case 'f': case 'g':
-          sprintf(buff, form, lua_check_number(arg++, "format"));
+          sprintf(buff, form, luaL_check_number(arg++));
           break;
         default:  /* also treat cases 'pnLlh' */
           lua_error("invalid format option in function `format'");
@@ -541,16 +512,7 @@ static void str_format (void)
 }
 
 
-void luaI_openlib (struct lua_reg *l, int n)
-{
-  int i;
-  for (i=0; i<n; i++)
-    lua_register(l[i].name, l[i].func);
-}
-
-
-static struct lua_reg strlib[] = {
-{"strtok", str_tok},
+static struct luaL_reg strlib[] = {
 {"strlen", str_len},
 {"strsub", str_sub},
 {"strset", str_set},
@@ -569,5 +531,5 @@ static struct lua_reg strlib[] = {
 */
 void strlib_open (void)
 {
-  luaI_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
+  luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
 }

table.c

@@ -3,9 +3,11 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.57 1996/07/12 20:00:26 roberto Exp roberto $";
+char *rcs_table="$Id: table.c,v 2.71 1997/06/09 17:28:14 roberto Exp roberto $";
 
-#include "mem.h"
+#include "luamem.h"
+#include "auxlib.h"
+#include "func.h"
 #include "opcode.h"
 #include "tree.h"
 #include "hash.h"
@@ -27,49 +29,14 @@ Word lua_nconstant = 0;
 static Long lua_maxconstant = 0;
 
 
-#define GARBAGE_BLOCK 50
-
-static void lua_nextvar (void);
-
-/*
-** Internal functions
-*/
-static struct {
-  char *name;
-  lua_CFunction func;
-} int_funcs[] = {
-  {"assert", luaI_assert},
-  {"call", luaI_call},
-  {"dofile", lua_internaldofile},
-  {"dostring", lua_internaldostring},
-  {"error", luaI_error},
-  {"getglobal", luaI_getglobal},
-  {"next", lua_next},
-  {"nextvar", lua_nextvar},
-  {"print", luaI_print},
-  {"setfallback", luaI_setfallback},
-  {"setglobal", luaI_setglobal},
-  {"tonumber", lua_obj2number},
-  {"tostring", luaI_tostring},
-  {"type", luaI_type}
-};
-
-#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+#define GARBAGE_BLOCK 100
 
 
 void luaI_initsymbol (void)
 {
-  int i;
-  Word n;
   lua_maxsymbol = BUFFER_BLOCK;
   lua_table = newvector(lua_maxsymbol, Symbol);
-  for (i=0; i<INTFUNCSIZE; i++)
-  {
-    n = luaI_findsymbolbyname(int_funcs[i].name);
-    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
-  }
-  n = luaI_findsymbolbyname("_VERSION_");
-  s_tag(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
+  luaI_predefine();
 }
 
 
@@ -92,17 +59,17 @@ void luaI_initconstant (void)
 */
 Word luaI_findsymbol (TaggedString *t)
 {
- if (t->varindex == NOT_USED)
+ if (t->u.s.varindex == NOT_USED)
  {
   if (lua_ntable == lua_maxsymbol)
     lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol,
                       symbolEM, MAX_WORD);
-  t->varindex = lua_ntable;
+  t->u.s.varindex = lua_ntable;
   lua_table[lua_ntable].varname = t;
-  s_tag(lua_ntable) = LUA_T_NIL;
+  s_ttype(lua_ntable) = LUA_T_NIL;
   lua_ntable++;
  }
- return t->varindex;
+ return t->u.s.varindex;
 }
 
 
@@ -118,16 +85,16 @@ Word luaI_findsymbolbyname (char *name)
 */
 Word luaI_findconstant (TaggedString *t)
 {
- if (t->constindex == NOT_USED)
+ if (t->u.s.constindex == NOT_USED)
  {
   if (lua_nconstant == lua_maxconstant)
     lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *,
                         constantEM, MAX_WORD);
-  t->constindex = lua_nconstant;
+  t->u.s.constindex = lua_nconstant;
   lua_constant[lua_nconstant] = t;
   lua_nconstant++;
  }
- return t->constindex;
+ return t->u.s.constindex;
 }
 
 
@@ -145,10 +112,16 @@ TaggedString *luaI_createfixedstring (char *name)
 }
 
 
+int luaI_globaldefined (char *name)
+{
+  return ttype(&lua_table[luaI_findsymbolbyname(name)].object) != LUA_T_NIL;
+}
+
+
 /*
 ** Traverse symbol table objects
 */
-static char *lua_travsymbol (int (*fn)(Object *))
+static char *lua_travsymbol (int (*fn)(TObject *))
 {
  Word i;
  for (i=0; i<lua_ntable; i++)
@@ -161,13 +134,14 @@ static char *lua_travsymbol (int (*fn)(Object *))
 /*
 ** Mark an object if it is a string or a unmarked array.
 */
-int lua_markobject (Object *o)
+int lua_markobject (TObject *o)
 {/* if already marked, does not change mark value */
- if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
+ if (ttype(o) == LUA_T_USERDATA ||
+     (ttype(o) == LUA_T_STRING && !tsvalue(o)->marked))
    tsvalue(o)->marked = 1;
- else if (tag(o) == LUA_T_ARRAY)
+ else if (ttype(o) == LUA_T_ARRAY)
    lua_hashmark (avalue(o));
- else if ((o->tag == LUA_T_FUNCTION || o->tag == LUA_T_MARK)
+ else if ((o->ttype == LUA_T_FUNCTION || o->ttype == LUA_T_MARK)
            && !o->value.tf->marked)
    o->value.tf->marked = 1;
  return 0;
@@ -176,11 +150,11 @@ int lua_markobject (Object *o)
 /*
 * returns 0 if the object is going to be (garbage) collected
 */
-int luaI_ismarked (Object *o)
+int luaI_ismarked (TObject *o)
 {
-  switch (o->tag)
+  switch (o->ttype)
   {
-   case LUA_T_STRING:
+   case LUA_T_STRING: case LUA_T_USERDATA:
      return o->value.ts->marked;
    case LUA_T_FUNCTION:
     return o->value.tf->marked;
@@ -192,76 +166,90 @@ int luaI_ismarked (Object *o)
 }
 
 
+static void call_nilIM (void)
+{ /* signals end of garbage collection */
+  TObject t;
+  ttype(&t) = LUA_T_NIL;
+  luaI_gcIM(&t);  /* end of list */
+}
+
 /*
 ** Garbage collection. 
 ** Delete all unused strings and arrays.
 */
-Long luaI_collectgarbage (void)
+static long gc_block = GARBAGE_BLOCK;
+static long gc_nentity = 0;  /* total of strings, arrays, etc */
+
+static void markall (void)
 {
-  Long recovered = 0;
   lua_travstack(lua_markobject); /* mark stack objects */
   lua_travsymbol(lua_markobject); /* mark symbol table objects */
   luaI_travlock(lua_markobject); /* mark locked objects */
   luaI_travfallbacks(lua_markobject);  /* mark fallbacks */
+}
+
+
+long lua_collectgarbage (long limit)
+{
+  long recovered = 0;
+  Hash *freetable;
+  TaggedString *freestr;
+  TFunc *freefunc;
+  markall();
   luaI_invalidaterefs();
-  recovered += lua_strcollector();
-  recovered += lua_hashcollector();
-  recovered += luaI_funccollector();
+  freetable = luaI_hashcollector(&recovered);
+  freestr = luaI_strcollector(&recovered);
+  freefunc = luaI_funccollector(&recovered);
+  gc_nentity -= recovered;
+  gc_block = (limit == 0) ? 2*(gc_block-recovered) : gc_nentity+limit;
+  luaI_hashcallIM(freetable);
+  luaI_strcallIM(freestr);
+  call_nilIM();
+  luaI_hashfree(freetable);
+  luaI_strfree(freestr);
+  luaI_funcfree(freefunc);
   return recovered;
 } 
 
+
 void lua_pack (void)
 {
-  static unsigned long block = GARBAGE_BLOCK;
-  static unsigned long nentity = 0;  /* total of strings, arrays, etc */
-  unsigned long recovered = 0;
-  if (nentity++ < block) return;
-  recovered = luaI_collectgarbage();
-  block = 2*(block-recovered);
-  nentity -= recovered;
+  if (++gc_nentity >= gc_block)
+    lua_collectgarbage(0);
 } 
 
 
 /*
 ** Internal function: return next global variable
 */
-static void lua_nextvar (void)
+void luaI_nextvar (void)
 {
- Word next;
- lua_Object o = lua_getparam(1);
- if (o == LUA_NOOBJECT)
-   lua_error("too few arguments to function `nextvar'");
- if (lua_getparam(2) != LUA_NOOBJECT)
-   lua_error("too many arguments to function `nextvar'");
- if (lua_isnil(o))
-   next = 0;
- else if (!lua_isstring(o))
- {
-   lua_error("incorrect argument to function `nextvar'"); 
-   return;  /* to avoid warnings */
- }
- else
-   next = luaI_findsymbolbyname(lua_getstring(o)) + 1;
- while (next < lua_ntable && s_tag(next) == LUA_T_NIL) next++;
- if (next < lua_ntable)
- {
-  lua_pushstring(lua_table[next].varname->str);
-  luaI_pushobject(&s_object(next));
- }
+  Word next;
+  if (lua_isnil(lua_getparam(1)))
+    next = 0;
+  else 
+    next = luaI_findsymbolbyname(luaL_check_string(1)) + 1;
+  while (next < lua_ntable && s_ttype(next) == LUA_T_NIL)
+    next++;
+  if (next < lua_ntable) {
+    lua_pushstring(lua_table[next].varname->str);
+    luaI_pushobject(&s_object(next));
+  }
 }
 
 
-static Object *functofind;
-static int checkfunc (Object *o)
+static TObject *functofind;
+static int checkfunc (TObject *o)
 {
-  if (o->tag == LUA_T_FUNCTION)
+  if (o->ttype == LUA_T_FUNCTION)
     return
-       ((functofind->tag == LUA_T_FUNCTION || functofind->tag == LUA_T_MARK)
+       ((functofind->ttype == LUA_T_FUNCTION || functofind->ttype == LUA_T_MARK)
             && (functofind->value.tf == o->value.tf));
-  if (o->tag == LUA_T_CFUNCTION)
+  if (o->ttype == LUA_T_CFUNCTION)
     return
-       ((functofind->tag == LUA_T_CFUNCTION || functofind->tag == LUA_T_CMARK)
-            && (functofind->value.f == o->value.f));
+       ((functofind->ttype == LUA_T_CFUNCTION ||
+         functofind->ttype == LUA_T_CMARK) &&
+         (functofind->value.f == o->value.f));
   return 0;
 }
 
@@ -270,7 +258,7 @@ char *lua_getobjname (lua_Object o, char **name)
 { /* try to find a name for given function */
   functofind = luaI_Address(o);
   if ((*name = luaI_travfallbacks(checkfunc)) != NULL)
-    return "fallback";
+    return "tag-method";
   else if ((*name = lua_travsymbol(checkfunc)) != NULL)
     return "global";
   else return "";

table.h

@@ -1,7 +1,7 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.20 1996/03/14 15:57:19 roberto Exp roberto $
+** $Id: table.h,v 2.24 1997/04/07 14:48:53 roberto Exp roberto $
 */
 
 #ifndef table_h
@@ -12,7 +12,7 @@
 
 typedef struct
 {
- Object  object;
+ TObject  object;
  TaggedString *varname;
 } Symbol;
 
@@ -28,10 +28,11 @@ Word  luaI_findsymbolbyname (char *name);
 Word  luaI_findsymbol      (TaggedString *t);
 Word  luaI_findconstant    (TaggedString *t);
 Word  luaI_findconstantbyname (char *name);
+int luaI_globaldefined (char *name);
+void luaI_nextvar (void);
 TaggedString *luaI_createfixedstring  (char *str);
-int   lua_markobject      (Object *o);
-int luaI_ismarked (Object *o);
-Long luaI_collectgarbage (void);
+int   lua_markobject      (TObject *o);
+int luaI_ismarked (TObject *o);
 void  lua_pack            (void);
 
 

tree.c

@@ -3,17 +3,18 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: tree.c,v 1.19 1996/02/22 20:34:33 roberto Exp $";
+char *rcs_tree="$Id: tree.c,v 1.27 1997/06/09 17:28:14 roberto Exp roberto $";
 
 
 #include <string.h>
 
-#include "mem.h"
+#include "luamem.h"
 #include "lua.h"
 #include "tree.h"
 #include "lex.h"
 #include "hash.h"
 #include "table.h"
+#include "fallback.h"
 
 
 #define NUM_HASHS  64
@@ -28,23 +29,43 @@ static int initialized = 0;
 
 static stringtable string_root[NUM_HASHS];
 
-static TaggedString EMPTY = {NOT_USED, NOT_USED, 0, 2, {0}};
+static TaggedString EMPTY = {LUA_T_STRING, NULL, {{NOT_USED, NOT_USED}},
+                             0, 2, {0}};
 
 
-static unsigned long hash (char *str)
+static unsigned long hash (char *s, int tag)
 {
-  unsigned long h = 0;
-  while (*str)
-    h = ((h<<5)-h)^(unsigned char)*(str++);
+  unsigned long h;
+  if (tag != LUA_T_STRING)
+    h = (unsigned long)s;
+  else {
+    h = 0;
+    while (*s)
+      h = ((h<<5)-h)^(unsigned char)*(s++);
+  }
   return h;
 }
 
+
+static void luaI_inittree (void)
+{
+  int i;
+  for (i=0; i<NUM_HASHS; i++) {
+    string_root[i].size = 0;
+    string_root[i].nuse = 0;
+    string_root[i].hash = NULL;
+  }
+}
+
+
 static void initialize (void)
 {
   initialized = 1;
+  luaI_inittree();
   luaI_addReserved();
   luaI_initsymbol();
   luaI_initconstant();
+  luaI_initfallbacks();
 }
 
 
@@ -58,8 +79,7 @@ static void grow (stringtable *tb)
   /* rehash */
   tb->nuse = 0;
   for (i=0; i<tb->size; i++)
-    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
-    {
+    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
       int h = tb->hash[i]->hash%newsize;
       while (newhash[h])
         h = (h+1)%newsize;
@@ -71,10 +91,30 @@ static void grow (stringtable *tb)
   tb->hash = newhash;
 }
 
-static TaggedString *insert (char *str, stringtable *tb)
+
+static TaggedString *newone(char *buff, int tag, unsigned long h)
 {
   TaggedString *ts;
-  unsigned long h = hash(str);
+  if (tag == LUA_T_STRING) {
+    ts = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(buff));
+    strcpy(ts->str, buff);
+    ts->u.s.varindex = ts->u.s.constindex = NOT_USED;
+    ts->tag = LUA_T_STRING;
+  }
+  else {
+    ts = (TaggedString *)luaI_malloc(sizeof(TaggedString));
+    ts->u.v = buff;
+    ts->tag = tag == LUA_ANYTAG ? 0 : tag;
+  }
+  ts->marked = 0;
+  ts->hash = h;
+  return ts;
+}
+
+static TaggedString *insert (char *buff, int tag, stringtable *tb)
+{
+  TaggedString *ts;
+  unsigned long h = hash(buff, tag);
   int i;
   int j = -1;
   if ((Long)tb->nuse*3 >= (Long)tb->size*2)
@@ -84,12 +124,14 @@ static TaggedString *insert (char *str, stringtable *tb)
     grow(tb);
   }
   i = h%tb->size;
-  while (tb->hash[i])
+  while ((ts = tb->hash[i]) != NULL)
   {
-    if (tb->hash[i] == &EMPTY)
+    if (ts == &EMPTY)
       j = i;
-    else if (strcmp(str, tb->hash[i]->str) == 0)
-      return tb->hash[i];
+    else if ((ts->tag == LUA_T_STRING) ?
+              (tag == LUA_T_STRING && (strcmp(buff, ts->str) == 0)) :
+              ((tag == ts->tag || tag == LUA_ANYTAG) && buff == ts->u.v))
+      return ts;
     i = (i+1)%tb->size;
   }
   /* not found */
@@ -98,27 +140,49 @@ static TaggedString *insert (char *str, stringtable *tb)
     i = j;
   else
     tb->nuse++;
-  ts = tb->hash[i] = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(str));
-  strcpy(ts->str, str);
-  ts->marked = 0;
-  ts->hash = h;
-  ts->varindex = ts->constindex = NOT_USED;
+  ts = tb->hash[i] = newone(buff, tag, h);
   return ts;
 }
 
-TaggedString *lua_createstring (char *str) 
+TaggedString *luaI_createudata (void *udata, int tag)
 {
-  return insert(str, &string_root[(unsigned)str[0]%NUM_HASHS]);
+  return insert(udata, tag, &string_root[(unsigned)udata%NUM_HASHS]);
+}
+
+TaggedString *lua_createstring (char *str)
+{
+  return insert(str, LUA_T_STRING, &string_root[(unsigned)str[0]%NUM_HASHS]);
+}
+
+
+void luaI_strcallIM (TaggedString *l)
+{
+  TObject o;
+  ttype(&o) = LUA_T_USERDATA;
+  for (; l; l=l->next) {
+    tsvalue(&o) = l;
+    luaI_gcIM(&o);
+  }
+}
+
+
+void luaI_strfree (TaggedString *l)
+{
+  while (l) {
+    TaggedString *next = l->next;
+    luaI_free(l);
+    l = next;
+  }
 }
 
 
 /*
 ** Garbage collection function.
-** This function traverse the string list freeing unindexed strings
 */
-Long lua_strcollector (void)
+TaggedString *luaI_strcollector (long *acum)
 {
   Long counter = 0;
+  TaggedString *frees = NULL;
   int i;
   for (i=0; i<NUM_HASHS; i++)
   {
@@ -133,13 +197,15 @@ Long lua_strcollector (void)
           t->marked = 0;
         else
         {
-          luaI_free(t);
+          t->next = frees;
+          frees = t;
           tb->hash[j] = &EMPTY;
           counter++;
         }
       }
     }
   }
-  return counter;
+  *acum += counter;
+  return frees;
 }
 

tree.h

@@ -1,7 +1,7 @@
 /*
 ** tree.h
 ** TecCGraf - PUC-Rio
-** $Id: tree.h,v 1.13 1996/02/14 13:35:51 roberto Exp roberto $
+** $Id: tree.h,v 1.17 1997/05/14 18:38:29 roberto Exp roberto $
 */
 
 #ifndef tree_h
@@ -14,8 +14,15 @@
 
 typedef struct TaggedString
 {
-  Word varindex;  /* != NOT_USED  if this is a symbol */
-  Word constindex;  /* != NOT_USED  if this is a constant */
+  int tag;  /* if != LUA_T_STRING, this is a userdata */
+  struct TaggedString *next;
+  union {
+    struct {
+      Word varindex;  /* != NOT_USED  if this is a symbol */
+      Word constindex;  /* != NOT_USED  if this is a constant */
+    } s;
+    void *v;  /* if this is a userdata, here is its value */
+  } u;
   unsigned long hash;  /* 0 if not initialized */
   int marked;   /* for garbage collection; never collect (nor change) if > 1 */
   char str[1];   /* \0 byte already reserved */
@@ -23,6 +30,9 @@ typedef struct TaggedString
  
 
 TaggedString *lua_createstring (char *str);
-Long lua_strcollector (void);
+TaggedString *luaI_createudata (void *udata, int tag);
+TaggedString *luaI_strcollector (long *cont);
+void luaI_strfree (TaggedString *l);
+void luaI_strcallIM (TaggedString *l);
 
 #endif

undump.c

@@ -3,33 +3,28 @@
 ** load bytecodes from files
 */
 
-char* rcs_undump="$Id: undump.c,v 1.20 1996/11/16 20:14:23 lhf Exp lhf $";
+char* rcs_undump="$Id: undump.c,v 1.23 1997/06/16 16:50:22 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
+#include "auxlib.h"
 #include "opcode.h"
-#include "mem.h"
+#include "luamem.h"
 #include "table.h"
 #include "undump.h"
+#include "zio.h"
 
 static int swapword=0;
 static int swapfloat=0;
 static TFunc* Main=NULL;			/* functions in a chunk */
 static TFunc* lastF=NULL;
 
-static void warn(char* s)			/* TODO: remove */
-{
-#if 0
- fprintf(stderr,"undump: %s\n",s);
-#endif
-}
-
 static void FixCode(Byte* code, Byte* end)	/* swap words */
 {
  Byte* p;
  for (p=code; p!=end;)
  {
-	OpCode op=(OpCode)*p;
+	int op=*p;
 	switch (op)
 	{
 	case PUSHNIL:
@@ -83,6 +78,8 @@ static void FixCode(Byte* code, Byte* end)	/* swap words */
 	case STORELIST0:
 	case ADJUST:
 	case RETCODE:
+	case VARARGS:
+	case STOREMAP:
 		p+=2;
 		break;
 	case STORELIST:
@@ -132,7 +129,8 @@ static void FixCode(Byte* code, Byte* end)	/* swap words */
 		break;
 	}
 	default:
-		lua_error("corrupt binary file");
+		luaL_verror("corrupt binary file: bad opcode %d at %d\n",
+			op,(int)(p-code));
 		break;
 	}
  }
@@ -150,149 +148,152 @@ static void Unthread(Byte* code, int i, int v)
  }
 }
 
-static int LoadWord(FILE* D)
+static int LoadWord(ZIO* Z)
 {
  Word w;
- fread(&w,sizeof(w),1,D);
+ zread(Z,&w,sizeof(w));
  if (swapword)
  {
-  Byte* p=(Byte*)&w;				/* TODO: need union? */
+  Byte* p=(Byte*)&w;
   Byte t;
   t=p[0]; p[0]=p[1]; p[1]=t;
  }
  return w;
 }
 
-static int LoadSize(FILE* D)
+static int LoadSize(ZIO* Z)
 {
- Word hi=LoadWord(D);
- Word lo=LoadWord(D);
+ Word hi=LoadWord(Z);
+ Word lo=LoadWord(Z);
  int s=(hi<<16)|lo;
  if ((Word)s != s) lua_error("code too long");
  return s;
 }
 
-static void* LoadBlock(int size, FILE* D)
+static void* LoadBlock(int size, ZIO* Z)
 {
  void* b=luaI_malloc(size);
- fread(b,size,1,D);
+ zread(Z,b,size);
  return b;
 }
 
-static char* LoadString(FILE* D)
+static char* LoadString(ZIO* Z)
 {
- int size=LoadWord(D);
+ int size=LoadWord(Z);
  char *b=luaI_buffer(size);
- fread(b,size,1,D);
+ zread(Z,b,size);
  return b;
 }
 
-static char* LoadNewString(FILE* D)
+static char* LoadNewString(ZIO* Z)
 {
- return LoadBlock(LoadWord(D),D);
+ return LoadBlock(LoadWord(Z),Z);
 }
 
-static void LoadFunction(FILE* D)
+static void LoadFunction(ZIO* Z)
 {
  TFunc* tf=new(TFunc);
  tf->next=NULL;
  tf->locvars=NULL;
- tf->size=LoadSize(D);
- tf->lineDefined=LoadWord(D);
+ tf->size=LoadSize(Z);
+ tf->lineDefined=LoadWord(Z);
  if (IsMain(tf))				/* new main */
  {
-  tf->fileName=LoadNewString(D);
+  tf->fileName=LoadNewString(Z);
   Main=lastF=tf;
  }
  else						/* fix PUSHFUNCTION */
  {
-  tf->marked=LoadWord(D);
+  tf->marked=LoadWord(Z);
   tf->fileName=Main->fileName;
   memcpy(Main->code+tf->marked,&tf,sizeof(tf));
   lastF=lastF->next=tf;
  }
- tf->code=LoadBlock(tf->size,D);
+ tf->code=LoadBlock(tf->size,Z);
  if (swapword || swapfloat) FixCode(tf->code,tf->code+tf->size);
  while (1)					/* unthread */
  {
-  int c=getc(D);
+  int c=zgetc(Z);
   if (c==ID_VAR)				/* global var */
   {
-   int i=LoadWord(D);
-   char* s=LoadString(D);
+   int i=LoadWord(Z);
+   char* s=LoadString(Z);
    int v=luaI_findsymbolbyname(s);
    Unthread(tf->code,i,v);
   }
   else if (c==ID_STR)				/* constant string */
   {
-   int i=LoadWord(D);
-   char* s=LoadString(D);
+   int i=LoadWord(Z);
+   char* s=LoadString(Z);
    int v=luaI_findconstantbyname(s);
    Unthread(tf->code,i,v);
   }
   else
   {
-   ungetc(c,D);
+   zungetc(Z);
    break;
   }
  }
 }
 
-static void LoadSignature(FILE* D)
+static void LoadSignature(ZIO* Z)
 {
  char* s=SIGNATURE;
- while (*s!=0 && getc(D)==*s)
+ while (*s!=0 && zgetc(Z)==*s)
   ++s;
- if (*s!=0) lua_error("bad signature");
+ if (*s!=0) lua_error("cannot load binary file: bad signature");
 }
 
-static void LoadHeader(FILE* D)			/* TODO: error handling */
+static void LoadHeader(ZIO* Z)
 {
  Word w,tw=TEST_WORD;
  float f,tf=TEST_FLOAT;
  int version;
- LoadSignature(D);
- version=getc(D);
+ LoadSignature(Z);
+ version=zgetc(Z);
  if (version>0x23)				/* after 2.5 */
  {
-  int oldsizeofW=getc(D);
-  int oldsizeofF=getc(D);
-  int oldsizeofP=getc(D);
+  int oldsizeofW=zgetc(Z);
+  int oldsizeofF=zgetc(Z);
+  int oldsizeofP=zgetc(Z);
   if (oldsizeofW!=2)
-   lua_error("cannot load binary file created on machine with sizeof(Word)!=2");
+   luaL_verror(
+	"cannot load binary file created on machine with sizeof(Word)=%d; "
+	"expected 2",oldsizeofW);
   if (oldsizeofF!=4)
-   lua_error("cannot load binary file created on machine with sizeof(float)!=4. not an IEEE machine?");
-  if (oldsizeofP!=sizeof(TFunc*))		/* TODO: pack */
-   lua_error("cannot load binary file: different pointer sizes");
+   luaL_verror(
+	"cannot load binary file created on machine with sizeof(float)=%d; "
+	"expected 4\nnot an IEEE machine?",oldsizeofF);
+  if (oldsizeofP!=sizeof(TFunc*))		/* TODO: pack? */
+   luaL_verror(
+	"cannot load binary file created on machine with sizeof(TFunc*)=%d; "
+	"expected %d",oldsizeofP,(int)sizeof(TFunc*));
  }
- fread(&w,sizeof(w),1,D);			/* test word */
+ zread(Z,&w,sizeof(w));			/* test word */
  if (w!=tw)
  {
   swapword=1;
-  warn("different byte order");
  }
- fread(&f,sizeof(f),1,D);			/* test float */
+ zread(Z,&f,sizeof(f));			/* test float */
  if (f!=tf)
  {
-  Byte* p=(Byte*)&f;				/* TODO: need union? */
+  Byte* p=(Byte*)&f;
   Byte t;
   swapfloat=1;
   t=p[0]; p[0]=p[3]; p[3]=t;
   t=p[1]; p[1]=p[2]; p[2]=t;
   if (f!=tf)					/* TODO: try another perm? */
-   lua_error("different float representation");
-  else
-   warn("different byte order in floats");
+   lua_error("cannot load binary file: unknown float representation");
  }
 }
 
-static void LoadChunk(FILE* D)
+static void LoadChunk(ZIO* Z)
 {
- LoadHeader(D);
+ LoadHeader(Z);
  while (1)
  {
-  int c=getc(D);
-  if (c==ID_FUN) LoadFunction(D); else { ungetc(c,D); break; }
+  int c=zgetc(Z);
+  if (c==ID_FUN) LoadFunction(Z); else { zungetc(Z); break; }
  }
 }
 
@@ -300,30 +301,26 @@ static void LoadChunk(FILE* D)
 ** load one chunk from a file.
 ** return list of functions found, headed by main, or NULL at EOF.
 */
-TFunc* luaI_undump1(FILE* D)
+TFunc* luaI_undump1(ZIO* Z)
 {
- while (1)
+ int c=zgetc(Z);
+ if (c==ID_CHUNK)
  {
-  int c=getc(D);
-  if (c==ID_CHUNK)
-  {
-   LoadChunk(D);
-   return Main;
-  }
-  else if (c==EOF)
-   return NULL;
-  else
-   lua_error("not a lua binary file");
+  LoadChunk(Z);
+  return Main;
  }
+ else if (c!=EOZ)
+   lua_error("not a lua binary file");
+ return NULL;
 }
 
 /*
 ** load and run all chunks in a file
 */
-int luaI_undump(FILE* D)
+int luaI_undump(ZIO* Z)
 {
  TFunc* m;
- while ((m=luaI_undump1(D)))
+ while ((m=luaI_undump1(Z)))
  {
   int status=luaI_dorun(m);
   luaI_freefunc(m);

undump.h

@@ -1,10 +1,14 @@
 /*
 ** undump.h
 ** definitions for lua decompiler
-** $Id: undump.h,v 1.2 1996/03/11 21:59:41 lhf Exp lhf $
+** $Id: undump.h,v 1.5 1997/06/16 16:50:22 roberto Exp roberto $
 */
 
+#ifndef undump_h
+#define undump_h
+
 #include "func.h"
+#include "zio.h"
 
 #define IsMain(f)	(f->lineDefined==0)
 
@@ -15,9 +19,12 @@
 #define ID_VAR		'V'
 #define ID_STR		'S'
 #define	SIGNATURE	"Lua"
-#define	VERSION		0x25		/* 2.5 */
+#define	VERSION		0x25		/* last format change was in 2.5 */
 #define	TEST_WORD	0x1234		/* a word for testing byte ordering */
 #define	TEST_FLOAT	0.123456789e-23	/* a float for testing representation */
 
-TFunc* luaI_undump1(FILE* D);		/* load one chunk */
-int luaI_undump(FILE* D);		/* load all chunks */
+
+TFunc* luaI_undump1(ZIO* Z);
+int luaI_undump(ZIO* Z);		/* load all chunks */
+
+#endif

zio.c

@@ -0,0 +1,79 @@
+/*
+* zio.c
+* a generic input stream interface
+* $Id: zio.c,v 1.1 1997/06/16 16:50:22 roberto Exp roberto $
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "zio.h"
+
+
+/* ----------------------------------------------------- memory buffers --- */
+
+static int zmfilbuf(ZIO* z)
+{
+ return EOZ;
+}
+
+ZIO* zmopen(ZIO* z, char* b, int size)
+{
+ if (b==NULL) return NULL;
+ z->n=size;
+ z->p= (unsigned char *)b;
+ z->filbuf=zmfilbuf;
+ z->u=NULL;
+ return z;
+}
+
+/* ------------------------------------------------------------ strings --- */
+
+ZIO* zsopen(ZIO* z, char* s)
+{
+ if (s==NULL) return NULL;
+ return zmopen(z,s,strlen(s));
+}
+
+/* -------------------------------------------------------------- FILEs --- */
+
+static int zffilbuf(ZIO* z)
+{
+ int n=fread(z->buffer,1,ZBSIZE,z->u);
+ if (n==0) return EOZ;
+ z->n=n-1;
+ z->p=z->buffer;
+ return *(z->p++);
+}
+
+
+ZIO* zFopen(ZIO* z, FILE* f)
+{
+ if (f==NULL) return NULL;
+ z->n=0;
+ z->p=z->buffer;
+ z->filbuf=zffilbuf;
+ z->u=f;
+ return z;
+}
+
+
+/* --------------------------------------------------------------- read --- */
+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 */
+    }
+    m = (n <= z->n) ? n : z->n;  /* minimo de n e z->n */
+    memcpy(b, z->p, m);
+    z->n -= m;
+    z->p += m;
+    b = (char *)b + m;
+    n -= m;
+  }
+  return 0;
+}

zio.h

@@ -0,0 +1,48 @@
+/*
+* zio.h
+* a generic input stream interface
+* $Id: zio.h,v 1.4 1997/06/19 18:55:28 roberto Exp roberto $
+*/
+
+#ifndef zio_h
+#define zio_h
+
+#include <stdio.h>
+
+
+
+/* For Lua only */
+#define zFopen	luaZ_Fopen
+#define zsopen	luaZ_sopen
+#define zmopen	luaZ_mopen
+#define zread	luaZ_read
+
+#define EOZ	(-1)			/* end of stream */
+
+typedef struct zio ZIO;
+
+ZIO* zFopen(ZIO* z, FILE* f);		/* open FILEs */
+ZIO* zsopen(ZIO* z, char* s);		/* string */
+ZIO* zmopen(ZIO* z, char* b, int size);	/* memory */
+
+int zread(ZIO* z, void* b, int n);	/* read next n bytes */
+
+#define zgetc(z)	(--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z))
+#define zungetc(z)	(++(z)->n,--(z)->p)
+
+
+
+/* --------- Private Part ------------------ */
+
+#define ZBSIZE	256			/* buffer size */
+
+struct zio {
+ int n;					/* bytes still unread */
+ unsigned char* p;			/* current position in buffer */
+ int (*filbuf)(ZIO* z);
+ void* u;				/* additional data */
+ unsigned char buffer[ZBSIZE];		/* buffer */
+};
+
+
+#endif