mem.h is now luamem.h

removed warn
added support for new opcodes (VARARGS, STOREMAP)
better error messages with luaL_verror

auxlib.c

@@ -0,0 +1,81 @@
+char *rcs_auxlib="$Id: auxlib.c,v 1.3 1997/04/06 14:08:08 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)
+{
+  char *funcname;
+  lua_getobjname(lua_stackedfunction(0), &funcname);
+  if (funcname == NULL)
+    funcname = "???";
+  if (!cond) {
+    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

@@ -0,0 +1,361 @@
+/*
+** fallback.c
+** TecCGraf - PUC-Rio
+*/
+ 
+char *rcs_fallback="$Id: fallback.c,v 2.3 1997/04/06 14:08:08 roberto Exp roberto $";
+
+#include <stdio.h>
+#include <string.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"
+
+
+
+/* -------------------------------------------
+** Reference routines
+*/
+
+static struct ref {
+  TObject o;
+  enum {LOCK, HOLD, FREE, COLLECTED} status;
+} *refArray = NULL;
+static int refSize = 0;
+
+int luaI_ref (TObject *object, int lock)
+{
+  int i;
+  int oldSize;
+  if (ttype(object) == LUA_T_NIL)
+    return -1;   /* special ref for nil */
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == FREE)
+      goto found;
+  /* no more empty spaces */
+  oldSize = refSize;
+  refSize = growvector(&refArray, refSize, struct ref, refEM, MAX_WORD);
+  for (i=oldSize; i<refSize; i++)
+    refArray[i].status = FREE;
+  i = oldSize;
+ found:
+  refArray[i].o = *object;
+  refArray[i].status = lock ? LOCK : HOLD;
+  return i;
+}
+
+
+void lua_unref (int ref)
+{
+  if (ref >= 0 && ref < refSize)
+    refArray[ref].status = FREE;
+}
+
+
+TObject *luaI_getref (int ref)
+{
+  static TObject nul = {LUA_T_NIL, {0}};
+  if (ref == -1)
+    return &nul;
+  if (ref >= 0 && ref < refSize &&
+      (refArray[ref].status == LOCK || refArray[ref].status == HOLD))
+    return &refArray[ref].o;
+  else
+    return NULL;
+}
+
+
+void luaI_travlock (int (*fn)(TObject *))
+{
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == LOCK)
+      fn(&refArray[i].o);
+}
+
+
+void luaI_invalidaterefs (void)
+{
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == HOLD && !luaI_ismarked(&refArray[i].o))
+      refArray[i].status = COLLECTED;
+}
+
+
+/* -------------------------------------------
+* 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;
+}
+
+
+static struct IM {
+  TObject int_method[IM_N];
+} *luaI_IMtable = NULL;
+
+static int IMtable_size = 0;
+static int last_tag = LUA_T_NIL;  /* ORDER LUA_T */
+
+static char validevents[NUM_TYPES][IM_N] = { /* ORDER LUA_T, ORDER IM */
+{1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_USERDATA */
+{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},  /* 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, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CFUNCTION */
+{1, 1, 1, 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, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
+{1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1},  /* LUA_T_NUMBER */
+{0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}   /* 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<IM_N; i++)
+    luaI_IMtable[-tag].int_method[i].ttype = 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;
+    default:
+      luaL_verror("cannot change the tag of a %s", luaI_typenames[-ttype(o)]);
+  }
+}
+
+
+int luaI_tag (TObject *o)
+{
+  lua_Type t = ttype(o);
+  if (t == LUA_T_USERDATA)
+    return o->value.ts->tag;
+  else if (t == LUA_T_ARRAY)
+    return o->value.a->htag;
+  else return t;
+}
+
+
+TObject *luaI_getim (int tag, IMS event)
+{
+  if (tag > LUA_T_USERDATA)
+    tag = LUA_T_USERDATA;  /* default for non-registered tags */
+  return &luaI_IMtable[-tag].int_method[event];
+}
+
+
+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_IMtable[-t].int_method[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_IMtable[-t].int_method[e]);
+  luaI_IMtable[-t].int_method[e] = *luaI_Address(func);
+}
+
+
+static TObject errorim = {LUA_T_NIL, {NULL}};
+
+
+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_IMtable[-t].int_method[e]))
+        return luaI_eventname[e];
+  }
+  return NULL;
+}
+
+
+/*
+* ===================================================================
+* compatibility with old fallback system
+*/
+
+
+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_IMtable[-t].int_method[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_IMtable[-LUA_T_NIL].int_method[IM_GETGLOBAL];
+      luaI_IMtable[-LUA_T_NIL].int_method[IM_GETGLOBAL] = *luaI_Address(func);
+      replace = nilFB;
+      break;
+    case 2: {  /* old arith fallback */
+      int i;
+      oldfunc = luaI_IMtable[-LUA_T_USERDATA].int_method[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_IMtable[-LUA_T_USERDATA].int_method[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_IMtable[-LUA_T_USERDATA].int_method[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);
+}
+ 

fallback.h

@@ -0,0 +1,60 @@
+/*
+** $Id: fallback.h,v 1.21 1997/04/02 23:04:12 roberto Exp roberto $
+*/
+ 
+#ifndef fallback_h
+#define fallback_h
+
+#include "lua.h"
+#include "opcode.h"
+
+/*
+* 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 IM_N 18
+
+extern char *luaI_eventname[];
+
+
+void luaI_setfallback (void);
+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)(TObject *));
+
+void luaI_settag (int tag, TObject *o);
+void luaI_realtag (int tag);
+TObject *luaI_getim (int tag, IMS event);
+#define luaI_getimbyObj(o,e)  (luaI_getim(luaI_tag(o),(e)))
+TObject *luaI_geterrorim (void);
+int luaI_tag (TObject *o);
+void luaI_settagmethod (void);
+void luaI_gettagmethod (void);
+void luaI_seterrormethod (void);
+void luaI_initfallbacks (void);
+
+#endif
+

func.c

@@ -0,0 +1,156 @@
+#include <string.h>
+
+#include "luadebug.h"
+#include "table.h"
+#include "luamem.h"
+#include "func.h"
+#include "opcode.h"
+
+
+static TFunc *function_root = NULL;
+static LocVar *currvars = NULL;
+static int numcurrvars = 0;
+static int maxcurrvars = 0;
+
+
+/*
+** Initialize TFunc struct
+*/
+void luaI_initTFunc (TFunc *f)
+{
+  f->next = NULL;
+  f->marked = 0;
+  f->size = 0;
+  f->code = NULL;
+  f->lineDefined = 0;
+  f->fileName = NULL;
+  f->locvars = NULL;
+}
+
+/*
+** Insert function in list for GC
+*/
+void luaI_insertfunction (TFunc *f)
+{
+  lua_pack();
+  f->next = function_root;
+  function_root = f;
+  f->marked = 0;
+}
+
+
+/*
+** Free function
+*/
+void luaI_freefunc (TFunc *f)
+{
+  luaI_free (f->code);
+  luaI_free (f->locvars);
+  luaI_free (f);
+}
+
+/*
+** Garbage collection function.
+** This function traverse the function list freeing unindexed functions
+*/
+Long luaI_funccollector (void)
+{
+  TFunc *curr = function_root;
+  TFunc *prev = NULL;
+  Long counter = 0;
+  while (curr)
+  {
+    TFunc *next = curr->next;
+    if (!curr->marked)
+    {
+      if (prev == NULL)
+        function_root = next;
+      else
+        prev->next = next;
+      luaI_freefunc (curr);
+      ++counter;
+    }
+    else
+    {
+      curr->marked = 0;
+      prev = curr;
+    } 
+    curr = next;
+  }
+  return counter;
+}
+
+
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
+{
+  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->ttype == LUA_T_CMARK || f->ttype == LUA_T_CFUNCTION)
+  {
+    *filename = "(C)";
+    *linedefined = -1;
+  }
+}
+
+/*
+** Stores information to know that variable has been declared in given line
+*/
+void luaI_registerlocalvar (TaggedString *varname, int line)
+{
+  if (numcurrvars >= maxcurrvars)
+    maxcurrvars = growvector(&currvars, maxcurrvars, LocVar, "", MAX_WORD);
+  currvars[numcurrvars].varname = varname;
+  currvars[numcurrvars].line = line;
+  numcurrvars++;
+}
+
+/*
+** Stores information to know that variable has been out of scope in given line
+*/
+void luaI_unregisterlocalvar (int line)
+{
+  luaI_registerlocalvar(NULL, line);
+}
+
+/*
+** Copies "currvars" into a new area and store it in function header.
+** The values (varname = NULL, line = -1) signal the end of vector.
+*/
+void luaI_closelocalvars (TFunc *func)
+{
+  func->locvars = newvector (numcurrvars+1, LocVar);
+  memcpy (func->locvars, currvars, numcurrvars*sizeof(LocVar));
+  func->locvars[numcurrvars].varname = NULL;
+  func->locvars[numcurrvars].line = -1;
+  numcurrvars = 0;  /* prepares for next function */
+}
+
+/*
+** Look for n-esim local variable at line "line" in function "func".
+** Returns NULL if not found.
+*/
+char *luaI_getlocalname (TFunc *func, int local_number, int line)
+{
+  int count = 0;
+  char *varname = NULL;
+  LocVar *lv = func->locvars;
+  if (lv == NULL)
+    return NULL;
+  for (; lv->line != -1 && lv->line < line; lv++)
+  {
+    if (lv->varname)               /* register */
+    {
+      if (++count == local_number)
+        varname = lv->varname->str;
+    }
+    else                           /* unregister */
+      if (--count < local_number)
+        varname = NULL;
+  }
+  return varname;
+}
+

func.h

@@ -0,0 +1,44 @@
+/*
+** $Id: func.h,v 1.7 1996/03/08 12:04:04 roberto Exp roberto $
+*/
+
+#ifndef func_h
+#define func_h
+
+#include "types.h"
+#include "lua.h"
+#include "tree.h"
+
+typedef struct LocVar
+{
+  TaggedString *varname;           /* NULL signals end of scope */
+  int       line;
+} LocVar;
+
+
+/*
+** Function Headers
+*/
+typedef struct TFunc
+{
+  struct TFunc	*next;
+  int		marked;
+  int		size;
+  Byte		*code;
+  int		lineDefined;
+  char		*fileName;
+  LocVar        *locvars;
+} TFunc;
+
+Long luaI_funccollector (void);
+void luaI_insertfunction (TFunc *f);
+
+void luaI_initTFunc (TFunc *f);
+void luaI_freefunc (TFunc *f);
+
+void luaI_registerlocalvar (TaggedString *varname, int line);
+void luaI_unregisterlocalvar (int line);
+void luaI_closelocalvars (TFunc *func);
+char *luaI_getlocalname (TFunc *func, int local_number, int line);
+
+#endif

hash.c

@@ -1,172 +1,279 @@
 /*
 ** hash.c
 ** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
-** Modified by Waldemar Celes Filho
-** 12 May 93
 */
 
-#include <string.h>
+char *rcs_hash="$Id: hash.c,v 2.40 1997/04/04 15:35:37 roberto Exp roberto $";
-#include <stdlib.h>
 
+
+#include "luamem.h"
 #include "opcode.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
 #include "lua.h"
+#include "auxlib.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==0)
-#define strneq(s1,s2)	(strcmp(s1,s2)!=0)
-
-#define new(s)		((s *)malloc(sizeof(s)))
-#define newvector(n,s)	((s *)calloc(n,sizeof(s)))
 
 #define nhash(t)	((t)->nhash)
-#define nodelist(t)	((t)->list)
+#define nuse(t)		((t)->nuse)
-#define list(t,i)	((t)->list[i])
+#define markarray(t)    ((t)->mark)
-#define ref_tag(n)	(tag(&(n)->ref))
+#define nodevector(t)	((t)->node)
-#define ref_nvalue(n)	(nvalue(&(n)->ref))
+#define node(t,i)	(&(t)->node[i])
-#define ref_svalue(n)	(svalue(&(n)->ref))
+#define ref(n)		(&(n)->ref)
+#define val(n)		(&(n)->val)
 
-static int head (Hash *t, Object *ref)		/* hash function */
+
+#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,
+  12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
+  1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
+
+int luaI_redimension (int nhash)
 {
- if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
+ int i;
- else if (tag(ref) == T_STRING)
+ for (i=0; dimensions[i]<MAX_INT; i++)
  {
-  int h;
+  if (dimensions[i] > nhash)
-  char *name = svalue(ref);
+   return dimensions[i];
-  for (h=0; *name!=0; name++)		/* interpret name as binary number */
+ }
-  {
+ lua_error("table overflow");
-   h <<= 8;
+ return 0;  /* to avoid warnings */
-   h  += (unsigned char) *name;		/* avoid sign extension */
+}
-   h  %= nhash(t);			/* make it a valid index */
+
+static int hashindex (Hash *t, TObject *ref)		/* hash function */
+{
+  long int h;
+  switch (ttype(ref)) {
+    case LUA_T_NUMBER:
+      h = (long int)nvalue(ref); break;
+    case LUA_T_STRING: case LUA_T_USERDATA:
+      h = tsvalue(ref)->hash; break;
+    case LUA_T_FUNCTION:
+      h = (IntPoint)ref->value.tf; break;
+    case LUA_T_CFUNCTION:
+      h = (IntPoint)fvalue(ref); break;
+    case LUA_T_ARRAY:
+      h = (IntPoint)avalue(ref); break;
+    default:
+      lua_error ("unexpected type to index table");
+      h = 0;  /* UNREACHEABLE */
   }
-  return h;
+  if (h < 0) h = -h;
- }
+  return h%nhash(t);  /* make it a valid index */
- else
- {
-  lua_reportbug ("unexpected type to index table");
-  return -1;
- }
 }
 
-static Node *present(Hash *t, Object *ref, int h)
+int lua_equalObj (TObject *t1, TObject *t2)
 {
- Node *n=NULL, *p;
+  if (ttype(t1) != ttype(t2)) return 0;
- if (tag(ref) == T_NUMBER)
+  switch (ttype(t1))
- {
+  {
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
+    case LUA_T_NIL: return 1;
-   if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
+    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
- }  
+    case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
- else if (tag(ref) == T_STRING)
+    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
- {
+    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
+    case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
-   if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
+    default:
- }  
+     lua_error("internal error in `lua_equalObj'");
- if (n==NULL)				/* name not present */
+     return 0; /* UNREACHEABLE */
-  return NULL;
+  }
-#if 0
- if (p!=NULL)				/* name present but not first */
- {
-  p->next=n->next;			/* move-to-front self-organization */
-  n->next=list(t,h);
-  list(t,h)=n;
- }
-#endif
- return n;
 }
 
-static void freelist (Node *n)
+static int present (Hash *t, TObject *ref)
-{
+{ 
- while (n)
+ int h = hashindex(t, ref);
+ while (ttype(ref(node(t, h))) != LUA_T_NIL)
  {
-  Node *next = n->next;
+  if (lua_equalObj(ref, ref(node(t, h))))
-  free (n);
+    return h;
-  n = next;
+  h = (h+1) % nhash(t);
  }
+ return h;
+}
+
+
+/*
+** Alloc a vector node 
+*/
+static Node *hashnodecreate (int nhash)
+{
+ int i;
+ Node *v = newvector (nhash, Node);
+ for (i=0; i<nhash; i++)
+   ttype(ref(&v[i])) = LUA_T_NIL;
+ return v;
 }
 
 /*
 ** Create a new hash. Return the hash pointer or NULL on error.
 */
-Hash *lua_hashcreate (unsigned int nhash)
+static Hash *hashcreate (int nhash)
 {
- Hash *t = new (Hash);
+ Hash *t = new(Hash);
- if (t == NULL)
+ nhash = luaI_redimension((int)((float)nhash/REHASH_LIMIT));
- {
+ nodevector(t) = hashnodecreate(nhash);
-  lua_error ("not enough memory");
-  return NULL;
- }
  nhash(t) = nhash;
+ nuse(t) = 0;
  markarray(t) = 0;
- nodelist(t) = newvector (nhash, Node*);
+ t->htag = TagDefault;
- if (nodelist(t) == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
  return t;
 }
 
 /*
 ** Delete a hash
 */
-void lua_hashdelete (Hash *h)
+static void hashdelete (Hash *t)
 {
- int i;
+ luaI_free (nodevector(t));
- for (i=0; i<nhash(h); i++)
+ luaI_free(t);
-  freelist (list(h,i));
- free (nodelist(h));
- free(h);
 }
 
-/*
-** If the hash node is present, return its pointer, otherwise create a new
-** node for the given reference and also return its pointer.
-** On error, return NULL.
-*/
-Object *lua_hashdefine (Hash *t, Object *ref)
-{
- int   h;
- Node *n;
- h = head (t, ref);
- if (h < 0) return NULL; 
- 
- n = present(t, ref, h);
- if (n == NULL)
- {
-  n = new(Node);
-  if (n == NULL)
-  {
-   lua_error ("not enough memory");
-   return NULL;
-  }
-  n->ref = *ref;
-  tag(&n->val) = T_NIL;
-  n->next = list(t,h);			/* link node to head of list */
-  list(t,h) = n;
- }
- return (&n->val);
-}
 
 /*
 ** Mark a hash and check its elements 
 */
 void lua_hashmark (Hash *h)
 {
- int i;
+ if (markarray(h) == 0)
- 
- markarray(h) = 1;
- 
- for (i=0; i<nhash(h); i++)
  {
-  Node *n;
+  int i;
-  for (n = list(h,i); n != NULL; n = n->next)
+  markarray(h) = 1;
+  for (i=0; i<nhash(h); i++)
   {
-   lua_markobject (&n->ref);
+   Node *n = node(h,i);
-   lua_markobject (&n->val);
+   if (ttype(ref(n)) != LUA_T_NIL)
+   {
+    lua_markobject(&n->ref);
+    lua_markobject(&n->val);
+   }
   }
+ } 
+}
+
+
+void luaI_hashcallIM (void)
+{
+  Hash *curr_array;
+  TObject t;
+  ttype(&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_gcIM(&t);
+    }
+}
+
+ 
+/*
+** Garbage collection to arrays
+** Delete all unmarked arrays.
+*/
+Long lua_hashcollector (void)
+{
+ Hash *curr_array = listhead, *prev = 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;
+   hashdelete(curr_array);
+   ++counter;
+  }
+  else
+  {
+   markarray(curr_array) = 0;
+   prev = curr_array;
+  }
+  curr_array = next;
  }
+ return counter;
+}
+
+
+/*
+** Create a new array
+** This function inserts the new array in the array list. It also
+** executes garbage collection if the number of arrays created
+** exceed a pre-defined range.
+*/
+Hash *lua_createarray (int nhash)
+{
+ Hash *array;
+ lua_pack();
+ array = hashcreate(nhash);
+ array->next = listhead;
+ listhead = array;
+ return array;
+}
+
+
+/*
+** Re-hash
+*/
+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 (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
+   *node(t, present(t, ref(n))) = *n;  /* copy old node to new hahs */
+ }
+ luaI_free(vold);
+}
+
+/*
+** If the hash node is present, return its pointer, otherwise return
+** null.
+*/
+TObject *lua_hashget (Hash *t, TObject *ref)
+{
+ int h = present(t, ref);
+ if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ else return NULL;
+}
+
+
+/*
+** If the hash node is present, return its pointer, otherwise create a new
+** node for the given reference and also return its pointer.
+*/
+TObject *lua_hashdefine (Hash *t, TObject *ref)
+{
+ int   h;
+ Node *n;
+ h = present(t, ref);
+ n = node(t, h);
+ if (ttype(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);
+  }
+  *ref(n) = *ref;
+  ttype(val(n)) = LUA_T_NIL;
+ }
+ return (val(n));
 }
 
 
@@ -176,84 +283,35 @@ void lua_hashmark (Hash *h)
 ** in the hash.
 ** This function pushs the element value and its reference to the stack.
 */
-#include "lua.h"
+static void hashnext (Hash *t, int i)
-static void firstnode (Hash *a, int h)
 {
- if (h < nhash(a))
+ if (i >= nhash(t))
- {  
+  return;
-  int i;
+ while (ttype(ref(node(t,i))) == LUA_T_NIL ||
-  for (i=h; i<nhash(a); i++)
+        ttype(val(node(t,i))) == LUA_T_NIL)
-  {
+ {
-   if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
+  if (++i >= nhash(t))
-   {
+   return;
-    lua_pushobject (&list(a,i)->ref);
-    lua_pushobject (&list(a,i)->val);
-    return;
-   }
-  }
  }
- lua_pushnil();
+ luaI_pushobject(ref(node(t,i)));
- lua_pushnil();
+ luaI_pushobject(val(node(t,i)));
 }
+
 void lua_next (void)
 {
- Hash   *a;
+ Hash   *t;
- Object *o = lua_getparam (1);
+ lua_Object o = lua_getparam(1);
- Object *r = lua_getparam (2);
+ lua_Object r = lua_getparam(2);
- if (o == NULL || r == NULL)
+ luaL_arg_check(lua_istable(o), 1, "table expected");
- { lua_error ("too few arguments to function `next'"); return; }
+ luaL_arg_check(r != LUA_NOOBJECT, 2, "value expected");
- if (lua_getparam (3) != NULL)
+ t = avalue(luaI_Address(o));
- { lua_error ("too many arguments to function `next'"); return; }
+ if (lua_isnil(r))
- if (tag(o) != T_ARRAY)
- { lua_error ("first argument of function `next' is not a table"); return; }
- a = avalue(o);
- if (tag(r) == T_NIL)
  {
-  firstnode (a, 0);
+  hashnext(t, 0);
-  return;
  }
  else
  {
-  int h = head (a, r);
+  int h = present (t, luaI_Address(r));
-  if (h >= 0)
+  hashnext(t, h+1);
-  {
-   Node *n = list(a,h);
-   while (n)
-   {
-    if (memcmp(&n->ref,r,sizeof(Object)) == 0)
-    {
-     if (n->next == NULL)
-     {
-      firstnode (a, h+1);
-      return;
-     }
-     else if (tag(&n->next->val) != T_NIL)
-     {
-      lua_pushobject (&n->next->ref);
-      lua_pushobject (&n->next->val);
-      return;
-     }
-     else
-     {
-      Node *next = n->next->next;
-      while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
-      if (next == NULL)
-      {
-       firstnode (a, h+1);
-       return;
-      }
-      else
-      {
-       lua_pushobject (&next->ref);
-       lua_pushobject (&next->val);
-      }
-      return;
-     }
-    }
-    n = n->next;
-   }
-   if (n == NULL)
-    lua_error ("error in function 'next': reference not found");
-  }
  }
 }

hash.h

@@ -1,35 +1,38 @@
 /*
 ** hash.h
 ** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
+** $Id: hash.h,v 2.14 1997/03/19 19:41:10 roberto Exp roberto $
-** Modified by Waldemar Celes Filho
-** 26 Apr 93
 */
 
 #ifndef hash_h
 #define hash_h
 
-typedef struct node
+#include "types.h"
-{
+#include "opcode.h"
- Object ref;
+
- Object val;
+typedef struct node {
- struct node *next;
+ TObject ref;
+ TObject val;
 } Node;
 
-typedef struct Hash
+typedef struct Hash {
-{
+  struct Hash *next;
- char           mark;
+  Node *node;
- unsigned int   nhash;
+  int nhash;
- Node         **list;
+  int nuse;
+  int htag;
+  char mark;
 } Hash;
 
-#define markarray(t)		((t)->mark)
-
-Hash 	*lua_hashcreate (unsigned int nhash);
-void 	 lua_hashdelete (Hash *h);
-Object 	*lua_hashdefine (Hash *t, Object *ref);
-void 	 lua_hashmark   (Hash *h);
 
+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);
+void	 luaI_hashcallIM (void);
+TObject  *lua_hashget (Hash *t, TObject *ref);
+TObject 	*lua_hashdefine (Hash *t, TObject *ref);
 void     lua_next (void);
 
 #endif

inout.c

@@ -2,59 +2,48 @@
 ** inout.c
 ** Provide function to realise the input/output function and debugger 
 ** facilities.
-**
+** Also provides some predefined lua functions.
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
+char *rcs_inout="$Id: inout.c,v 2.56 1997/04/06 14:08:08 roberto Exp roberto $";
+
 #include <stdio.h>
 #include <string.h>
 
+#include "auxlib.h"
+#include "lex.h"
 #include "opcode.h"
-#include "hash.h"
 #include "inout.h"
 #include "table.h"
+#include "tree.h"
+#include "lua.h"
+#include "hash.h"
+#include "luamem.h"
+#include "fallback.h"
+#include "luamem.h"
+
 
 /* Exported variables */
-int lua_linenumber;
+Word lua_linenumber;
-int lua_debug;
+char *lua_parsedfile;
-int lua_debugline;
 
-/* Internal variables */
+
-#ifndef MAXFUNCSTACK
+char *luaI_typenames[] = { /* ORDER LUA_T */
-#define MAXFUNCSTACK 32
+  "userdata", "line", "cmark", "mark", "function",
-#endif
+  "function", "table", "string", "number", "nil",
-static struct { int file; int function; } funcstack[MAXFUNCSTACK];
+  NULL
-static int nfuncstack=0;
+};
 
 static FILE *fp;
 static char *st;
-static void (*usererror) (char *s);
-
-/*
-** Function to set user function to handle errors.
-*/
-void lua_errorfunction (void (*fn) (char *s))
-{
- usererror = fn;
-}
 
 /*
 ** Function to get the next character from the input file
 */
 static int fileinput (void)
 {
- int c = fgetc (fp);
+  int c = fgetc(fp);
- return (c == EOF ? 0 : c);
+  return (c == EOF) ? 0 : c;
-}
-
-/*
-** Function to unget the next character from to input file
-*/
-static void fileunput (int c)
-{
- ungetc (c, fp);
 }
 
 /*
@@ -62,31 +51,27 @@ static void fileunput (int c)
 */
 static int stringinput (void)
 {
- st++;
+ return *st++;
- return (*(st-1));
-}
-
-/*
-** Function to unget the next character from to input string
-*/
-static void stringunput (int c)
-{
- st--;
 }
 
 /*
 ** Function to open a file to be input unit. 
-** Return 0 on success or 1 on error.
+** Return the file.
 */
-int lua_openfile (char *fn)
+FILE *lua_openfile (char *fn)
 {
- lua_linenumber = 1;
  lua_setinput (fileinput);
- lua_setunput (fileunput);
+ if (fn == NULL)
- fp = fopen (fn, "r");
+ {
- if (fp == NULL) return 1;
+   fp = stdin;
- if (lua_addfile (fn)) return 1;
+   fn = "(stdin)";
- return 0;
+ }
+ else
+   fp = fopen (fn, "r");
+ if (fp == NULL)
+   return NULL;
+ lua_parsedfile = luaI_createfixedstring(fn)->str;
+ return fp;
 }
 
 /*
@@ -94,7 +79,7 @@ int lua_openfile (char *fn)
 */
 void lua_closefile (void)
 {
- if (fp != NULL)
+ if (fp != NULL && fp != stdin)
  {
   fclose (fp);
   fp = NULL;
@@ -104,85 +89,279 @@ void lua_closefile (void)
 /*
 ** Function to open a string to be input unit
 */
-int lua_openstring (char *s)
+#define SIZE_PREF 20  /* size of string prefix to appear in error messages */
+void lua_openstring (char *s)
 {
- lua_linenumber = 1;
+  char buff[SIZE_PREF+25];
- lua_setinput (stringinput);
+  lua_setinput(stringinput);
- lua_setunput (stringunput);
+  st = s;
- st = s;
+  sprintf(buff, "(dostring) >> %.20s%s", s,
- {
+          (strlen(s) > SIZE_PREF) ? "..." : "");
-  char sn[64];
+  lua_parsedfile = luaI_createfixedstring(buff)->str;
-  sprintf (sn, "String: %10.10s...", s);
-  if (lua_addfile (sn)) return 1;
- }
- return 0;
 }
 
 /*
-** Call user function to handle error messages, if registred. Or report error
+** Function to close an opened string
-** using standard function (fprintf).
 */
-void lua_error (char *s)
+void lua_closestring (void)
 {
- if (usererror != NULL) usererror (s);
+}
- else			    fprintf (stderr, "lua: %s\n", s);
+
+
+static int passresults (void)
+{
+  int arg = 0;
+  lua_Object obj;
+  while ((obj = lua_getresult(++arg)) != LUA_NOOBJECT)
+    lua_pushobject(obj);
+  return arg-1;
+}
+ 
+/*
+** Internal function: do a string
+*/
+static void lua_internaldostring (void)
+{
+  if (lua_dostring(luaL_check_string(1)) == 0)
+    if (passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 }
 
 /*
-** Called to execute  SETFUNCTION opcode, this function pushs a function into
+** Internal function: do a file
-** function stack. Return 0 on success or 1 on error.
 */
-int lua_pushfunction (int file, int function)
+static void lua_internaldofile (void)
 {
- if (nfuncstack >= MAXFUNCSTACK-1)
+ char *fname = luaL_opt_string(1, NULL);
- {
+ if (lua_dofile(fname) == 0)
-  lua_error ("function stack overflow");
+    if (passresults() == 0)
-  return 1;
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
- }
- funcstack[nfuncstack].file = file;
- funcstack[nfuncstack].function = function;
- nfuncstack++;
- return 0;
 }
+ 
 
-/*
+static char *tostring (lua_Object obj)
-** Called to execute  RESET opcode, this function pops a function from 
-** function stack.
-*/
-void lua_popfunction (void)
 {
- nfuncstack--;
+  TObject *o = luaI_Address(obj);
-}
+  switch (ttype(o)) {
-
+    case LUA_T_NUMBER:  case LUA_T_STRING:
-/*
+      return lua_getstring(obj);
-** Report bug building a message and sending it to lua_error function.
+    case LUA_T_ARRAY: case LUA_T_FUNCTION:
-*/
+    case LUA_T_CFUNCTION: case LUA_T_NIL:
-void lua_reportbug (char *s)
+      return luaI_typenames[-ttype(o)];
-{
+    case LUA_T_USERDATA: {
- char msg[1024];
+      char *buff = luaI_buffer(100);
- strcpy (msg, s);
+      int size = o->value.ts->size;
- if (lua_debugline != 0)
+      int i;
- {
+      strcpy(buff, "userdata: ");
-  int i;
+      if (size > 10) size = 10;
-  if (nfuncstack > 0)
+      for (i=0; i<size; i++)
-  {
+        sprintf(buff+strlen(buff), "%.2X",
-   sprintf (strchr(msg,0), 
+               (int)(unsigned char)o->value.ts->str[i]);
-         "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
+      return buff;
-         lua_debugline, s_name(funcstack[nfuncstack-1].function),
+    }
-  	 lua_file[funcstack[nfuncstack-1].file]);
+    default: return "<unknown object>";
-   sprintf (strchr(msg,0), "\n\tactive stack\n");
-   for (i=nfuncstack-1; i>=0; i--)
-    sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n", 
-                            s_name(funcstack[i].function),
-			    lua_file[funcstack[i].file]);
   }
+}
+
+static void luaI_tostring (void)
+{
+  lua_pushstring(tostring(lua_getparam(1)));
+}
+
+static void luaI_print (void)
+{
+  int i = 1;
+  lua_Object obj;
+  while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
+    printf("%s\n", tostring(obj));
+}
+
+static void luaI_type (void)
+{
+  lua_Object o = lua_getparam(1);
+  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
+*/
+static void lua_obj2number (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isnumber(o))
+    lua_pushnumber(lua_getnumber(o));
+}
+
+
+static void luaI_error (void)
+{
+  char *s = lua_getstring(lua_getparam(1));
+  if (s == NULL) s = "(no message)";
+  lua_error(s);
+}
+
+static void luaI_assert (void)
+{
+  lua_Object p = lua_getparam(1);
+  if (p == LUA_NOOBJECT || lua_isnil(p))
+    lua_error("assertion failed!");
+}
+
+static void luaI_setglobal (void)
+{
+  lua_Object value = lua_getparam(2);
+  luaL_arg_check(value != LUA_NOOBJECT, 2, NULL);
+  lua_pushobject(value);
+  lua_setglobal(luaL_check_string(1));
+  lua_pushobject(value);  /* return given value */
+}
+
+static void luaI_rawsetglobal (void)
+{
+  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 */
+}
+
+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)));
+}
+
+#define MAXPARAMS	256
+static void luaI_call (void)
+{
+  lua_Object f = lua_getparam(1);
+  lua_Object arg = lua_getparam(2);
+  lua_Object temp, params[MAXPARAMS];
+  int narg, i;
+  luaL_arg_check(lua_isfunction(f), 1, "function expected");
+  luaL_arg_check(lua_istable(arg), 2, "table expected");
+  /* 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] */
+  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;
+      break;
+    }
+  }
+  /* push parameters and do the call */
+  for (i=0; i<narg; i++)
+    lua_pushobject(params[i]);
+  if (lua_callfunction(f))
+    lua_error(NULL);
   else
-  {
+    passresults();
-   sprintf (strchr(msg,0),
-         "\n\tin statement begining at line %d of file \"%s\"", 
-         lua_debugline, lua_filename());
-  }
- }
- lua_error (msg);
 }
 
+static void luaIl_settag (void)
+{
+  lua_Object o = lua_getparam(1);
+  luaL_arg_check(o != LUA_NOOBJECT, 1, NULL);
+  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();
+}
+
+
+
+/*
+** 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},
+  {"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},
+  {"setfallback", luaI_setfallback},
+  {"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,24 +1,24 @@
 /*
-** inout.h
+** $Id: inout.h,v 1.16 1996/05/28 21:07:32 roberto Exp roberto $
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
 
 #ifndef inout_h
 #define inout_h
 
-extern int lua_linenumber;
+#include "types.h"
-extern int lua_debug;
+#include <stdio.h>
-extern int lua_debugline;
 
-int  lua_openfile     (char *fn);
+
+extern Word lua_linenumber;
+extern Word lua_debugline;
+extern char *lua_parsedfile;
+
+FILE *lua_openfile     (char *fn);
 void lua_closefile    (void);
-int  lua_openstring   (char *s);
+void lua_openstring   (char *s);
-int  lua_pushfunction (int file, int function);
+void lua_closestring  (void);
-void lua_popfunction  (void);
+
-void lua_reportbug    (char *s);
+void luaI_predefine (void);
 
 #endif

iolib.c

@@ -1,401 +1,348 @@
-/*
-** iolib.c
-** Input/output library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
-*/
-
-#include <stdlib.h>
-#include <string.h>
 #include <stdio.h>
-#include <ctype.h>
+#include <string.h>
-#ifdef __GNUC__
+#include <time.h>
-#include <floatingpoint.h>
+#include <stdlib.h>
-#endif
+#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
+FILE *popen();
+int pclose();
+#else
+#define popen(x,y) NULL  /* that is, popen always fails */
+#define pclose(x)  (-1)
+#endif
+
+
+static void pushresult (int i)
+{
+  if (i)
+    lua_pushuserdata(NULL);
+  else {
+    lua_pushnil();
+#ifndef NOSTRERROR
+    lua_pushstring(strerror(errno));
+#else
+    lua_pushstring("O.S. unable to define the error");
+#endif
+  }
+}
+
+
+static void closefile (FILE *f)
+{
+  if (f == stdin || f == stdout)
+    return;
+  if (f == lua_infile)
+    lua_infile = stdin;
+  if (f == lua_outfile)
+    lua_outfile = stdout;
+  if (pclose(f) == -1)
+    fclose(f);
+}
+
 
-static FILE *in=stdin, *out=stdout;
 
-/*
-** Open a file to read.
-** LUA interface:
-**			status = readfrom (filename)
-** where:
-**			status = 1 -> success
-**			status = 0 -> error
-*/
 static void io_readfrom (void)
 {
- lua_Object o = lua_getparam (1);
+  lua_Object f = lua_getparam(1);
- if (o == NULL)			/* restore standart input */
+  if (f == LUA_NOOBJECT)
- {
+    closefile(lua_infile);  /* restore standart input */
-  if (in != stdin)
+  else if (lua_tag(f) == lua_tagio)
-  {
+    lua_infile = lua_getuserdata(f);
-   fclose (in);
+  else {
-   in = stdin;
+    char *s = luaL_check_string(1);
+    FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
+    if (fp)
+      lua_infile = fp;
+    else {
+      pushresult(0);
+      return;
+    }
   }
-  lua_pushnumber (1);
+  lua_pushusertag(lua_infile, lua_tagio);
- }
- else
- {
-  if (!lua_isstring (o))
-  {
-   lua_error ("incorrect argument to function 'readfrom`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"r");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (in != stdin) fclose (in);
-    in = fp;
-    lua_pushnumber (1);
-   }
-  }
- }
 }
 
 
-/*
-** Open a file to write.
-** LUA interface:
-**			status = writeto (filename)
-** where:
-**			status = 1 -> success
-**			status = 0 -> error
-*/
 static void io_writeto (void)
 {
- lua_Object o = lua_getparam (1);
+  lua_Object f = lua_getparam(1);
- if (o == NULL)			/* restore standart output */
+  if (f == LUA_NOOBJECT)
- {
+    closefile(lua_outfile);  /* restore standart output */
-  if (out != stdout)
+  else if (lua_tag(f) == lua_tagio)
-  {
+    lua_outfile = lua_getuserdata(f);
-   fclose (out);
+  else {
-   out = stdout;
+    char *s = luaL_check_string(1);
+    FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
+    if (fp)
+      lua_outfile = fp;
+    else {
+      pushresult(0);
+      return;
+    }
   }
-  lua_pushnumber (1);
+  lua_pushusertag(lua_outfile, lua_tagio);
- }
- else
- {
-  if (!lua_isstring (o))
-  {
-   lua_error ("incorrect argument to function 'writeto`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"w");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (1);
-   }
-  }
- }
 }
 
 
-/*
+static void io_appendto (void)
-** Read a variable. On error put nil on stack.
+{
-** LUA interface:
+  char *s = luaL_check_string(1);
-**			variable = read ([format])
+  FILE *fp = fopen (s, "a");
-**
+  if (fp != NULL) {
-** O formato pode ter um dos seguintes especificadores:
+    lua_outfile = fp;
-**
+    lua_pushusertag(lua_outfile, lua_tagio);
-**	s ou S -> para string
+  }
-**	f ou F, g ou G, e ou E -> para reais
+  else
-**	i ou I -> para inteiros
+    pushresult(0);
-**
+}
-**	Estes especificadores podem vir seguidos de numero que representa
+
-**	o numero de campos a serem lidos.
+
-*/
+#define NEED_OTHER (EOF-1)  /* just some flag different from EOF */
+
 static void io_read (void)
 {
- lua_Object o = lua_getparam (1);
+  char *buff;
- if (o == NULL)			/* free format */
+  char *p = luaL_opt_string(1, "[^\n]*{\n}");
- {
+  int inskip = 0;  /* to control {skips} */
-  int c;
+  int c = NEED_OTHER;
-  char s[256];
+  luaI_emptybuff();
-  while (isspace(c=fgetc(in)))
+  while (*p) {
-   ;
+    if (*p == '{') {
-  if (c == '\"')
+      inskip++;
-  {
+      p++;
-   if (fscanf (in, "%[^\"]\"", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-  }
-  else if (c == '\'')
-  {
-   if (fscanf (in, "%[^\']\'", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-  }
-  else
-  {
-   char *ptr;
-   double d;
-   ungetc (c, in);
-   if (fscanf (in, "%s", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-   d = strtod (s, &ptr);
-   if (!(*ptr))
-   {
-    lua_pushnumber (d);
-    return;
-   }
-  }
-  lua_pushstring (s);
-  return;
- }
- else				/* formatted */
- {
-  char *e = lua_getstring(o);
-  char t;
-  int  m=0;
-  while (isspace(*e)) e++;
-  t = *e++;
-  while (isdigit(*e))
-   m = m*10 + (*e++ - '0');
-  
-  if (m > 0)
-  {
-   char f[80];
-   char s[256];
-   sprintf (f, "%%%ds", m);
-   fscanf (in, f, s);
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     long int l;
-     sscanf (s, "%ld", &l);
-     lua_pushnumber(l);
     }
-    break;
+    else if (*p == '}') {
-    case 'f': case 'g': case 'e':
+      if (inskip == 0)
-    {
+        lua_error("unbalanced braces in read pattern");
-     float f;
+      inskip--;
-     sscanf (s, "%f", &f);
+      p++;
-     lua_pushnumber(f);
     }
-    break;
+    else {
-    default: 
+      char *ep = luaL_item_end(p);  /* get what is next */
-     lua_pushstring(s); 
+      int m;  /* match result */
-    break;
+      if (c == NEED_OTHER) c = getc(lua_infile);
-   }
+      m = (c == EOF) ? 0 : luaL_singlematch((char)c, p);
-  }
+      if (m) {
-  else
+        if (inskip == 0) luaI_addchar(c);
-  {
+        c = NEED_OTHER;
-   switch (tolower(t))
+      }
-   {
+      switch (*ep) {
-    case 'i':
+        case '*':  /* repetition */
-    {
+          if (!m) p = ep+1;  /* else stay in (repeat) the same item */
-     long int l;
+          break;
-     fscanf (in, "%ld", &l);
+        case '?':  /* optional */
-     lua_pushnumber(l);
+          p = ep+1;  /* continues reading the pattern */
+          break;
+        default:
+          if (m) p = ep;  /* continues reading the pattern */
+          else
+            goto break_while;   /* pattern fails */
+      }
     }
-    break;
+  } break_while:
-    case 'f': case 'g': case 'e':
+  if (c >= 0)  /* not EOF nor NEED_OTHER? */
-    {
+     ungetc(c, lua_infile);
-     float f;
+  buff = luaI_addchar(0);
-     fscanf (in, "%f", &f);
+  if (*buff != 0 || *p == 0)  /* read something or did not fail? */
-     lua_pushnumber(f);
+    lua_pushstring(buff);
-    }
-    break;
-    default: 
-    {
-     char s[256];
-     fscanf (in, "%s", s);
-     lua_pushstring(s);
-    }
-    break;
-   }
-  }
- }
 }
 
 
-/*
-** Write a variable. On error put 0 on stack, otherwise put 1.
-** LUA interface:
-**			status = write (variable [,format])
-**
-** O formato pode ter um dos seguintes especificadores:
-**
-**	s ou S -> para string
-**	f ou F, g ou G, e ou E -> para reais
-**	i ou I -> para inteiros
-**
-**	Estes especificadores podem vir seguidos de:
-**
-**		[?][m][.n]
-**
-**	onde:
-**		? -> indica justificacao
-**			< = esquerda
-**			| = centro
-**			> = direita (default)
-**		m -> numero maximo de campos (se exceder estoura)
-**		n -> indica precisao para
-**			reais -> numero de casas decimais
-**			inteiros -> numero minimo de digitos
-**			string -> nao se aplica
-*/
-static char *buildformat (char *e, lua_Object o)
-{
- static char buffer[512];
- static char f[80];
- char *string = &buffer[255];
- char t, j='r';
- int  m=0, n=0, l;
- while (isspace(*e)) e++;
- t = *e++;
- if (*e == '<' || *e == '|' || *e == '>') j = *e++;
- while (isdigit(*e))
-  m = m*10 + (*e++ - '0');
- e++;	/* skip point */
- while (isdigit(*e))
-  n = n*10 + (*e++ - '0');
-
- sprintf(f,"%%");
- if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
- if (m != 0)   sprintf(strchr(f,0),"%d", m);
- if (n != 0)   sprintf(strchr(f,0),".%d", n);
- sprintf(strchr(f,0), "%c", t);
- switch (tolower(t))
- {
-  case 'i': t = 'i';
-   sprintf (string, f, (long int)lua_getnumber(o));
-  break;
-  case 'f': case 'g': case 'e': t = 'f';
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 's': t = 's';
-   sprintf (string, f, lua_getstring(o));
-  break;
-  default: return "";
- }
- l = strlen(string);
- if (m!=0 && l>m)
- {
-  int i;
-  for (i=0; i<m; i++)
-   string[i] = '*';
-  string[i] = 0;
- }
- else if (m!=0 && j=='|')
- {
-  int i=l-1;
-  while (isspace(string[i])) i--;
-  string -= (m-i) / 2;
-  i=0;
-  while (string[i]==0) string[i++] = ' ';
-  string[l] = 0;
- }
- return string;
-}
 static void io_write (void)
 {
- lua_Object o1 = lua_getparam (1);
+  int arg = 1;
- lua_Object o2 = lua_getparam (2);
+  int status = 1;
- if (o1 == NULL)			/* new line */
+  char *s;
- {
+  while ((s = luaL_opt_string(arg++, NULL)) != NULL)
-  fprintf (out, "\n");
+    status = status && (fputs(s, lua_outfile) != EOF);
-  lua_pushnumber(1);
+  pushresult(status);
- }
- else if (o2 == NULL)   		/* free format */
- {
-  int status=0;
-  if (lua_isnumber(o1))
-   status = fprintf (out, "%g", lua_getnumber(o1));
-  else if (lua_isstring(o1))
-   status = fprintf (out, "%s", lua_getstring(o1));
-  lua_pushnumber(status);
- }
- else					/* formated */
- {
-  if (!lua_isstring(o2))
-  { 
-   lua_error ("incorrect format to function `write'"); 
-   lua_pushnumber(0);
-   return;
-  }
-  lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
- }
 }
 
-/*
+
-** Execute a executable program using "sustem".
+static void io_execute (void)
-** On error put 0 on stack, otherwise put 1.
-*/
-void io_execute (void)
 {
- lua_Object o = lua_getparam (1);
+  lua_pushnumber(system(luaL_check_string(1)));
- if (o == NULL || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  system(lua_getstring(o));
-  lua_pushnumber (1);
- }
- return;
 }
 
-/*
+
-** Remove a file.
+static void io_remove  (void)
-** On error put 0 on stack, otherwise put 1.
-*/
-void io_remove  (void)
 {
- lua_Object o = lua_getparam (1);
+  pushresult(remove(luaL_check_string(1)) == 0);
- if (o == NULL || !lua_isstring (o))
+}
- {
+
-  lua_error ("incorrect argument to function 'execute`");
+
-  lua_pushnumber (0);
+static void io_rename (void)
- }
+{
- else
+  pushresult(rename(luaL_check_string(1),
- {
+                    luaL_check_string(2)) == 0);
-  if (remove(lua_getstring(o)) == 0)
+}
-   lua_pushnumber (1);
+
+
+static void io_tmpname (void)
+{
+  lua_pushstring(tmpnam(NULL));
+}
+
+
+
+static void io_getenv (void)
+{
+  lua_pushstring(getenv(luaL_check_string(1))); /* if NULL push nil */
+}
+
+
+static void io_date (void)
+{
+  time_t t;
+  struct tm *tm;
+  char *s = luaL_opt_string(1, "%c");
+  char b[BUFSIZ];
+  time(&t); tm = localtime(&t);
+  if (strftime(b,sizeof(b),s,tm))
+    lua_pushstring(b);
   else
-   lua_pushnumber (0);
+    lua_error("invalid `date' format");
- }
+}
- return;
+ 
+
+static void io_exit (void)
+{
+  lua_Object o = lua_getparam(1);
+  exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);
 }
 
-/*
+
-** Open io library
+static void io_debug (void)
+{
+  while (1) {
+    char buffer[250];
+    fprintf(stderr, "lua_debug> ");
+    if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
+    if (strcmp(buffer, "cont\n") == 0) return;
+    lua_dostring(buffer);
+  }
+}
+
+
+static void lua_printstack (FILE *f)
+{
+  int level = 1;  /* skip level 0 (it's this function) */
+  lua_Object func;
+  while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
+    char *name;
+    int currentline;
+    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' iternal 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);
+      }
+    }
+    if ((currentline = lua_currentline(func)) > 0)
+      fprintf(f, " at line %d", currentline);
+    fprintf(f, "\n");
+  }
+}
+
+
+static void errorfb (void)
+{
+  fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1)));
+  lua_printstack(stderr);
+}
+
+
+/* --------------------------------------------
+* functions to manipulate userdata
 */
+static void getbyte (void)
+{
+  lua_Object ud = lua_getparam(1);
+  int i = luaL_opt_number(2, -1);
+  luaL_arg_check(lua_isuserdata(ud), 1, "userdata expected");
+  if (i == -1)
+    lua_pushnumber(lua_getbindatasize(ud));
+  else {
+    i--;
+    if (0 <= i && i < lua_getbindatasize(ud))
+      lua_pushnumber(*(((char *)lua_getbindata(ud))+i));
+    else
+      lua_pushnil();
+  }
+}
+
+static void newuserdata (void)
+{
+  lua_Object t = lua_getparam(1);
+  int tag = luaL_opt_number(2, 0);
+  int i;
+  luaI_emptybuff();
+  luaL_arg_check(lua_istable(t), 1, "table expected");
+  for (i=0; ; i++) {
+    lua_Object o;
+    lua_beginblock();
+    lua_pushobject(t);
+    lua_pushnumber(i+1);
+    o = lua_rawgettable();
+    if (lua_isnil(o)) {
+      lua_endblock();
+      break;
+    }
+    luaL_arg_check(lua_isnumber(o), 1, "table values must be numbers");
+    luaI_addchar(lua_getnumber(o));
+    lua_endblock();
+  }
+  lua_pushbindata(luaI_addchar(0), i, tag);
+}
+
+
+static struct luaL_reg iolib[] = {
+{"readfrom", io_readfrom},
+{"writeto",  io_writeto},
+{"appendto", io_appendto},
+{"read",     io_read},
+{"write",    io_write},
+{"execute",  io_execute},
+{"remove",   io_remove},
+{"rename",   io_rename},
+{"tmpname",   io_tmpname},
+{"getenv",   io_getenv},
+{"date",     io_date},
+{"exit",     io_exit},
+{"debug",    io_debug},
+{"getbyte",    getbyte},
+{"userdata",    newuserdata},
+{"print_stack", errorfb}
+};
+
 void iolib_open (void)
 {
- lua_register ("readfrom", io_readfrom);
+  lua_tagio = lua_newtag();
- lua_register ("writeto",  io_writeto);
+  lua_infile=stdin; lua_outfile=stdout;
- lua_register ("read",     io_read);
+  luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
- lua_register ("write",    io_write);
+  lua_seterrormethod(errorfb);
- lua_register ("execute",  io_execute);
- lua_register ("remove",   io_remove);
 }

lex.c

@@ -0,0 +1,459 @@
+char *rcs_lex = "$Id: lex.c,v 2.46 1997/04/07 14:48:53 roberto Exp roberto $";
+
+
+#include <ctype.h>
+#include <string.h>
+
+#include "auxlib.h"
+#include "luamem.h"
+#include "tree.h"
+#include "table.h"
+#include "lex.h"
+#include "inout.h"
+#include "luadebug.h"
+#include "parser.h"
+
+#define MINBUFF 250
+
+#define next() (current = input())
+#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	10
+
+/* "ifstate" keeps the state of each nested $if the lexical is
+** dealing with. The first bit indicates whether the $if condition
+** is false or true. The second bit indicates whether the lexical is
+** inside the "then" part (0) or the "else" part (2)
+*/
+static int ifstate[MAX_IFS];  /* 0 => then part - condition false */
+                              /* 1 => then part - condition true */
+                              /* 2 => else part - condition false */
+                              /* 3 => else part - condition true */
+static int iflevel;  /* level of nested $if's */
+
+
+void lua_setinput (Input fn)
+{
+  current = '\n';
+  lua_linenumber = 0;
+  iflevel = 0;
+  input = fn;
+}
+
+
+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)
+{
+  luaI_auxsynterrbf(s, luaI_buffer(1));
+}
+
+
+static struct
+  {
+    char *name;
+    int token;
+  } reserved [] = {
+      {"and", AND},
+      {"do", DO},
+      {"else", ELSE},
+      {"elseif", ELSEIF},
+      {"end", END},
+      {"function", FUNCTION},
+      {"if", IF},
+      {"local", LOCAL},
+      {"nil", NIL},
+      {"not", NOT},
+      {"or", OR},
+      {"repeat", REPEAT},
+      {"return", RETURN},
+      {"then", THEN},
+      {"until", UNTIL},
+      {"while", WHILE} };
+
+
+#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
+
+
+void luaI_addReserved (void)
+{
+  int i;
+  for (i=0; i<RESERVEDSIZE; i++)
+  {
+    TaggedString *ts = lua_createstring(reserved[i].name);
+    ts->marked = reserved[i].token;  /* reserved word  (always > 255) */
+  }
+}
+
+
+/*
+** Pragma handling
+*/
+
+#define PRAGMASIZE	20
+
+static void skipspace (void)
+{
+  while (current == ' ' || current == '\t') next();
+}
+
+
+static int checkcond (char *buff)
+{
+  if (strcmp(buff, "nil") == 0)
+    return 0;
+  else if (strcmp(buff, "1") == 0)
+    return 1;
+  else if (isalpha((unsigned char)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)) {
+    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 (int thisiflevel)
+{
+  while (iflevel > thisiflevel &&
+         (ifstate[thisiflevel] == 0 || ifstate[thisiflevel] == 3)) {
+    if (current == '\n')
+      inclinenumber();
+    else if (current == 0)
+      luaI_auxsyntaxerror("input ends inside a $if");
+    else next();
+  }
+}
+
+
+static void inclinenumber (void)
+{
+  static char *pragmas [] = 
+    {"debug", "nodebug", "end", "ifnot", "if", "else", NULL};
+  next();  /* skip '\n' */
+  ++lua_linenumber;
+  if (current == '$') {  /* is a pragma? */
+    char buff[PRAGMASIZE+1];
+    int ifnot = 0;
+    next();  /* skip $ */
+    readname(buff);
+    switch (luaI_findstring(buff, pragmas)) {
+      case 0:  /* debug */
+        lua_debug = 1;
+        break;
+      case 1:  /* nodebug */
+        lua_debug = 0;
+        break;
+      case 2:  /* end */
+        if (--iflevel < 0)
+          luaI_auxsyntaxerror("unmatched $endif");
+        break;
+      case 3:  /* ifnot */
+        ifnot = 1;
+        /* go through */
+      case 4:  /* if */
+        if (iflevel == MAX_IFS)
+          luaI_auxsyntaxerror("too many nested `$ifs'");
+        readname(buff);
+        ifstate[iflevel++] = checkcond(buff) ? !ifnot : ifnot;
+        break;
+      case 5:  /* else */
+        if (iflevel <= 0 || (ifstate[iflevel-1] & 2))
+          luaI_auxsyntaxerror("unmatched $else");
+        ifstate[iflevel-1] = ifstate[iflevel-1] | 2;
+        break;
+      default:
+        luaI_auxsynterrbf("invalid pragma", buff);
+    }
+    skipspace();
+    if (current == '\n')  /* pragma must end with a '\n' */
+      inclinenumber();
+    else if (current != 0)  /* or eof */
+      luaI_auxsyntaxerror("invalid pragma format");
+    if (iflevel > 0)
+      ifskip(iflevel-1);
+  }
+}
+
+static int read_long_string (char *yytext, int buffsize)
+{
+  int cont = 0;
+  int tokensize = 2;  /* '[[' already stored */
+  while (1)
+  {
+    if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */
+      yytext = luaI_buffer(buffsize *= 2);
+    switch (current)
+    {
+      case 0:
+        save(0);
+        return WRONGTOKEN;
+      case '[':
+        save_and_next();
+        if (current == '[')
+        {
+          cont++;
+          save_and_next();
+        }
+        continue;
+      case ']':
+        save_and_next();
+        if (current == ']')
+        {
+          if (cont == 0) goto endloop;
+          cont--;
+          save_and_next();
+        }
+        continue;
+      case '\n':
+        save('\n');
+        inclinenumber();
+        continue;
+      default:
+        save_and_next();
+    }
+  } endloop:
+  save_and_next();  /* pass the second ']' */
+  yytext[tokensize-2] = 0;  /* erases ']]' */
+  luaY_lval.vWord = luaI_findconstantbyname(yytext+2);
+  yytext[tokensize-2] = ']';  /* restores ']]' */
+  save(0);
+  return STRING;
+}
+
+int luaY_lex (void)
+{
+  static int linelasttoken = 0;
+  double a;
+  int buffsize = MINBUFF;
+  char *yytext = luaI_buffer(buffsize);
+  yytext[1] = yytext[2] = yytext[3] = 0;
+  if (lua_debug)
+    luaI_codedebugline(linelasttoken);
+  linelasttoken = lua_linenumber;
+  while (1)
+  {
+    int tokensize = 0;
+    switch (current)
+    {
+      case '\n':
+        inclinenumber();
+        linelasttoken = lua_linenumber;
+        continue;
+
+      case ' ': case '\t': case '\r':  /* CR: to avoid problems with DOS */
+        next();
+        continue;
+
+      case '-':
+        save_and_next();
+        if (current != '-') return '-';
+        do { next(); } while (current != '\n' && current != 0);
+        continue;
+
+      case '[':
+        save_and_next();
+        if (current != '[') return '[';
+        else
+        {
+          save_and_next();  /* pass the second '[' */
+          return read_long_string(yytext, buffsize);
+        }
+
+      case '=':
+        save_and_next();
+        if (current != '=') return '=';
+        else { save_and_next(); return EQ; }
+
+      case '<':
+        save_and_next();
+        if (current != '=') return '<';
+        else { save_and_next(); return LE; }
+
+      case '>':
+        save_and_next();
+        if (current != '=') return '>';
+        else { save_and_next(); return GE; }
+
+      case '~':
+        save_and_next();
+        if (current != '=') return '~';
+        else { save_and_next(); return NE; }
+
+      case '"':
+      case '\'':
+      {
+        int del = current;
+        save_and_next();
+        while (current != del)
+        {
+          if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */
+            yytext = luaI_buffer(buffsize *= 2);
+          switch (current)
+          {
+            case 0:
+            case '\n':
+              save(0);
+              return WRONGTOKEN;
+            case '\\':
+              next();  /* do not save the '\' */
+              switch (current)
+              {
+                case 'n': save('\n'); next(); break;
+                case 't': save('\t'); next(); break;
+                case 'r': save('\r'); next(); break;
+                case '\n': save('\n'); inclinenumber(); break;
+                default : save_and_next(); break;
+              }
+              break;
+            default:
+              save_and_next();
+          }
+        }
+        next();  /* skip delimiter */
+        save(0);
+        luaY_lval.vWord = luaI_findconstantbyname(yytext+1);
+        tokensize--;
+        save(del); save(0);  /* restore delimiter */
+        return STRING;
+      }
+
+      case 'a': case 'b': case 'c': case 'd': case 'e':
+      case 'f': case 'g': case 'h': case 'i': case 'j':
+      case 'k': case 'l': case 'm': case 'n': case 'o':
+      case 'p': case 'q': case 'r': case 's': case 't':
+      case 'u': case 'v': case 'w': case 'x': case 'y':
+      case 'z':
+      case 'A': case 'B': case 'C': case 'D': case 'E':
+      case 'F': case 'G': case 'H': case 'I': case 'J':
+      case 'K': case 'L': case 'M': case 'N': case 'O':
+      case 'P': case 'Q': case 'R': case 'S': case 'T':
+      case 'U': case 'V': case 'W': case 'X': case 'Y':
+      case 'Z':
+      case '_':
+      {
+        TaggedString *ts;
+        do {
+          save_and_next();
+        } while (isalnum((unsigned char)current) || current == '_');
+        save(0);
+        ts = lua_createstring(yytext);
+        if (ts->marked > 2)
+          return ts->marked;  /* reserved word */
+        luaY_lval.pTStr = ts;
+        ts->marked = 2;  /* avoid GC */
+        return NAME;
+      }
+
+      case '.':
+        save_and_next();
+        if (current == '.')
+        {
+          save_and_next();
+          if (current == '.')
+          {
+            save_and_next();
+            return DOTS;   /* ... */
+          }
+          else return CONC;   /* .. */
+        }
+        else if (!isdigit((unsigned char)current)) return '.';
+        /* current is a digit: goes through to number */
+	a=0.0;
+        goto fraction;
+
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+	a=0.0;
+        do {
+          a=10.0*a+(current-'0');
+          save_and_next();
+        } while (isdigit((unsigned char)current));
+        if (current == '.') {
+          save_and_next();
+          if (current == '.')
+            luaI_syntaxerror(
+              "ambiguous syntax (decimal point x string concatenation)");
+        }
+      fraction:
+	{ double da=0.1;
+	  while (isdigit((unsigned char)current))
+	  {
+            a+=(current-'0')*da;
+            da/=10.0;
+            save_and_next();
+          }
+          if (current == 'e' || current == 'E')
+          {
+	    int e=0;
+	    int neg;
+	    double ea;
+            save_and_next();
+	    neg=(current=='-');
+            if (current == '+' || current == '-') save_and_next();
+            if (!isdigit((unsigned char)current)) {
+              save(0); return WRONGTOKEN; }
+            do {
+              e=10.0*e+(current-'0');
+              save_and_next();
+            } while (isdigit((unsigned char)current));
+	    for (ea=neg?0.1:10.0; e>0; e>>=1)
+	    {
+	      if (e & 1) a*=ea;
+	      ea*=ea;
+	    }
+          }
+          luaY_lval.vFloat = a;
+          save(0);
+          return NUMBER;
+        }
+
+      case 0:
+        save(0);
+        if (iflevel > 0)
+          luaI_syntaxerror("missing $endif");
+        return 0;
+
+      default:
+        save_and_next();
+        return yytext[0];
+    }
+  }
+}
+

lex.h

@@ -0,0 +1,19 @@
+/*
+** lex.h
+** TecCGraf - PUC-Rio
+** $Id: lex.h,v 1.2 1996/02/14 13:35:51 roberto Exp roberto $
+*/
+
+#ifndef lex_h
+#define lex_h
+
+
+typedef int  (*Input) (void);
+
+void    lua_setinput   (Input fn);
+void luaI_syntaxerror (char *s);
+int     luaY_lex (void);
+void luaI_addReserved (void);
+
+
+#endif

lex_yy.c

@@ -1,923 +0,0 @@
-# include "stdio.h"
-# define U(x) x
-# define NLSTATE yyprevious=YYNEWLINE
-# define BEGIN yybgin = yysvec + 1 +
-# define INITIAL 0
-# define YYLERR yysvec
-# define YYSTATE (yyestate-yysvec-1)
-# define YYOPTIM 1
-# define YYLMAX BUFSIZ
-# define output(c) putc(c,yyout)
-# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)
-# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
-# define yymore() (yymorfg=1)
-# define ECHO fprintf(yyout, "%s",yytext)
-# define REJECT { nstr = yyreject(); goto yyfussy;}
-int yyleng; extern char yytext[];
-int yymorfg;
-extern char *yysptr, yysbuf[];
-int yytchar;
-FILE *yyin = {stdin}, *yyout = {stdout};
-extern int yylineno;
-struct yysvf { 
-	struct yywork *yystoff;
-	struct yysvf *yyother;
-	int *yystops;};
-struct yysvf *yyestate;
-extern struct yysvf yysvec[], *yybgin;
-#include <stdlib.h>
-#include <string.h>
-
-#include "opcode.h"
-#include "hash.h"
-#include "inout.h"
-#include "table.h"
-#include "y_tab.h"
-
-#undef input
-#undef unput
-
-static Input input;
-static Unput unput;
-
-void lua_setinput (Input fn)
-{
- input = fn;
-}
-
-void lua_setunput (Unput fn)
-{
- unput = fn;
-}
-
-char *lua_lasttext (void)
-{
- return yytext;
-}
-
-# define YYNEWLINE 10
-yylex(){
-int nstr; extern int yyprevious;
-while((nstr = yylook()) >= 0)
-yyfussy: switch(nstr){
-case 0:
-if(yywrap()) return(0); break;
-case 1:
-				;
-break;
-case 2:
-			{yylval.vInt = 1; return DEBUG;}
-break;
-case 3:
-			{yylval.vInt = 0; return DEBUG;}
-break;
-case 4:
-				lua_linenumber++;
-break;
-case 5:
-				;
-break;
-case 6:
-				return LOCAL;
-break;
-case 7:
-				return IF;
-break;
-case 8:
-				return THEN;
-break;
-case 9:
-				return ELSE;
-break;
-case 10:
-			return ELSEIF;
-break;
-case 11:
-				return WHILE;
-break;
-case 12:
-				return DO;
-break;
-case 13:
-			return REPEAT;
-break;
-case 14:
-				return UNTIL;
-break;
-case 15:
-			{
-                                         yylval.vWord = lua_nfile-1;
-                                         return FUNCTION;
-					}
-break;
-case 16:
-				return END;
-break;
-case 17:
-				return RETURN;
-break;
-case 18:
-				return LOCAL;
-break;
-case 19:
-				return NIL;
-break;
-case 20:
-				return AND;
-break;
-case 21:
-				return OR;
-break;
-case 22:
-				return NOT;
-break;
-case 23:
-				return NE;
-break;
-case 24:
-				return LE;
-break;
-case 25:
-				return GE;
-break;
-case 26:
-				return CONC;
-break;
-case 27:
-			case 28:
-		      {
-				       yylval.vWord = lua_findenclosedconstant (yytext);
-				       return STRING;
-				      }
-break;
-case 29:
-case 30:
-case 31:
-case 32:
-{
-				        yylval.vFloat = atof(yytext);
-				        return NUMBER;
-				       }
-break;
-case 33:
- 	       {
-					yylval.vWord = lua_findsymbol (yytext);
-					return NAME;
-				       }
-break;
-case 34:
-				return  *yytext;
-break;
-case -1:
-break;
-default:
-fprintf(yyout,"bad switch yylook %d",nstr);
-} return(0); }
-/* end of yylex */
-int yyvstop[] = {
-0,
-
-1,
-0,
-
-1,
-0,
-
-34,
-0,
-
-1,
-34,
-0,
-
-4,
-0,
-
-34,
-0,
-
-34,
-0,
-
-34,
-0,
-
-34,
-0,
-
-29,
-34,
-0,
-
-34,
-0,
-
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-33,
-34,
-0,
-
-34,
-0,
-
-34,
-0,
-
-1,
-0,
-
-27,
-0,
-
-28,
-0,
-
-5,
-0,
-
-26,
-0,
-
-30,
-0,
-
-29,
-0,
-
-29,
-0,
-
-24,
-0,
-
-25,
-0,
-
-33,
-0,
-
-33,
-0,
-
-12,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-7,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-21,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-23,
-0,
-
-29,
-30,
-0,
-
-31,
-0,
-
-20,
-33,
-0,
-
-33,
-0,
-
-16,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-19,
-33,
-0,
-
-22,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-32,
-0,
-
-9,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-8,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-31,
-32,
-0,
-
-33,
-0,
-
-33,
-0,
-
-6,
-18,
-33,
-0,
-
-33,
-0,
-
-33,
-0,
-
-14,
-33,
-0,
-
-11,
-33,
-0,
-
-10,
-33,
-0,
-
-33,
-0,
-
-13,
-33,
-0,
-
-17,
-33,
-0,
-
-2,
-0,
-
-33,
-0,
-
-15,
-33,
-0,
-
-3,
-0,
-0};
-# define YYTYPE char
-struct yywork { YYTYPE verify, advance; } yycrank[] = {
-0,0,	0,0,	1,3,	0,0,	
-0,0,	0,0,	0,0,	0,0,	
-0,0,	0,0,	1,4,	1,5,	
-6,29,	4,28,	0,0,	0,0,	
-0,0,	0,0,	7,31,	0,0,	
-6,29,	6,29,	0,0,	0,0,	
-0,0,	0,0,	7,31,	7,31,	
-0,0,	0,0,	0,0,	0,0,	
-0,0,	0,0,	0,0,	1,6,	
-4,28,	0,0,	0,0,	0,0,	
-1,7,	0,0,	0,0,	0,0,	
-1,3,	6,30,	1,8,	1,9,	
-0,0,	1,10,	6,29,	7,31,	
-8,33,	0,0,	6,29,	0,0,	
-7,32,	0,0,	0,0,	6,29,	
-7,31,	1,11,	0,0,	1,12,	
-2,27,	7,31,	1,13,	11,39,	
-12,40,	1,13,	26,56,	0,0,	
-0,0,	2,8,	2,9,	0,0,	
-6,29,	0,0,	0,0,	6,29,	
-0,0,	0,0,	7,31,	0,0,	
-0,0,	7,31,	0,0,	0,0,	
-2,11,	0,0,	2,12,	0,0,	
-0,0,	0,0,	0,0,	0,0,	
-0,0,	0,0,	1,14,	0,0,	
-0,0,	1,15,	1,16,	1,17,	
-0,0,	22,52,	1,18,	18,47,	
-23,53,	1,19,	42,63,	1,20,	
-1,21,	25,55,	14,42,	1,22,	
-15,43,	1,23,	1,24,	16,44,	
-1,25,	16,45,	17,46,	19,48,	
-21,51,	2,14,	20,49,	1,26,	
-2,15,	2,16,	2,17,	24,54,	
-20,50,	2,18,	44,64,	45,65,	
-2,19,	46,66,	2,20,	2,21,	
-27,57,	48,67,	2,22,	49,68,	
-2,23,	2,24,	50,69,	2,25,	
-52,70,	53,72,	27,58,	54,73,	
-52,71,	9,34,	2,26,	9,35,	
-9,35,	9,35,	9,35,	9,35,	
-9,35,	9,35,	9,35,	9,35,	
-9,35,	10,36,	55,74,	10,37,	
-10,37,	10,37,	10,37,	10,37,	
-10,37,	10,37,	10,37,	10,37,	
-10,37,	57,75,	58,76,	64,80,	
-66,81,	67,82,	70,83,	71,84,	
-72,85,	73,86,	74,87,	10,38,	
-10,38,	38,61,	10,38,	38,61,	
-75,88,	76,89,	38,62,	38,62,	
-38,62,	38,62,	38,62,	38,62,	
-38,62,	38,62,	38,62,	38,62,	
-80,92,	81,93,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-82,94,	83,95,	84,96,	10,38,	
-10,38,	86,97,	10,38,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	87,98,	88,99,	60,79,	
-60,79,	13,41,	60,79,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	13,41,	13,41,	13,41,	
-13,41,	33,33,	89,100,	60,79,	
-60,79,	92,101,	60,79,	93,102,	
-95,103,	33,33,	33,0,	96,104,	
-99,105,	100,106,	102,107,	106,108,	
-107,109,	35,35,	35,35,	35,35,	
-35,35,	35,35,	35,35,	35,35,	
-35,35,	35,35,	35,35,	108,110,	
-0,0,	0,0,	0,0,	0,0,	
-0,0,	0,0,	33,33,	0,0,	
-0,0,	35,59,	35,59,	33,33,	
-35,59,	0,0,	0,0,	33,33,	
-0,0,	0,0,	0,0,	0,0,	
-33,33,	0,0,	0,0,	0,0,	
-0,0,	36,60,	36,60,	36,60,	
-36,60,	36,60,	36,60,	36,60,	
-36,60,	36,60,	36,60,	0,0,	
-0,0,	33,33,	0,0,	0,0,	
-33,33,	35,59,	35,59,	0,0,	
-35,59,	36,38,	36,38,	59,77,	
-36,38,	59,77,	0,0,	0,0,	
-59,78,	59,78,	59,78,	59,78,	
-59,78,	59,78,	59,78,	59,78,	
-59,78,	59,78,	61,62,	61,62,	
-61,62,	61,62,	61,62,	61,62,	
-61,62,	61,62,	61,62,	61,62,	
-0,0,	0,0,	0,0,	0,0,	
-0,0,	36,38,	36,38,	0,0,	
-36,38,	77,78,	77,78,	77,78,	
-77,78,	77,78,	77,78,	77,78,	
-77,78,	77,78,	77,78,	79,90,	
-0,0,	79,90,	0,0,	0,0,	
-79,91,	79,91,	79,91,	79,91,	
-79,91,	79,91,	79,91,	79,91,	
-79,91,	79,91,	90,91,	90,91,	
-90,91,	90,91,	90,91,	90,91,	
-90,91,	90,91,	90,91,	90,91,	
-0,0};
-struct yysvf yysvec[] = {
-0,	0,	0,
-yycrank+-1,	0,		yyvstop+1,
-yycrank+-28,	yysvec+1,	yyvstop+3,
-yycrank+0,	0,		yyvstop+5,
-yycrank+4,	0,		yyvstop+7,
-yycrank+0,	0,		yyvstop+10,
-yycrank+-11,	0,		yyvstop+12,
-yycrank+-17,	0,		yyvstop+14,
-yycrank+7,	0,		yyvstop+16,
-yycrank+107,	0,		yyvstop+18,
-yycrank+119,	0,		yyvstop+20,
-yycrank+6,	0,		yyvstop+23,
-yycrank+7,	0,		yyvstop+25,
-yycrank+158,	0,		yyvstop+27,
-yycrank+4,	yysvec+13,	yyvstop+30,
-yycrank+5,	yysvec+13,	yyvstop+33,
-yycrank+11,	yysvec+13,	yyvstop+36,
-yycrank+5,	yysvec+13,	yyvstop+39,
-yycrank+5,	yysvec+13,	yyvstop+42,
-yycrank+12,	yysvec+13,	yyvstop+45,
-yycrank+21,	yysvec+13,	yyvstop+48,
-yycrank+10,	yysvec+13,	yyvstop+51,
-yycrank+4,	yysvec+13,	yyvstop+54,
-yycrank+4,	yysvec+13,	yyvstop+57,
-yycrank+21,	yysvec+13,	yyvstop+60,
-yycrank+9,	yysvec+13,	yyvstop+63,
-yycrank+9,	0,		yyvstop+66,
-yycrank+40,	0,		yyvstop+68,
-yycrank+0,	yysvec+4,	yyvstop+70,
-yycrank+0,	yysvec+6,	0,	
-yycrank+0,	0,		yyvstop+72,
-yycrank+0,	yysvec+7,	0,	
-yycrank+0,	0,		yyvstop+74,
-yycrank+-280,	0,		yyvstop+76,
-yycrank+0,	0,		yyvstop+78,
-yycrank+249,	0,		yyvstop+80,
-yycrank+285,	0,		yyvstop+82,
-yycrank+0,	yysvec+10,	yyvstop+84,
-yycrank+146,	0,		0,	
-yycrank+0,	0,		yyvstop+86,
-yycrank+0,	0,		yyvstop+88,
-yycrank+0,	yysvec+13,	yyvstop+90,
-yycrank+10,	yysvec+13,	yyvstop+92,
-yycrank+0,	yysvec+13,	yyvstop+94,
-yycrank+19,	yysvec+13,	yyvstop+97,
-yycrank+35,	yysvec+13,	yyvstop+99,
-yycrank+27,	yysvec+13,	yyvstop+101,
-yycrank+0,	yysvec+13,	yyvstop+103,
-yycrank+42,	yysvec+13,	yyvstop+106,
-yycrank+35,	yysvec+13,	yyvstop+108,
-yycrank+30,	yysvec+13,	yyvstop+110,
-yycrank+0,	yysvec+13,	yyvstop+112,
-yycrank+36,	yysvec+13,	yyvstop+115,
-yycrank+48,	yysvec+13,	yyvstop+117,
-yycrank+35,	yysvec+13,	yyvstop+119,
-yycrank+61,	yysvec+13,	yyvstop+121,
-yycrank+0,	0,		yyvstop+123,
-yycrank+76,	0,		0,	
-yycrank+67,	0,		0,	
-yycrank+312,	0,		0,	
-yycrank+183,	yysvec+36,	yyvstop+125,
-yycrank+322,	0,		0,	
-yycrank+0,	yysvec+61,	yyvstop+128,
-yycrank+0,	yysvec+13,	yyvstop+130,
-yycrank+78,	yysvec+13,	yyvstop+133,
-yycrank+0,	yysvec+13,	yyvstop+135,
-yycrank+81,	yysvec+13,	yyvstop+138,
-yycrank+84,	yysvec+13,	yyvstop+140,
-yycrank+0,	yysvec+13,	yyvstop+142,
-yycrank+0,	yysvec+13,	yyvstop+145,
-yycrank+81,	yysvec+13,	yyvstop+148,
-yycrank+66,	yysvec+13,	yyvstop+150,
-yycrank+74,	yysvec+13,	yyvstop+152,
-yycrank+80,	yysvec+13,	yyvstop+154,
-yycrank+78,	yysvec+13,	yyvstop+156,
-yycrank+94,	0,		0,	
-yycrank+93,	0,		0,	
-yycrank+341,	0,		0,	
-yycrank+0,	yysvec+77,	yyvstop+158,
-yycrank+356,	0,		0,	
-yycrank+99,	yysvec+13,	yyvstop+160,
-yycrank+89,	yysvec+13,	yyvstop+163,
-yycrank+108,	yysvec+13,	yyvstop+165,
-yycrank+120,	yysvec+13,	yyvstop+167,
-yycrank+104,	yysvec+13,	yyvstop+169,
-yycrank+0,	yysvec+13,	yyvstop+171,
-yycrank+113,	yysvec+13,	yyvstop+174,
-yycrank+148,	yysvec+13,	yyvstop+176,
-yycrank+133,	0,		0,	
-yycrank+181,	0,		0,	
-yycrank+366,	0,		0,	
-yycrank+0,	yysvec+90,	yyvstop+178,
-yycrank+183,	yysvec+13,	yyvstop+181,
-yycrank+182,	yysvec+13,	yyvstop+183,
-yycrank+0,	yysvec+13,	yyvstop+185,
-yycrank+172,	yysvec+13,	yyvstop+189,
-yycrank+181,	yysvec+13,	yyvstop+191,
-yycrank+0,	yysvec+13,	yyvstop+193,
-yycrank+0,	yysvec+13,	yyvstop+196,
-yycrank+189,	0,		0,	
-yycrank+195,	0,		0,	
-yycrank+0,	yysvec+13,	yyvstop+199,
-yycrank+183,	yysvec+13,	yyvstop+202,
-yycrank+0,	yysvec+13,	yyvstop+204,
-yycrank+0,	yysvec+13,	yyvstop+207,
-yycrank+0,	0,		yyvstop+210,
-yycrank+178,	0,		0,	
-yycrank+186,	yysvec+13,	yyvstop+212,
-yycrank+204,	0,		0,	
-yycrank+0,	yysvec+13,	yyvstop+214,
-yycrank+0,	0,		yyvstop+217,
-0,	0,	0};
-struct yywork *yytop = yycrank+423;
-struct yysvf *yybgin = yysvec+1;
-char yymatch[] = {
-00  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
-01  ,011 ,012 ,01  ,01  ,01  ,01  ,01  ,
-01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
-01  ,01  ,01  ,01  ,01  ,01  ,01  ,01  ,
-011 ,01  ,'"' ,01  ,01  ,01  ,01  ,047 ,
-01  ,01  ,01  ,'+' ,01  ,'+' ,01  ,01  ,
-'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,
-'0' ,'0' ,01  ,01  ,01  ,01  ,01  ,01  ,
-01  ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
-'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
-'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
-'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,'A' ,
-01  ,'A' ,'A' ,'A' ,'D' ,'D' ,'A' ,'D' ,
-'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
-'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,
-'A' ,'A' ,'A' ,01  ,01  ,01  ,01  ,01  ,
-0};
-char yyextra[] = {
-0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,
-0,0,0,0,0,0,0,0,
-0};
-#ifndef lint
-static	char ncform_sccsid[] = "@(#)ncform 1.6 88/02/08 SMI"; /* from S5R2 1.2 */
-#endif
-
-int yylineno =1;
-# define YYU(x) x
-# define NLSTATE yyprevious=YYNEWLINE
-char yytext[YYLMAX];
-struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp;
-char yysbuf[YYLMAX];
-char *yysptr = yysbuf;
-int *yyfnd;
-extern struct yysvf *yyestate;
-int yyprevious = YYNEWLINE;
-yylook(){
-	register struct yysvf *yystate, **lsp;
-	register struct yywork *yyt;
-	struct yysvf *yyz;
-	int yych, yyfirst;
-	struct yywork *yyr;
-# ifdef LEXDEBUG
-	int debug;
-# endif
-	char *yylastch;
-	/* start off machines */
-# ifdef LEXDEBUG
-	debug = 0;
-# endif
-	yyfirst=1;
-	if (!yymorfg)
-		yylastch = yytext;
-	else {
-		yymorfg=0;
-		yylastch = yytext+yyleng;
-		}
-	for(;;){
-		lsp = yylstate;
-		yyestate = yystate = yybgin;
-		if (yyprevious==YYNEWLINE) yystate++;
-		for (;;){
-# ifdef LEXDEBUG
-			if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1);
-# endif
-			yyt = yystate->yystoff;
-			if(yyt == yycrank && !yyfirst){  /* may not be any transitions */
-				yyz = yystate->yyother;
-				if(yyz == 0)break;
-				if(yyz->yystoff == yycrank)break;
-				}
-			*yylastch++ = yych = input();
-			yyfirst=0;
-		tryagain:
-# ifdef LEXDEBUG
-			if(debug){
-				fprintf(yyout,"char ");
-				allprint(yych);
-				putchar('\n');
-				}
-# endif
-			yyr = yyt;
-			if ( (int)yyt > (int)yycrank){
-				yyt = yyr + yych;
-				if (yyt <= yytop && yyt->verify+yysvec == yystate){
-					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
-						{unput(*--yylastch);break;}
-					*lsp++ = yystate = yyt->advance+yysvec;
-					goto contin;
-					}
-				}
-# ifdef YYOPTIM
-			else if((int)yyt < (int)yycrank) {		/* r < yycrank */
-				yyt = yyr = yycrank+(yycrank-yyt);
-# ifdef LEXDEBUG
-				if(debug)fprintf(yyout,"compressed state\n");
-# endif
-				yyt = yyt + yych;
-				if(yyt <= yytop && yyt->verify+yysvec == yystate){
-					if(yyt->advance+yysvec == YYLERR)	/* error transitions */
-						{unput(*--yylastch);break;}
-					*lsp++ = yystate = yyt->advance+yysvec;
-					goto contin;
-					}
-				yyt = yyr + YYU(yymatch[yych]);
-# ifdef LEXDEBUG
-				if(debug){
-					fprintf(yyout,"try fall back character ");
-					allprint(YYU(yymatch[yych]));
-					putchar('\n');
-					}
-# endif
-				if(yyt <= yytop && yyt->verify+yysvec == yystate){
-					if(yyt->advance+yysvec == YYLERR)	/* error transition */
-						{unput(*--yylastch);break;}
-					*lsp++ = yystate = yyt->advance+yysvec;
-					goto contin;
-					}
-				}
-			if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){
-# ifdef LEXDEBUG
-				if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1);
-# endif
-				goto tryagain;
-				}
-# endif
-			else
-				{unput(*--yylastch);break;}
-		contin:
-# ifdef LEXDEBUG
-			if(debug){
-				fprintf(yyout,"state %d char ",yystate-yysvec-1);
-				allprint(yych);
-				putchar('\n');
-				}
-# endif
-			;
-			}
-# ifdef LEXDEBUG
-		if(debug){
-			fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1);
-			allprint(yych);
-			putchar('\n');
-			}
-# endif
-		while (lsp-- > yylstate){
-			*yylastch-- = 0;
-			if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){
-				yyolsp = lsp;
-				if(yyextra[*yyfnd]){		/* must backup */
-					while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){
-						lsp--;
-						unput(*yylastch--);
-						}
-					}
-				yyprevious = YYU(*yylastch);
-				yylsp = lsp;
-				yyleng = yylastch-yytext+1;
-				yytext[yyleng] = 0;
-# ifdef LEXDEBUG
-				if(debug){
-					fprintf(yyout,"\nmatch ");
-					sprint(yytext);
-					fprintf(yyout," action %d\n",*yyfnd);
-					}
-# endif
-				return(*yyfnd++);
-				}
-			unput(*yylastch);
-			}
-		if (yytext[0] == 0  /* && feof(yyin) */)
-			{
-			yysptr=yysbuf;
-			return(0);
-			}
-		yyprevious = yytext[0] = input();
-		if (yyprevious>0)
-			output(yyprevious);
-		yylastch=yytext;
-# ifdef LEXDEBUG
-		if(debug)putchar('\n');
-# endif
-		}
-	}
-yyback(p, m)
-	int *p;
-{
-if (p==0) return(0);
-while (*p)
-	{
-	if (*p++ == m)
-		return(1);
-	}
-return(0);
-}
-	/* the following are only used in the lex library */
-yyinput(){
-	return(input());
-	}
-yyoutput(c)
-  int c; {
-	output(c);
-	}
-yyunput(c)
-   int c; {
-	unput(c);
-	}

lua.c

@@ -1,54 +1,71 @@
 /*
 ** lua.c
 ** Linguagem para Usuarios de Aplicacao
-** TeCGraf - PUC-Rio
-** 28 Apr 93
 */
 
+char *rcs_lua="$Id: lua.c,v 1.14 1996/09/24 17:30:28 roberto Exp roberto $";
+
 #include <stdio.h>
+#include <string.h>
 
 #include "lua.h"
 #include "lualib.h"
 
 
-void test (void)
+#ifdef _POSIX_SOURCE
+#include <unistd.h>
+#else
+#define isatty(x)       (x==0)  /* assume stdin is a tty */
+#endif
+
+
+static void manual_input (void)
 {
-  lua_pushobject(lua_getparam(1));
+  if (isatty(0)) {
-  lua_call ("c", 1);
+    char buffer[250];
+    while (fgets(buffer, sizeof(buffer), stdin) != 0) {
+      lua_beginblock();
+      lua_dostring(buffer);
+      lua_endblock();
+    }
+  }
+  else
+    lua_dofile(NULL);  /* executes stdin as a file */
 }
 
 
-static void callfunc (void)
+int main (int argc, char *argv[])
 {
- lua_Object obj = lua_getparam (1);
+  int i;
- if (lua_isstring(obj)) lua_call(lua_getstring(obj),0);
+  int result = 0;
+  iolib_open ();
+  strlib_open ();
+  mathlib_open ();
+  if (argc < 2)
+    manual_input();
+  else for (i=1; i<argc; i++) {
+    if (strcmp(argv[i], "-") == 0)
+      manual_input();
+    else if (strcmp(argv[i], "-v") == 0)
+      printf("%s  %s\n(written by %s)\n\n",
+             LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
+    else if ((strcmp(argv[i], "-e") == 0 && i++) || strchr(argv[i], '=')) {
+      if (lua_dostring(argv[i]) != 0) {
+        fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
+        return 1;
+      }
+    }
+    else {
+      result = lua_dofile (argv[i]);
+      if (result) {
+        if (result == 2) {
+          fprintf(stderr, "lua: cannot execute file ");
+          perror(argv[i]);
+        }
+        return 1;
+      }
+    }
+  }
+  return result;
 }
 
-static void execstr (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj)) lua_dostring(lua_getstring(obj));
-}
-
-void main (int argc, char *argv[])
-{
- int i;
- if (argc < 2)
- {
-  puts ("usage: lua filename [functionnames]");
-  return;
- }
- lua_register ("callfunc", callfunc);
- lua_register ("execstr", execstr);
- lua_register ("test", test);
- iolib_open ();
- strlib_open ();
- mathlib_open ();
- lua_dofile (argv[1]);
- for (i=2; i<argc; i++)
- {
-  lua_call (argv[i],0);
- }
-}
-
-

lua.h

@@ -1,54 +1,121 @@
 /*
-** LUA - Linguagem para Usuarios de Aplicacao
+** LUA - An Extensible Extension Language
-** Grupo de Tecnologia em Computacao Grafica
+** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
-** TeCGraf - PUC-Rio
+** e-mail: lua@tecgraf.puc-rio.br
-** 19 May 93
+** $Id: lua.h,v 4.1 1997/04/03 18:26:08 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+#define LUA_VERSION	"Lua 3.0 (alpha)"
+#define LUA_COPYRIGHT	"Copyright (C) 1994-1997 TeCGraf"
+#define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
+
+
+#define LUA_NOOBJECT  0
+
 typedef void (*lua_CFunction) (void);
-typedef struct Object *lua_Object;
+typedef unsigned int lua_Object;
 
-#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+void           lua_settagmethod	(int tag, char *event, lua_CFunction method);
+void           lua_gettagmethod	(int tag, char *event);  /* out: method */
+void           lua_seterrormethod (lua_CFunction method);
 
+int            lua_newtag		(void);
+void           lua_settag		(int tag); /* In: object */
 
-void           lua_errorfunction    	(void (*fn) (char *s));
 void           lua_error		(char *s);
-int            lua_dofile 		(char *filename);
+int            lua_dofile 		(char *filename); /* Out: returns */
-int            lua_dostring 		(char *string);
+int            lua_dostring 		(char *string); /* Out: returns */
-int            lua_call 		(char *functionname, int nparam);
+int            lua_callfunction		(lua_Object f);
+					  /* In: parameters; Out: returns */
+int	       lua_call			(char *funcname);
+					  /* In: parameters; Out: returns */
+
+void	       lua_beginblock		(void);
+void	       lua_endblock		(void);
+
+lua_Object     lua_lua2C 		(int number);
+#define	       lua_getparam(_)		lua_lua2C(_)
+#define	       lua_getresult(_)		lua_lua2C(_)
+
+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);
 
-lua_Object     lua_getparam 		(int number);
 float          lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
-char 	      *lua_copystring 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
-void          *lua_getuserdata  	(lua_Object object);
+void          *lua_getbindata		(lua_Object object);
-lua_Object     lua_getfield         	(lua_Object object, char *field);
+int            lua_getbindatasize	(lua_Object object);
-lua_Object     lua_getindexed         	(lua_Object object, float index);
+
+void 	       lua_pushnil 		(void);
+void           lua_pushnumber 		(float n);
+void           lua_pushstring 		(char *s);
+void           lua_pushcfunction	(lua_CFunction fn);
+void           lua_pushbindata		(void *buff, int size, int tag);
+void           lua_pushusertag     	(void *u, int tag);
+void           lua_pushobject       	(lua_Object object);
+
 lua_Object     lua_getglobal 		(char *name);
+lua_Object     lua_rawgetglobal		(char *name);
+void           lua_setglobal		(char *name); /* In: value */
+void           lua_rawsetglobal		(char *name); /* In: value */
 
-lua_Object     lua_pop 			(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_pushnil 		(void);
+int            lua_tag			(lua_Object object);
-int            lua_pushnumber 		(float n);
-int            lua_pushstring 		(char *s);
-int            lua_pushcfunction	(lua_CFunction fn);
-int            lua_pushuserdata     	(void *u);
-int            lua_pushobject       	(lua_Object object);
 
-int            lua_storeglobal		(char *name);
-int            lua_storefield		(lua_Object object, char *field);
-int            lua_storeindexed		(lua_Object object, float index);
 
-int            lua_isnil 		(lua_Object object);
+int            lua_ref			(int lock); /* In: value */
-int            lua_isnumber 		(lua_Object object);
+lua_Object     lua_getref		(int ref);
-int            lua_isstring 		(lua_Object object);
+void	       lua_pushref		(int ref);
-int            lua_istable          	(lua_Object object);
+void	       lua_unref		(int ref);
-int            lua_iscfunction 		(lua_Object object);
-int            lua_isuserdata 		(lua_Object object);
 
+lua_Object     lua_createtable		(void);
+
+
+/* =============================================================== */
+/* some useful macros */
+
+#define lua_refobject(o,l)	(lua_pushobject(o), lua_ref(l))
+
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_setglobal(n))
+
+#define lua_pushuserdata(u)     lua_pushusertag(u, 0)
+
+
+/* =============================================================== */
+/* for compatibility with old versions. Avoid using these macros/functions */
+
+lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
+
+#define lua_storeglobal(n)	lua_setglobal(n)
+#define lua_type(o)		(lua_tag(o))
+
+void	*lua_getuserdata	(lua_Object object);
+
+#define lua_lockobject(o)  lua_refobject(o,1)
+#define	lua_lock() lua_ref(1)
+#define lua_getlocked lua_getref
+#define	lua_pushlocked lua_pushref
+#define	lua_unlock lua_unref
+
+#define lua_pushliteral(o)  lua_pushstring(o)
+
+#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_gettable())
+#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushliteral(f), lua_gettable())
+
+#define lua_copystring(o) (strdup(lua_getstring(o)))
+
+#define lua_getsubscript  lua_gettable
 #endif

lua.stx

@@ -0,0 +1,792 @@
+%{
+
+char *rcs_luastx = "$Id: lua.stx,v 3.45 1997/03/06 17:30:55 roberto Exp roberto $";
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "luadebug.h"
+#include "luamem.h"
+#include "lex.h"
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "tree.h"
+#include "table.h"
+#include "lua.h"
+#include "func.h"
+
+/* to avoid warnings generated by yacc */
+int yyparse (void);
+#define malloc luaI_malloc
+#define realloc luaI_realloc
+#define free luaI_free
+
+#ifndef LISTING
+#define LISTING 0
+#endif
+
+#ifndef CODE_BLOCK
+#define CODE_BLOCK 256
+#endif
+static int   maxcode;
+static int   maxmain;
+static int   maxcurr;
+static Byte  *funcCode = NULL;
+static Byte **initcode;
+static Byte  *basepc;
+static int   maincode;
+static int   pc;
+
+
+#define MAXVAR 32
+static Long    varbuffer[MAXVAR];    /* variables in an assignment list;
+				it's long to store negative Word values */
+static int     nvarbuffer=0;	     /* number of variables at a list */
+
+#define MAXLOCALS 32
+static TaggedString *localvar[MAXLOCALS];  /* store local variable names */
+static int     nlocalvar=0;	     /* number of local variables */
+
+#define MAXFIELDS FIELDS_PER_FLUSH*2
+
+int lua_debug = 0;
+
+/* Internal functions */
+
+static void yyerror (char *s)
+{
+  luaI_syntaxerror(s);
+}
+
+static void check_space (int i)
+{
+  if (pc+i>maxcurr-1)  /* 1 byte free to code HALT of main code */
+    maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT);
+}
+
+static void code_byte (Byte c)
+{
+ check_space(1);
+ basepc[pc++] = c;
+}
+
+static void code_word (Word n)
+{
+  check_space(sizeof(Word));
+  memcpy(basepc+pc, &n, sizeof(Word));
+  pc += sizeof(Word);
+}
+
+static void code_float (real n)
+{
+  check_space(sizeof(real));
+  memcpy(basepc+pc, &n, sizeof(real));
+  pc += sizeof(real);
+}
+
+static void code_code (TFunc *tf)
+{
+  check_space(sizeof(TFunc *));
+  memcpy(basepc+pc, &tf, sizeof(TFunc *));
+  pc += sizeof(TFunc *);
+}
+
+static void code_word_at (Byte *p, int n)
+{
+  Word w = n;
+  if (w != n)
+    yyerror("block too big");
+  memcpy(p, &w, sizeof(Word));
+}
+
+static void flush_record (int n)
+{
+  if (n == 0) return;
+  code_byte(STOREMAP);
+  code_byte(n);
+}
+
+static void flush_list (int m, int n)
+{
+  if (n == 0) return;
+  if (m == 0)
+    code_byte(STORELIST0); 
+  else
+  if (m < 255)
+  {
+    code_byte(STORELIST);
+    code_byte(m);
+  }
+  else
+   yyerror ("list constructor too long");
+  code_byte(n);
+}
+
+static void store_localvar (TaggedString *name, int n)
+{
+ if (nlocalvar+n < MAXLOCALS)
+  localvar[nlocalvar+n] = name;
+ else
+  yyerror ("too many local variables");
+ if (lua_debug)
+   luaI_registerlocalvar(name, lua_linenumber);
+}
+
+static void add_localvar (TaggedString *name)
+{
+  store_localvar(name, 0);
+  nlocalvar++;
+}
+
+static void add_varbuffer (Long var)
+{
+ if (nvarbuffer < MAXVAR)
+  varbuffer[nvarbuffer++] = var;
+ else
+  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;
+  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)
+   {
+    code_byte(PUSHBYTE);
+    code_byte(i);
+   }
+   else
+   {
+    code_byte(PUSHWORD);
+    code_word(i);
+   }
+  }
+  else
+  {
+   code_byte(PUSHFLOAT);
+   code_float(f);
+  }
+}
+
+/*
+** Search a local name and if find return its index. If do not find return -1
+*/
+static int lua_localname (TaggedString *n)
+{
+ int i;
+ for (i=nlocalvar-1; i >= 0; i--)
+  if (n == localvar[i]) return i;	/* local var */
+ return -1;		        /* global var */
+}
+
+/*
+** Push a variable given a number. If number is positive, push global variable
+** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
+** Otherwise, if zero, push indexed variable (record).
+*/
+static void lua_pushvar (Long number)
+{ 
+ if (number > 0)	/* global var */
+ {
+  code_byte(PUSHGLOBAL);
+  code_word(number-1);
+ }
+ else if (number < 0)	/* local var */
+ {
+  number = (-number) - 1;
+  if (number < 10) code_byte(PUSHLOCAL0 + number);
+  else
+  {
+   code_byte(PUSHLOCAL);
+   code_byte(number);
+  }
+ }
+ else
+ {
+  code_byte(PUSHINDEXED);
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ if (n+nlocalvar == 0)
+   code_byte(ADJUST0);
+ else
+ {
+   code_byte(ADJUST);
+   code_byte(n+nlocalvar);
+ }
+}
+
+static void change2main (void)
+{
+  /* (re)store main values */
+  pc=maincode; basepc=*initcode; maxcurr=maxmain;
+  nlocalvar=0;
+}
+
+static void savemain (void)
+{
+  /* save main values */
+  maincode=pc; *initcode=basepc; maxmain=maxcurr;
+}
+
+static void init_func (void)
+{
+  if (funcCode == NULL)	/* first function */
+  {
+   funcCode = newvector(CODE_BLOCK, Byte);
+   maxcode = CODE_BLOCK;
+  }
+  savemain();  /* save main values */
+  /* set func values */
+  pc=0; basepc=funcCode; maxcurr=maxcode; 
+  nlocalvar = 0;
+  luaI_codedebugline(lua_linenumber);
+}
+
+static void codereturn (void)
+{
+  if (nlocalvar == 0)
+    code_byte(RETCODE0);
+  else
+  {
+    code_byte(RETCODE);
+    code_byte(nlocalvar);
+  }
+}
+
+void luaI_codedebugline (int line)
+{
+  static int lastline = 0;
+  if (lua_debug && line != lastline)
+  {
+    code_byte(SETLINE);
+    code_word(line);
+    lastline = line;
+  }
+}
+
+static int adjust_functioncall (Long exp, int i)
+{
+  if (exp <= 0)
+    return -exp; /* exp is -list length */
+  else
+  {
+    int temp = basepc[exp];
+    basepc[exp] = i;
+    return temp+i;
+  }
+}
+
+static void adjust_mult_assign (int vars, Long exps, int temps)
+{
+  if (exps > 0)
+  { /* must correct function call */
+    int diff = vars - basepc[exps];
+    if (diff >= 0)
+      adjust_functioncall(exps, diff);
+    else
+    {
+      adjust_functioncall(exps, 0);
+      lua_codeadjust(temps);
+    }
+  }
+  else if (vars != -exps)
+    lua_codeadjust(temps);
+}
+
+static int close_parlist (int dots)
+{
+  if (!dots)
+    lua_codeadjust(0);
+  else
+  {
+    code_byte(VARARGS);
+    code_byte(nlocalvar);
+    add_localvar(luaI_createfixedstring("arg"));
+  }
+  return lua_linenumber;
+}
+
+static void storesinglevar (Long v)
+{
+ if (v > 0)		/* global var */
+ {
+   code_byte(STOREGLOBAL);
+   code_word(v-1);
+ }
+ else if (v < 0)      /* local var */
+ {
+   int number = (-v) - 1;
+   if (number < 10) code_byte(STORELOCAL0 + number);
+   else
+   {
+     code_byte(STORELOCAL);
+     code_byte(number);
+   }
+ }
+ else 
+   code_byte(STOREINDEXED0);
+}
+
+static void lua_codestore (int i)
+{
+ if (varbuffer[i] != 0)  /* global or local var */
+  storesinglevar(varbuffer[i]);
+ else				  /* indexed var */
+ {
+  int j;
+  int upper=0;     	/* number of indexed variables upper */
+  int param;		/* number of itens until indexed expression */
+  for (j=i+1; j <nvarbuffer; j++)
+   if (varbuffer[j] == 0) upper++;
+  param = upper*2 + i;
+  if (param == 0)
+   code_byte(STOREINDEXED0);
+  else
+  {
+   code_byte(STOREINDEXED);
+   code_byte(param);
+  }
+ }
+}
+
+static void codeIf (Long thenAdd, Long elseAdd)
+{
+  Long elseinit = elseAdd+sizeof(Word)+1;
+  if (pc == elseinit)		/* no else */
+  {
+    pc -= sizeof(Word)+1;
+    elseinit = pc;
+  }
+  else
+  {
+    basepc[elseAdd] = JMP;
+    code_word_at(basepc+elseAdd+1, pc-elseinit);
+  }
+  basepc[thenAdd] = IFFJMP;
+  code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
+}
+
+
+/*
+** Parse LUA code.
+*/
+void lua_parse (TFunc *tf)
+{
+ initcode = &(tf->code);
+ *initcode = newvector(CODE_BLOCK, Byte);
+ maincode = 0; 
+ maxmain = CODE_BLOCK;
+ change2main();
+ if (yyparse ()) lua_error("parse error");
+ savemain();
+ (*initcode)[maincode++] = RETCODE0;
+ tf->size = maincode;
+#if LISTING
+{ static void PrintCode (Byte *c, Byte *end);
+ PrintCode(*initcode,*initcode+maincode); }
+#endif
+}
+
+
+%}
+
+
+%union 
+{
+ int   vInt;
+ float vFloat;
+ char *pChar;
+ Word  vWord;
+ Long  vLong;
+ TFunc *pFunc;
+ TaggedString *pTStr;
+}
+
+%start chunk
+
+%token WRONGTOKEN
+%token NIL
+%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
+%token RETURN
+%token LOCAL
+%token FUNCTION
+%token DOTS
+%token <vFloat> NUMBER
+%token <vWord>  STRING
+%token <pTStr>  NAME 
+
+%type <vLong> PrepJump
+%type <vLong> exprlist, exprlist1  /* if > 0, points to function return
+	counter (which has list length); if <= 0, -list lenght */
+%type <vLong> functioncall, expr  /* if != 0, points to function return
+					 counter */
+%type <vInt>  varlist1, funcParams, funcvalue
+%type <vInt>  fieldlist, localdeclist, decinit
+%type <vInt>  ffieldlist, ffieldlist1, semicolonpart
+%type <vInt>  lfieldlist, lfieldlist1
+%type <vInt>  parlist, parlist1, par
+%type <vLong> var, singlevar, funcname
+%type <pFunc> body
+
+%left AND OR
+%left EQ NE '>' '<' LE GE
+%left CONC
+%left '+' '-'
+%left '*' '/'
+%left UNARY NOT
+%right '^'
+
+
+%% /* beginning of rules section */
+
+chunk	: chunklist ret ;
+
+chunklist : /* empty */
+	  | chunklist stat sc
+	  | chunklist function
+	  ;
+
+function     : FUNCTION funcname body 	 
+	       { 
+		code_byte(PUSHFUNCTION);
+		code_code($3);
+		storesinglevar($2);
+	       }
+	       ;
+
+funcname	: var { $$ =$1; init_func(); }
+		| varexp ':' NAME
+	{
+	  code_constant($3);
+	  $$ = 0;  /* indexed variable */
+	  init_func();
+	  add_localvar(luaI_createfixedstring("self"));
+	}
+		;
+
+body :  '(' parlist ')' block END
+	{
+          codereturn();
+	  $$ = new(TFunc);
+          luaI_initTFunc($$);
+	  $$->size = pc;
+	  $$->code = newvector(pc, Byte);
+	  $$->fileName = lua_parsedfile;
+	  $$->lineDefined = $2;
+	  memcpy($$->code, basepc, pc*sizeof(Byte));
+          if (lua_debug)
+            luaI_closelocalvars($$);
+	  /* save func values */
+	  funcCode = basepc; maxcode=maxcurr;
+#if LISTING
+                PrintCode(funcCode,funcCode+pc);
+#endif
+	  change2main();  /* change back to main code */
+	}
+		;
+
+statlist : /* empty */
+	 | statlist stat sc
+	 ;
+
+sc	 : /* empty */ | ';' ;
+
+stat   : IF expr1 THEN PrepJump block PrepJump elsepart END
+	{ codeIf($4, $6); }
+
+       | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
+       {
+        basepc[$5] = IFFJMP;
+	code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
+        basepc[$7] = UPJMP;
+	code_word_at(basepc+$7+1, pc - ($<vLong>2));
+       }
+     
+       | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
+       {
+        basepc[$6] = IFFUPJMP;
+	code_word_at(basepc+$6+1, pc - ($<vLong>2));
+       }
+
+       | varlist1 '=' exprlist1
+       {
+        {
+         int i;
+         adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer);
+	 for (i=nvarbuffer-1; i>=0; i--)
+	  lua_codestore (i);
+	 if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
+	  lua_codeadjust (0);
+	}
+       } 
+       | functioncall {;}
+       | LOCAL localdeclist decinit
+	{ nlocalvar += $2;
+	  adjust_mult_assign($2, $3, 0);
+	}
+       ;
+
+elsepart : /* empty */
+	 | ELSE block
+         | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
+	{ codeIf($4, $6); }
+         ;
+     
+block    : {$<vInt>$ = nlocalvar;} statlist ret 
+         {
+	  if (nlocalvar != $<vInt>1)
+	  {
+           if (lua_debug)
+             for (; nlocalvar > $<vInt>1; nlocalvar--)
+               luaI_unregisterlocalvar(lua_linenumber);
+           else
+             nlocalvar = $<vInt>1;
+	   lua_codeadjust (0);
+	  }
+         }
+         ;
+
+ret	: /* empty */
+        | RETURN exprlist sc
+          {
+	   adjust_functioncall($2, MULT_RET);
+           codereturn();
+          }
+	;
+
+PrepJump : /* empty */
+	 { 
+	  $$ = pc;
+	  code_byte(0);		/* open space */
+	  code_word (0);
+         }
+	 ;
+	   
+expr1	 : expr { adjust_functioncall($1, 1); }
+	 ;
+				
+expr :  '(' expr ')'  { $$ = $2; }
+     |  expr1 EQ  expr1	{ code_byte(EQOP);   $$ = 0; }
+     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 0; }
+     |	expr1 '>' expr1	{ code_byte(GTOP);   $$ = 0; }
+     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 0; }
+     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 0; }
+     |	expr1 GE  expr1	{ code_byte(GEOP);   $$ = 0; }
+     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 0; }
+     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 0; }
+     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 0; }
+     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 0; }
+     |	expr1 '^' expr1 { code_byte(POWOP);  $$ = 0; }
+     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 0; }
+     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 0;}
+     | table { $$ = 0; }
+     |  varexp          { $$ = 0;}
+     |  NUMBER          { code_number($1); $$ = 0; }
+     |  STRING
+     {
+       code_string($1);
+       $$ = 0;
+     }
+     |	NIL		{code_byte(PUSHNIL); $$ = 0; }
+     |  functioncall    { $$ = $1; }
+     |	NOT expr1	{ code_byte(NOTOP);  $$ = 0;}
+     |	expr1 AND PrepJump {code_byte(POP); } expr1
+     { 
+      basepc[$3] = ONFJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 0;
+     }
+     |	expr1 OR PrepJump {code_byte(POP); } expr1	
+     { 
+      basepc[$3] = ONTJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 0;
+     }
+     ;
+
+table :
+     {
+      code_byte(CREATEARRAY);
+      $<vLong>$ = pc; code_word(0);
+     }
+      '{' fieldlist '}'
+     {
+      code_word_at(basepc+$<vLong>1, $3);
+     }
+         ;
+
+functioncall : funcvalue funcParams
+	{
+	  code_byte(CALLFUNC);
+	  code_byte($1+$2);
+	  $$ = pc;
+	  code_byte(0);  /* may be modified by other rules */
+	}
+	     ;
+
+funcvalue    : varexp { $$ = 0; }
+	     | varexp ':' NAME 
+	     { 
+               code_byte(PUSHSELF); 
+	       code_word(luaI_findconstant($3));
+               $$ = 1;
+	     }
+	     ;
+
+funcParams :	'(' exprlist ')'
+	{ $$ = adjust_functioncall($2, 1); }
+	|	table  { $$ = 1; }
+	;
+
+exprlist  :	/* empty */		{ $$ = 0; }
+	  |	exprlist1		{ $$ = $1; }
+	  ;
+		
+exprlist1 :  expr	{ if ($1 != 0) $$ = $1; else $$ = -1; }
+	  |  exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr 
+	{
+	  if ($4 == 0) $$ = -($<vLong>3 + 1);  /* -length */
+	  else
+	  {
+	    adjust_functioncall($4, $<vLong>3);
+	    $$ = $4;
+	  }
+	}
+	  ;
+
+parlist  :	/* empty */ { $$ = close_parlist(0); }
+	  |	parlist1    { $$ = close_parlist($1); }
+	  ;
+		
+parlist1 :	par		  { $$ = $1; }
+	  |	parlist1 ',' par
+	{
+	  if ($1)
+            lua_error("invalid parameter list");
+          $$ = $3;
+	}
+	  ;
+
+par : NAME	{ add_localvar($1); $$ = 0; }
+    | DOTS	{ $$ = 1; }
+    ;
+		
+fieldlist  : lfieldlist
+  	     { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+	     semicolonpart
+	     { $$ = $1+$3; }
+	   | ffieldlist1 lastcomma
+	     { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
+	   ;
+
+semicolonpart : /* empty */
+	        { $$ = 0; }
+	      | ';' ffieldlist
+	        { $$ = $2; flush_record($2%FIELDS_PER_FLUSH); }
+	      ;
+
+lastcomma  : /* empty */ 
+	   | ','
+	   ;
+
+ffieldlist  : /* empty */ { $$ = 0; }
+            | ffieldlist1 lastcomma { $$ = $1; }
+            ;   
+
+ffieldlist1 : ffield			{$$=1;}
+	   | ffieldlist1 ',' ffield	
+		{
+		  $$=$1+1;
+		  if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
+		}
+	   ; 
+
+ffield      : ffieldkey '=' expr1
+           ;
+
+ffieldkey   : '[' expr1 ']'
+	    | NAME { code_constant($1); }
+	    ;
+
+lfieldlist  : /* empty */ { $$ = 0; }
+	    | lfieldlist1 lastcomma { $$ = $1; }
+	    ;
+
+lfieldlist1 : expr1  {$$=1;}
+	    | lfieldlist1 ',' expr1
+		{
+		  $$=$1+1;
+		  if ($$%FIELDS_PER_FLUSH == 0) 
+		    flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH);
+		}
+            ;
+
+varlist1  :	var			
+	  {
+	   nvarbuffer = 0; 
+	   add_varbuffer($1);
+	   $$ = ($1 == 0) ? 1 : 0;
+	  }
+	  |	varlist1 ',' var	
+	  { 
+	   add_varbuffer($3);
+	   $$ = ($3 == 0) ? $1 + 1 : $1;
+	  }
+	  ;
+		
+var	  :	singlevar { $$ = $1; }
+	  |	varexp '[' expr1 ']' 
+	  {
+	   $$ = 0;		/* indexed variable */
+	  }
+	  |	varexp '.' NAME
+	  {
+	    code_constant($3);
+	    $$ = 0;		/* indexed variable */
+	  }
+	  ;
+		
+singlevar :	NAME
+	  {
+	   int local = lua_localname($1);
+	   if (local == -1)	/* global var */
+	    $$ = luaI_findsymbol($1)+1;  /* return positive value */
+           else
+	    $$ = -(local+1);		/* return negative value */
+	  }
+	  ;
+
+varexp	: var { lua_pushvar($1); }
+	;
+	  
+localdeclist  : NAME {store_localvar($1, 0); $$ = 1;}
+     	  | localdeclist ',' NAME 
+	    {
+	     store_localvar($3, $1);
+	     $$ = $1+1;
+	    }
+	  ;
+		
+decinit	  : /* empty */  { $$ = 0; }
+	  | '=' exprlist1 { $$ = $2; }
+	  ;
+	  
+%%

luadebug.h

@@ -0,0 +1,31 @@
+/*
+** LUA - Linguagem para Usuarios de Aplicacao
+** Grupo de Tecnologia em Computacao Grafica
+** TeCGraf - PUC-Rio
+** $Id: luadebug.h,v 1.5 1996/02/08 17:03:20 roberto Exp roberto $
+*/
+
+
+#ifndef luadebug_h
+#define luadebug_h
+
+#include "lua.h"
+
+typedef lua_Object lua_Function;
+
+typedef void (*lua_LHFunction) (int line);
+typedef void (*lua_CHFunction) (lua_Function func, char *file, int line);
+
+lua_Function lua_stackedfunction (int level);
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
+int lua_currentline (lua_Function func);
+char *lua_getobjname (lua_Object o, char **name);
+
+lua_Object lua_getlocal (lua_Function func, int local_number, char **name);
+int lua_setlocal (lua_Function func, int local_number);
+
+extern lua_LHFunction lua_linehook;
+extern lua_CHFunction lua_callhook;
+extern int lua_debug;
+
+#endif

lualib.h

@@ -1,15 +1,29 @@
 /*
-** Libraries to use in LUA programs
+** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** 19 May 93
+** $Id: lualib.h,v 1.12 1997/03/18 15:30:50 roberto Exp roberto $
 */
 
 #ifndef lualib_h
 #define lualib_h
 
+#include "lua.h"
+
 void iolib_open   (void);
 void strlib_open  (void);
 void mathlib_open (void);
 
+
+
+/* auxiliar functions (private) */
+
+char *luaI_addchar (int c);
+void luaI_emptybuff (void);
+void luaI_addquoted (char *s);
+
+char *luaL_item_end (char *p);
+int luaL_singlematch (int c, char *p);
+
 #endif
+

luamem.c

@@ -0,0 +1,159 @@
+/*
+** mem.c
+** TecCGraf - PUC-Rio
+*/
+
+char *rcs_luamem = "$Id: luamem.c,v 1.15 1997/03/31 14:17:09 roberto Exp roberto $";
+
+#include <stdlib.h>
+
+#include "luamem.h"
+#include "lua.h"
+
+
+#define DEBUG 0
+
+#if !DEBUG
+
+void luaI_free (void *block)
+{
+  if (block)
+  {
+    *((char *)block) = -1;  /* to catch errors */
+    free(block);
+  }
+}
+
+
+void *luaI_realloc (void *oldblock, unsigned long size)
+{
+  void *block;
+  size_t s = (size_t)size;
+  if (s != size)
+    lua_error("Allocation Error: Block too big");
+  block = oldblock ? realloc(oldblock, s) : malloc(s);
+  if (block == NULL)
+    lua_error(memEM);
+  return block;
+}
+
+
+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;
+}
+
+#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

@@ -0,0 +1,39 @@
+/*
+** mem.c
+** memory manager for lua
+** $Id: luamem.h,v 1.8 1996/05/24 14:31:10 roberto Exp roberto $
+*/
+ 
+#ifndef luamem_h
+#define luamem_h
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+
+/* memory error messages */
+#define codeEM   "code size overflow"
+#define symbolEM   "symbol table overflow"
+#define constantEM   "constant table overflow"
+#define stackEM   "stack size overflow"
+#define lexEM   "lex buffer overflow"
+#define refEM   "reference table overflow"
+#define tableEM  "table overflow"
+#define memEM "not enough memory"
+
+
+void luaI_free (void *block);
+void *luaI_realloc (void *oldblock, unsigned long size);
+void *luaI_buffer (unsigned long size);
+int luaI_growvector (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit);
+
+#define luaI_malloc(s)	luaI_realloc(NULL, (s))
+#define new(s)          ((s *)luaI_malloc(sizeof(s)))
+#define newvector(n,s)  ((s *)luaI_malloc((n)*sizeof(s)))
+#define growvector(old,n,s,e,l) \
+          (luaI_growvector((void**)old,n,sizeof(s),e,l))
+
+#endif 
+

makefile

@@ -0,0 +1,105 @@
+# $Id: makefile,v 1.32 1997/03/31 20:58:42 roberto Exp roberto $
+
+#configuration
+
+# define (undefine) POPEN if your system (does not) support piped I/O
+# 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)
+CONFIG = -DPOPEN -D_POSIX_SOURCE
+# Compilation parameters
+CC = gcc
+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
+
+AR = ar
+ARFLAGS	= rvl
+
+
+# Aplication modules
+LUAOBJS = \
+	parser.o \
+	lex.o \
+	opcode.o \
+	hash.o \
+	table.o \
+	inout.o \
+	tree.o \
+	fallback.o \
+	luamem.o \
+	func.o \
+	undump.o \
+	auxlib.o
+
+LIBOBJS = 	\
+	iolib.o \
+	mathlib.o \
+	strlib.o
+
+
+lua : lua.o liblua.a liblualib.a
+	$(CC) $(CFLAGS) -o $@ lua.o -L. -llua -llualib -lm
+
+liblua.a : $(LUAOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib $@
+
+liblualib.a : $(LIBOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib $@
+
+liblua.so.1.0 : lua.o
+	ld -o liblua.so.1.0 $(LUAOBJS)
+
+y.tab.c y.tab.h  : lua.stx
+	yacc -d lua.stx
+
+parser.c : y.tab.c
+	sed -e 's/yy/luaY_/g' -e 's/malloc\.h/stdlib\.h/g' y.tab.c > parser.c
+
+parser.h : y.tab.h
+	sed -e 's/yy/luaY_/g' y.tab.h > parser.h
+
+clear	:
+	rcsclean
+	rm -f *.o
+	rm -f parser.c parser.h y.tab.c y.tab.h
+	co lua.h lualib.h luadebug.h
+
+
+%.h : RCS/%.h,v
+	co $@
+
+%.c : RCS/%.c,v
+	co $@
+
+
+auxlib.o: auxlib.c lua.h auxlib.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 lex.h opcode.h types.h tree.h func.h \
+ inout.h table.h hash.h luamem.h fallback.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 inout.h luadebug.h parser.h
+lua.o: lua.c lua.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 undump.h auxlib.h
+parser.o: parser.c luadebug.h lua.h luamem.h lex.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 opcode.h types.h tree.h \
+ func.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 hash.h opcode.h \
+ func.h table.h fallback.h
+undump.o: undump.c opcode.h lua.h types.h tree.h func.h luamem.h \
+ table.h undump.h

mathlib.c

@@ -1,26 +1,26 @@
 /*
 ** mathlib.c
-** Mathematica library to LUA
+** Mathematics library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
-#include <stdio.h>		/* NULL */
+char *rcs_mathlib="$Id: mathlib.c,v 1.22 1997/04/04 22:24:51 roberto Exp roberto $";
+
+#include <stdlib.h>
 #include <math.h>
 
+#include "lualib.h"
+#include "auxlib.h"
 #include "lua.h"
 
+#ifndef PI
+#define PI          3.14159265358979323846
+#endif
+#define TODEGREE(a) ((a)*180.0/PI)
+#define TORAD(a)    ((a)*PI/180.0)
+
 static void math_abs (void)
 {
- double d;
+ double d = luaL_check_number(1); 
- lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `abs'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `abs'"); return; }
- d = lua_getnumber(o);
  if (d < 0) d = -d;
  lua_pushnumber (d);
 }
@@ -28,207 +28,188 @@ static void math_abs (void)
 
 static void math_sin (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (sin(TORAD(d)));
- if (o == NULL)
- { lua_error ("too few arguments to function `sin'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `sin'"); return; }
- d = lua_getnumber(o);
- lua_pushnumber (sin(d));
 }
 
 
 
 static void math_cos (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (cos(TORAD(d)));
- if (o == NULL)
- { lua_error ("too few arguments to function `cos'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `cos'"); return; }
- d = lua_getnumber(o);
- lua_pushnumber (cos(d));
 }
 
 
 
 static void math_tan (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (tan(TORAD(d)));
- if (o == NULL)
- { lua_error ("too few arguments to function `tan'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `tan'"); return; }
- d = lua_getnumber(o);
- lua_pushnumber (tan(d));
 }
 
 
 static void math_asin (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (TODEGREE(asin(d)));
- if (o == NULL)
- { lua_error ("too few arguments to function `asin'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `asin'"); return; }
- d = lua_getnumber(o);
- lua_pushnumber (asin(d));
 }
 
 
 static void math_acos (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (TODEGREE(acos(d)));
- if (o == NULL)
- { lua_error ("too few arguments to function `acos'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `acos'"); return; }
- d = lua_getnumber(o);
- lua_pushnumber (acos(d));
 }
 
 
-
 static void math_atan (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
+ lua_pushnumber (TODEGREE(atan(d)));
- if (o == NULL)
+}
- { lua_error ("too few arguments to function `atan'"); return; }
+
- if (!lua_isnumber(o))
+
- { lua_error ("incorrect arguments to function `atan'"); return; }
+static void math_atan2 (void)
- d = lua_getnumber(o);
+{
- lua_pushnumber (atan(d));
+ 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;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `ceil'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `ceil'"); return; }
- d = lua_getnumber(o);
  lua_pushnumber (ceil(d));
 }
 
 
 static void math_floor (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `floor'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `floor'"); return; }
- d = lua_getnumber(o);
  lua_pushnumber (floor(d));
 }
 
 static void math_mod (void)
 {
- int d1, d2;
+  float x = luaL_check_number(1);
- lua_Object o1 = lua_getparam (1);
+  float y = luaL_check_number(2);
- lua_Object o2 = lua_getparam (2);
+  lua_pushnumber(fmod(x, y));
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `mod'"); return; }
- d1 = (int) lua_getnumber(o1);
- d2 = (int) lua_getnumber(o2);
- lua_pushnumber (d1%d2);
 }
 
 
 static void math_sqrt (void)
 {
- double d;
+ double d = luaL_check_number(1);
- lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `sqrt'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `sqrt'"); return; }
- d = lua_getnumber(o);
  lua_pushnumber (sqrt(d));
 }
 
+
 static void math_pow (void)
 {
- double d1, d2;
+  double d1 = luaL_check_number(1);
- lua_Object o1 = lua_getparam (1);
+  double d2 = luaL_check_number(2);
- lua_Object o2 = lua_getparam (2);
+  lua_pushnumber(pow(d1,d2));
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `pow'"); return; }
- d1 = lua_getnumber(o1);
- d2 = lua_getnumber(o2);
- lua_pushnumber (pow(d1,d2));
 }
 
 static void math_min (void)
 {
  int i=1;
- double d, dmin;
+ double dmin = luaL_check_number(i);
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- if ((o = lua_getparam(i++)) == NULL)
- { lua_error ("too few arguments to function `min'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `min'"); return; }
- dmin = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != NULL)
  {
-  if (!lua_isnumber(o))
+  double d = luaL_check_number(i);
-  { lua_error ("incorrect arguments to function `min'"); return; }
-  d = lua_getnumber (o);
   if (d < dmin) dmin = d;
  }
  lua_pushnumber (dmin);
 }
 
-
 static void math_max (void)
 {
  int i=1;
- double d, dmax;
+ double dmax = luaL_check_number(i);
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- if ((o = lua_getparam(i++)) == NULL)
- { lua_error ("too few arguments to function `max'"); return; }
- if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `max'"); return; }
- dmax = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != NULL)
  {
-  if (!lua_isnumber(o))
+  double d = luaL_check_number(i);
-  { lua_error ("incorrect arguments to function `max'"); return; }
-  d = lua_getnumber (o);
   if (d > dmax) dmax = d;
  }
  lua_pushnumber (dmax);
 }
 
+static void math_log (void)
+{
+ double d = luaL_check_number(1);
+ lua_pushnumber (log(d));
+}
 
 
+static void math_log10 (void)
+{
+ double d = luaL_check_number(1);
+ lua_pushnumber (log10(d));
+}
+
+
+static void math_exp (void)
+{
+ double d = luaL_check_number(1);
+ lua_pushnumber (exp(d));
+}
+
+static void math_deg (void)
+{
+ float d = luaL_check_number(1);
+ lua_pushnumber (d*180./PI);
+}
+
+static void math_rad (void)
+{
+ float d = luaL_check_number(1);
+ lua_pushnumber (d/180.*PI);
+}
+
+static void math_random (void)
+{
+  lua_pushnumber((double)(rand()%RAND_MAX) / (double)RAND_MAX);
+}
+
+static void math_randomseed (void)
+{
+  srand(luaL_check_number(1));
+}
+
+
+static struct luaL_reg mathlib[] = {
+{"abs",   math_abs},
+{"sin",   math_sin},
+{"cos",   math_cos},
+{"tan",   math_tan},
+{"asin",  math_asin},
+{"acos",  math_acos},
+{"atan",  math_atan},
+{"atan2",  math_atan2},
+{"ceil",  math_ceil},
+{"floor", math_floor},
+{"mod",   math_mod},
+{"sqrt",  math_sqrt},
+{"min",   math_min},
+{"max",   math_max},
+{"log",   math_log},
+{"log10", math_log10},
+{"exp",   math_exp},
+{"deg",   math_deg},
+{"rad",   math_rad},
+{"random",     math_random},
+{"randomseed", math_randomseed}
+};
+
 /*
 ** Open math library
 */
 void mathlib_open (void)
 {
- lua_register ("abs",   math_abs);
+  luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
- lua_register ("sin",   math_sin);
+  lua_settagmethod(0, "pow", math_pow);
- lua_register ("cos",   math_cos);
- lua_register ("tan",   math_tan);
- lua_register ("asin",  math_asin);
- lua_register ("acos",  math_acos);
- lua_register ("atan",  math_atan);
- lua_register ("ceil",  math_ceil);
- lua_register ("floor", math_floor);
- lua_register ("mod",   math_mod);
- lua_register ("sqrt",  math_sqrt);
- lua_register ("pow",   math_pow);
- lua_register ("min",   math_min);
- lua_register ("max",   math_max);
 }
+

mathlib.h

@@ -0,0 +1,13 @@
+/*
+** Math library to LUA
+** TeCGraf - PUC-Rio
+** $Id: $
+*/
+
+
+#ifndef strlib_h
+
+void mathlib_open (void);
+
+#endif
+

opcode.h

@@ -1,144 +1,170 @@
 /*
-** opcode.h
 ** TeCGraf - PUC-Rio
-** 16 Apr 92
+** $Id: opcode.h,v 3.32 1997/04/04 22:24:51 roberto Exp roberto $
 */
 
 #ifndef opcode_h
 #define opcode_h
 
-#ifndef STACKGAP
+#include "lua.h"
-#define STACKGAP	128
+#include "types.h"
-#endif 
+#include "tree.h"
+#include "func.h"
 
-#ifndef real
-#define real float
-#endif
 
-typedef unsigned char  Byte;
+#define FIELDS_PER_FLUSH 40
-
-typedef unsigned short Word;
-
-typedef enum 
-{ 
- NOP,
- PUSHNIL,
- PUSH0, PUSH1, PUSH2,
- PUSHBYTE,
- PUSHWORD,
- PUSHFLOAT,
- PUSHSTRING,
- PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
- PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
- PUSHLOCAL,
- PUSHGLOBAL,
- PUSHINDEXED,
- PUSHMARK,
- PUSHOBJECT,
- STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
- STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
- STORELOCAL,
- STOREGLOBAL,
- STOREINDEXED0,
- STOREINDEXED,
- STOREFIELD,
- ADJUST,
- CREATEARRAY,
- EQOP,
- LTOP,
- LEOP,
- ADDOP,
- SUBOP,
- MULTOP,
- DIVOP,
- CONCOP,
- MINUSOP,
- NOTOP,
- ONTJMP,
- ONFJMP,
- JMP,
- UPJMP,
- IFFJMP,
- IFFUPJMP,
- POP,
- CALLFUNC,
- RETCODE,
- HALT,
- SETFUNCTION,
- SETLINE,
- RESET
-} OpCode;
 
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER LUA_T"
+*/
 typedef enum
 {
- T_MARK,
+ LUA_T_NIL      = -9,
- T_NIL,
+ LUA_T_NUMBER   = -8,
- T_NUMBER,
+ LUA_T_STRING   = -7,
- T_STRING,
+ LUA_T_ARRAY    = -6,  /* array==table */
- T_ARRAY,
+ LUA_T_FUNCTION = -5,
- T_FUNCTION,
+ LUA_T_CFUNCTION= -4,
- T_CFUNCTION,
+ LUA_T_MARK     = -3,
- T_USERDATA
+ LUA_T_CMARK    = -2,
-} Type; 
+ 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
+-----------------------------------------------------------------------------*/
+
+PUSHNIL,/*		-		nil  */
+PUSH0,/*		-		0.0  */
+PUSH1,/*		-		1.0  */
+PUSH2,/*		-		2.0  */
+PUSHBYTE,/*	b	-		(float)b  */
+PUSHWORD,/*	w	-		(float)w  */
+PUSHFLOAT,/*	f	-		f  */
+PUSHSTRING,/*	w	-		STR[w]  */
+PUSHFUNCTION,/*	p	-		FUN(p)  */
+PUSHLOCAL0,/*		-		LOC[0]  */
+PUSHLOCAL1,/*		-		LOC[1]  */
+PUSHLOCAL2,/*		-		LOC[2]  */
+PUSHLOCAL3,/*		-		LOC[3]  */
+PUSHLOCAL4,/*		-		LOC[4]  */
+PUSHLOCAL5,/*		-		LOC[5]  */
+PUSHLOCAL6,/*		-		LOC[6]  */
+PUSHLOCAL7,/*		-		LOC[7]  */
+PUSHLOCAL8,/*		-		LOC[8]  */
+PUSHLOCAL9,/*		-		LOC[9]  */
+PUSHLOCAL,/*	b	-		LOC[b]  */
+PUSHGLOBAL,/*	w	-		VAR[w]  */
+PUSHINDEXED,/*		i t		t[i]  */
+PUSHSELF,/*	w	t		t t[STR[w]]  */
+STORELOCAL0,/*		x		-		LOC[0]=x  */
+STORELOCAL1,/*		x		-		LOC[1]=x  */
+STORELOCAL2,/*		x		-		LOC[2]=x  */
+STORELOCAL3,/*		x		-		LOC[3]=x  */
+STORELOCAL4,/*		x		-		LOC[4]=x  */
+STORELOCAL5,/*		x		-		LOC[5]=x  */
+STORELOCAL6,/*		x		-		LOC[6]=x  */
+STORELOCAL7,/*		x		-		LOC[7]=x  */
+STORELOCAL8,/*		x		-		LOC[8]=x  */
+STORELOCAL9,/*		x		-		LOC[9]=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,/*	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)  */
+EQOP,/*			y x		(x==y)? 1 : nil  */
+LTOP,/*			y x		(x<y)? 1 : nil  */
+LEOP,/*			y x		(x<y)? 1 : nil  */
+GTOP,/*			y x		(x>y)? 1 : nil  */
+GEOP,/*			y x		(x>=y)? 1 : nil  */
+ADDOP,/*		y x		x+y  */
+SUBOP,/*		y x		x-y  */
+MULTOP,/*		y x		x*y  */
+DIVOP,/*		y x		x/y  */
+POWOP,/*		y x		x^y  */
+CONCOP,/*		y x		x..y  */
+MINUSOP,/*		x		-x  */
+NOTOP,/*		x		(x==nil)? 1 : nil  */
+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  */
+IFFUPJMP,/*	w	x		-		(x==nil)? PC-=w  */
+POP,/*			x		-  */
+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_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;
+
+
+#define MULT_RET	255
 
-typedef void (*Cfunction) (void);
-typedef int  (*Input) (void);
-typedef void (*Unput) (int );
 
 typedef union
 {
- Cfunction 	 f;
+ lua_CFunction f;
- real    	 n;
+ real          n;
- char      	*s;
+ TaggedString *ts;
- Byte      	*b;
+ TFunc         *tf;
  struct Hash    *a;
- void           *u;
+ int	       i;
 } Value;
 
-typedef struct Object
+typedef struct TObject
 {
- Type  tag;
+ lua_Type ttype;
  Value value;
-} Object;
+} TObject;
 
-typedef struct
-{
- char   *name;
- Object  object;
-} Symbol;
 
 /* 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.s)
+#define svalue(o)	((o)->value.ts->str)
-#define bvalue(o)	((o)->value.b)
+#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_name(i)	(lua_table[i].name)
 #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_bvalue(i)	(bvalue(&s_object(i)))
+#define s_tsvalue(i)	(tsvalue(&s_object(i)))
 #define s_avalue(i)	(avalue(&s_object(i)))
 #define s_fvalue(i)	(fvalue(&s_object(i)))
 #define s_uvalue(i)	(uvalue(&s_object(i)))
 
+#define get_word(code,pc) {memcpy(&code, pc, sizeof(Word)); pc+=sizeof(Word);}
+#define get_float(code,pc){memcpy(&code, pc, sizeof(real)); pc+=sizeof(real);}
+#define get_code(code,pc) {memcpy(&code, pc, sizeof(TFunc *)); \
+                           pc+=sizeof(TFunc *);}
+
 
 /* Exported functions */
-int     lua_execute   (Byte *pc);
+void    lua_parse      (TFunc *tf);	/* from "lua.stx" module */
-void    lua_markstack (void);
+void	luaI_codedebugline (int line);  /* from "lua.stx" module */
-char   *lua_strdup (char *l);
+void    lua_travstack (int (*fn)(TObject *));
-
+TObject *luaI_Address (lua_Object o);
-void    lua_setinput   (Input fn);	/* from "lua.lex" module */
+void	luaI_pushobject (TObject *o);
-void    lua_setunput   (Unput fn);	/* from "lua.lex" module */
+void    luaI_gcIM       (TObject *o);
-char   *lua_lasttext   (void);		/* from "lua.lex" module */
+int     luaI_dorun (TFunc *tf);
-int     lua_parse      (void); 		/* from "lua.stx" module */
-void    lua_type       (void);
-void 	lua_obj2number (void);
-void 	lua_print      (void);
 
 #endif

strlib.c

@@ -1,121 +1,541 @@
 /*
 ** strlib.c
 ** String library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
-#include <stdlib.h>
+char *rcs_strlib="$Id: strlib.c,v 1.40 1997/04/06 14:08:08 roberto Exp roberto $";
+
 #include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
 #include <ctype.h>
 
-
 #include "lua.h"
+#include "auxlib.h"
+#include "lualib.h"
+
+
+struct lbuff {
+  char *b;
+  size_t max;
+  size_t size;
+};
+
+static struct lbuff lbuffer = {NULL, 0, 0};
+
+
+static char *strbuffer (unsigned long size)
+{
+  if (size > lbuffer.max) {
+    /* ANSI "realloc" doesn't need this test, but some machines (Sun!)
+       don't follow ANSI */
+    lbuffer.b = (lbuffer.b) ? realloc(lbuffer.b, lbuffer.max=size) :
+                              malloc(lbuffer.max=size);
+    if (lbuffer.b == NULL)
+      lua_error("memory overflow");
+  }
+  return lbuffer.b;
+}
+
+static char *openspace (unsigned long size)
+{
+  char *buff = strbuffer(lbuffer.size+size);
+  return buff+lbuffer.size;
+}
+
+char *luaI_addchar (int c)
+{
+  if (lbuffer.size >= lbuffer.max)
+    strbuffer(lbuffer.max == 0 ? 100 : lbuffer.max*2);
+  lbuffer.b[lbuffer.size++] = c;
+  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);
+  strncpy(b, s, n);
+  lbuffer.size += n;
+}
+
+static void addstr (char *s)
+{
+  addnchar(s, strlen(s));
+}
 
 /*
-** Return the position of the first caracter of a substring into a string
+** Interface to strtok
-** LUA interface:
-**			n = strfind (string, substring)
 */
-static void str_find (void)
+static void str_tok (void)
 {
- int n;
+  char *s1 = luaL_check_string(1);
- char *s1, *s2;
+  char *del = luaL_check_string(2);
- lua_Object o1 = lua_getparam (1);
+  lua_Object t = lua_createtable();
- lua_Object o2 = lua_getparam (2);
+  int i = 1;
- if (!lua_isstring(o1) || !lua_isstring(o2))
+  /* As strtok changes s1, and s1 is "constant",  make a copy of it */
- { lua_error ("incorrect arguments to function `strfind'"); return; }
+  s1 = strcpy(strbuffer(strlen(s1+1)), s1);
- s1 = lua_getstring(o1);
+  while ((s1 = strtok(s1, del)) != NULL) {
- s2 = lua_getstring(o2);
+    lua_pushobject(t);
- n = strstr(s1,s2) - s1 + 1;
+    lua_pushnumber(i++);
- lua_pushnumber (n);
+    lua_pushstring(s1);
+    lua_settable();
+    s1 = NULL;  /* prepare for next strtok */
+  }
+  lua_pushobject(t);
+  lua_pushnumber(i-1);  /* total number of tokens */
 }
 
+
 /*
 ** Return the string length
-** LUA interface:
-**			n = strlen (string)
 */
 static void str_len (void)
 {
- lua_Object o = lua_getparam (1);
+ lua_pushnumber(strlen(luaL_check_string(1)));
- if (!lua_isstring(o))
- { lua_error ("incorrect arguments to function `strlen'"); return; }
- lua_pushnumber(strlen(lua_getstring(o)));
 }
 
-
 /*
-** Return the substring of a string, from start to end
+** Return the substring of a string
-** LUA interface:
-**			substring = strsub (string, start, end)
 */
 static void str_sub (void)
 {
- int start, end;
+  char *s = luaL_check_string(1);
- char *s;
+  long start = (long)luaL_check_number(2);
- lua_Object o1 = lua_getparam (1);
+  long end = (long)luaL_opt_number(3, strlen(s));
- lua_Object o2 = lua_getparam (2);
+  if (1 <= start && start <= end && end <= strlen(s)) {
- lua_Object o3 = lua_getparam (3);
+    luaI_emptybuff();
- if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
+    addnchar(s+start-1, end-start+1);
- { lua_error ("incorrect arguments to function `strsub'"); return; }
+    lua_pushstring(luaI_addchar(0));
- s = strdup (lua_getstring(o1));
+  }
- start = lua_getnumber (o2);
+  else lua_pushliteral("");
- end = lua_getnumber (o3);
- if (end < start || start < 1 || end > strlen(s))
-  lua_pushstring ("");
- else
- {
-  s[end] = 0;
-  lua_pushstring (&s[start-1]);
- }
- free (s);
 }
 
 /*
 ** Convert a string to lower case.
-** LUA interface:
-**			lowercase = strlower (string)
 */
 static void str_lower (void)
 {
- char *s, *c;
+  char *s;
- lua_Object o = lua_getparam (1);
+  luaI_emptybuff();
- if (!lua_isstring(o))
+  for (s = luaL_check_string(1); *s; s++)
- { lua_error ("incorrect arguments to function `strlower'"); return; }
+    luaI_addchar(tolower((unsigned char)*s));
- c = s = strdup(lua_getstring(o));
+  lua_pushstring(luaI_addchar(0));
- while (*c != 0)
+}
- {
-  *c = tolower(*c);
-  c++;
- }
- lua_pushstring(s);
- free(s);
-} 
-
 
 /*
 ** Convert a string to upper case.
-** LUA interface:
-**			uppercase = strupper (string)
 */
 static void str_upper (void)
 {
- char *s, *c;
+  char *s;
- lua_Object o = lua_getparam (1);
+  luaI_emptybuff();
- if (!lua_isstring(o))
+  for (s = luaL_check_string(1); *s; s++)
- { lua_error ("incorrect arguments to function `strlower'"); return; }
+    luaI_addchar(toupper((unsigned char)*s));
- c = s = strdup(lua_getstring(o));
+  lua_pushstring(luaI_addchar(0));
- while (*c != 0)
+}
- {
+
-  *c = toupper(*c);
+static void str_rep (void)
-  c++;
+{
- }
+  char *s = luaL_check_string(1);
- lua_pushstring(s);
+  int n = (int)luaL_check_number(2);
- free(s);
+  luaI_emptybuff();
-} 
+  while (n-- > 0)
+    addstr(s);
+  lua_pushstring(luaI_addchar(0));
+}
+
+/*
+** get ascii value of a character in a string
+*/
+static void str_ascii (void)
+{
+  char *s = luaL_check_string(1);
+  long pos = (long)luaL_opt_number(2, 1) - 1;
+  luaL_arg_check(0<=pos && pos<strlen(s), 2,  "out of range");
+  lua_pushnumber((unsigned char)s[pos]);
+}
+
+
+/* pattern matching */
+
+#define ESC	'%'
+#define SPECIALS  "^$*?.([%-"
+
+static char *bracket_end (char *p)
+{
+  return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
+}
+
+char *luaL_item_end (char *p)
+{
+  switch (*p++) {
+    case '\0': return p-1;
+    case ESC:
+      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 (missing `]')");
+      return end+1;
+    }
+    default:
+      return p;
+  }
+}
+
+static int matchclass (int c, int cl)
+{
+  int res;
+  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((unsigned char)cl) ? res : !res);
+}
+
+int luaL_singlematch (int c, char *p)
+{
+  if (c == 0) return 0;
+  switch (*p) {
+    case '.': return 1;
+    case ESC: return matchclass(c, *(p+1));
+    case '[': {
+      char *end = bracket_end(p+1);
+      int sig = *(p+1) == '^' ? (p++, 0) : 1;
+      while (++p < end) {
+        if (*p == ESC) {
+          if (((p+1) < end) && matchclass(c, *++p)) return sig;
+        }
+        else if ((*(p+1) == '-') && (p+2 < end)) {
+          p+=2;
+          if (*(p-2) <= c && c <= *p) return sig;
+        }
+        else if (*p == c) return sig;
+      }
+      return !sig;
+    }
+    default: return (*p == c);
+  }
+}
+
+#define MAX_CAPT 9
+
+static struct {
+  char *init;
+  int len;  /* -1 signals unfinished capture */
+} capture[MAX_CAPT];
+
+static int num_captures;  /* only valid after a sucessful call to match */
+
+
+static void push_captures (void)
+{
+  int i;
+  for (i=0; i<num_captures; i++) {
+    int l = capture[i].len;
+    char *buff = openspace(l+1);
+    if (l == -1) lua_error("unfinished capture");
+    strncpy(buff, capture[i].init, l);
+    buff[l] = 0;
+    lua_pushstring(buff);
+  }
+}
+
+static int check_cap (int l, int level)
+{
+  l -= '1';
+  if (!(0 <= l && l < level && capture[l].len != -1))
+    lua_error("invalid capture index");
+  return l;
+}
+
+static int capture_to_close (int level)
+{
+  for (level--; level>=0; level--)
+    if (capture[level].len == -1) return level;
+  lua_error("invalid pattern capture");
+  return 0;  /* to avoid warnings */
+}
+
+static char *matchbalance (char *s, int b, int e)
+{
+  if (*s != b) return NULL;
+  else {
+    int cont = 1;
+    while (*(++s)) {
+      if (*s == e) {
+        if (--cont == 0) return s+1;
+      }
+      else if (*s == b) cont++;
+    }
+  }
+  return NULL;  /* string ends out of balance */
+}
+
+static char *match (char *s, char *p, int level)
+{
+  init: /* using goto's to optimize tail recursion */
+  switch (*p) {
+    case '(':  /* start capture */
+      if (level >= MAX_CAPT) lua_error("too many captures");
+      capture[level].init = s;
+      capture[level].len = -1;
+      level++; p++; goto init;  /* return match(s, p+1, level); */
+    case ')': {  /* end capture */
+      int l = capture_to_close(level);
+      char *res;
+      capture[l].len = s - capture[l].init;  /* close capture */
+      if ((res = match(s, p+1, level)) == NULL) /* match failed? */
+        capture[l].len = -1;  /* undo capture */
+      return res;
+    }
+    case ESC:
+      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); */
+          p+=2; s+=capture[l].len; goto init;
+        }
+        else return NULL;
+      }
+      else if (*(p+1) == 'b') {  /* balanced string */
+        if (*(p+2) == 0 || *(p+3) == 0)
+          lua_error("bad balanced pattern specification");
+        s = matchbalance(s, *(p+2), *(p+3));
+        if (s == NULL) return NULL;
+        else {  /* return match(p+4, s, level); */
+          p+=4; goto init;
+        }
+      }
+      else goto dflt;
+    case '\0': case '$':  /* (possibly) end of pattern */
+      if (*p == 0 || (*(p+1) == 0 && *s == 0)) {
+        num_captures = level;
+        return s;
+      }
+      else goto dflt;
+    default: dflt: {  /* it is a pattern item */
+      int m = luaL_singlematch(*s, p);
+      char *ep = luaL_item_end(p);  /* get what is next */
+      switch (*ep) {
+        case '*': {  /* repetition */
+          char *res;
+          if (m && (res = match(s+1, p, 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)))
+            return res;
+          p=ep+1; goto init;  /* else return match(s, ep+1, level); */
+        }
+        default:
+          if (m) { s++; p=ep; goto init; }  /* return match(s+1, ep, level); */
+          else return NULL;
+      }
+    }
+  }
+}
+
+static void str_find (void)
+{
+  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);
+    if (s2) {
+      lua_pushnumber(s2-s+1);
+      lua_pushnumber(s2-s+strlen(p));
+    }
+  }
+  else {
+    int anchor = (*p == '^') ? (p++, 1) : 0;
+    char *s1=s+init;
+    do {
+      char *res;
+      if ((res=match(s1, p, 0)) != NULL) {
+        lua_pushnumber(s1-s+1);  /* start */
+        lua_pushnumber(res-s);   /* end */
+        push_captures();
+        return;
+      }
+    } while (*s1++ && !anchor);
+  }
+}
+
+static void add_s (lua_Object newp)
+{
+  if (lua_isstring(newp)) {
+    char *news = lua_getstring(newp);
+    while (*news) {
+      if (*news != ESC || !isdigit((unsigned char)*++news))
+        luaI_addchar(*news++);
+      else {
+        int l = check_cap(*news++, num_captures);
+        addnchar(capture[l].init, capture[l].len);
+      }
+    }
+  }
+  else if (lua_isfunction(newp)) {
+    lua_Object res;
+    struct lbuff oldbuff;
+    lua_beginblock();
+    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);
+    /* restore old buffer */
+    free(lbuffer.b);
+    lbuffer = oldbuff;
+    res = lua_getresult(1);
+    addstr(lua_isstring(res) ? lua_getstring(res) : "");
+    lua_endblock();
+  }
+  else luaL_arg_check(0, 3, NULL);
+}
+
+static void str_gsub (void)
+{
+  char *src = luaL_check_string(1);
+  char *p = luaL_check_string(2);
+  lua_Object newp = lua_getparam(3);
+  int max_s = (int)luaL_opt_number(4, strlen(src)+1);
+  int anchor = (*p == '^') ? (p++, 1) : 0;
+  int n = 0;
+  luaI_emptybuff();
+  while (n < max_s) {
+    char *e = match(src, p, 0);
+    if (e) {
+      add_s(newp);
+      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);
+  lua_pushstring(luaI_addchar(0));
+  lua_pushnumber(n);  /* number of substitutions */
+}
+
+static void str_set (void)
+{
+  char *item = luaL_check_string(1);
+  int i;
+  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 (luaL_singlematch(i, item))
+      luaI_addchar(i);
+  lua_pushstring(luaI_addchar(0));
+}
+
+
+void luaI_addquoted (char *s)
+{
+  luaI_addchar('"');
+  for (; *s; s++) {
+    if (strchr("\"\\\n", *s))
+      luaI_addchar('\\');
+    luaI_addchar(*s);
+  }
+  luaI_addchar('"');
+}
+
+#define MAX_FORMAT 200
+
+static void str_format (void)
+{
+  int arg = 1;
+  char *strfrmt = luaL_check_string(arg++);
+  luaI_emptybuff();  /* initialize */
+  while (*strfrmt) {
+    if (*strfrmt != '%')
+      luaI_addchar(*strfrmt++);
+    else if (*++strfrmt == '%')
+      luaI_addchar(*strfrmt++);  /* %% */
+    else { /* format item */
+      char form[MAX_FORMAT];      /* store the format ('%...') */
+      char *buff;
+      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 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(luaL_check_string(arg++));
+          continue;
+        case 's': {
+          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)luaL_check_number(arg++));
+          break;
+        case 'e':  case 'E': case 'f': case 'g':
+          sprintf(buff, form, luaL_check_number(arg++));
+          break;
+        default:  /* also treat cases 'pnLlh' */
+          lua_error("invalid format option in function `format'");
+      }
+      lbuffer.size += strlen(buff);
+    }
+  }
+  lua_pushstring(luaI_addchar(0));  /* push the result */
+}
+
+
+static struct luaL_reg strlib[] = {
+{"strtok", str_tok},
+{"strlen", str_len},
+{"strsub", str_sub},
+{"strset", str_set},
+{"strlower", str_lower},
+{"strupper", str_upper},
+{"strrep", str_rep},
+{"ascii", str_ascii},
+{"format", str_format},
+{"strfind", str_find},
+{"gsub", str_gsub}
+};
 
 
 /*
@@ -123,9 +543,5 @@ static void str_upper (void)
 */
 void strlib_open (void)
 {
- lua_register ("strfind", str_find);
+  luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
- lua_register ("strlen", str_len);
- lua_register ("strsub", str_sub);
- lua_register ("strlower", str_lower);
- lua_register ("strupper", str_upper);
 }

strlib.h

@@ -0,0 +1,13 @@
+/*
+** String library to LUA
+** TeCGraf - PUC-Rio
+** $Id: $
+*/
+
+
+#ifndef strlib_h
+
+void strlib_open (void);
+
+#endif
+

table.c

@@ -1,351 +1,252 @@
 /*
 ** table.c
 ** Module to control static tables
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
-#include <stdlib.h>
+char *rcs_table="$Id: table.c,v 2.67 1997/04/06 14:08:08 roberto Exp roberto $";
-#include <string.h>
 
+#include "luamem.h"
+#include "auxlib.h"
 #include "opcode.h"
+#include "tree.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
+#include "inout.h"
 #include "lua.h"
+#include "fallback.h"
+#include "luadebug.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==0)
 
-#ifndef MAXSYMBOL
+#define BUFFER_BLOCK 256
-#define MAXSYMBOL	512
-#endif
-static Symbol  		tablebuffer[MAXSYMBOL] = {
-                                    {"type",{T_CFUNCTION,{lua_type}}},
-                                    {"tonumber",{T_CFUNCTION,{lua_obj2number}}},
-                                    {"next",{T_CFUNCTION,{lua_next}}},
-                                    {"nextvar",{T_CFUNCTION,{lua_nextvar}}},
-                                    {"print",{T_CFUNCTION,{lua_print}}}
-                                                 };
-Symbol	       	       *lua_table=tablebuffer;
-Word   	 		lua_ntable=5;
 
-#ifndef MAXCONSTANT
+Symbol *lua_table = NULL;
-#define MAXCONSTANT	256
+Word lua_ntable = 0;
-#endif
+static Long lua_maxsymbol = 0;
-static char  	       *constantbuffer[MAXCONSTANT] = {"mark","nil","number",
-                                                       "string","table",
-                                                       "function","cfunction"
-                                                      };
-char  	      	      **lua_constant = constantbuffer;
-Word    		lua_nconstant=T_CFUNCTION+1;
 
-#ifndef MAXSTRING
+TaggedString **lua_constant = NULL;
-#define MAXSTRING	512
+Word lua_nconstant = 0;
-#endif
+static Long lua_maxconstant = 0;
-static char 	       *stringbuffer[MAXSTRING];
-char  		      **lua_string = stringbuffer;
-Word    		lua_nstring=0;
 
-#ifndef MAXARRAY
-#define MAXARRAY	512
-#endif
-static Hash             *arraybuffer[MAXARRAY];
-Hash  	              **lua_array = arraybuffer;
-Word    		lua_narray=0;
 
-#define MAXFILE 	20
+#define GARBAGE_BLOCK 50
-char  		       *lua_file[MAXFILE];
+
-int      		lua_nfile;
+
+void luaI_initsymbol (void)
+{
+  lua_maxsymbol = BUFFER_BLOCK;
+  lua_table = newvector(lua_maxsymbol, Symbol);
+  luaI_predefine();
+}
+
+
+/*
+** Initialise constant table with pre-defined constants
+*/
+void luaI_initconstant (void)
+{
+ lua_maxconstant = BUFFER_BLOCK;
+ lua_constant = newvector(lua_maxconstant, TaggedString *);
+ /* pre-register mem error messages, to avoid loop when error arises */
+ luaI_findconstantbyname(tableEM);
+ luaI_findconstantbyname(memEM);
+}
 
 
 /*
 ** Given a name, search it at symbol table and return its index. If not
-** found, allocate at end of table, checking oveflow and return its index.
+** found, allocate it.
-** On error, return -1.
 */
-int lua_findsymbol (char *s)
+Word luaI_findsymbol (TaggedString *t)
 {
- int i;
+ if (t->varindex == NOT_USED)
+ {
+  if (lua_ntable == lua_maxsymbol)
+    lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol,
+                      symbolEM, MAX_WORD);
+  t->varindex = lua_ntable;
+  lua_table[lua_ntable].varname = t;
+  s_ttype(lua_ntable) = LUA_T_NIL;
+  lua_ntable++;
+ }
+ return t->varindex;
+}
+
+
+Word luaI_findsymbolbyname (char *name)
+{
+  return luaI_findsymbol(luaI_createfixedstring(name));
+}
+
+
+/*
+** Given a tree node, check it is has a correspondent constant index. If not,
+** allocate it.
+*/
+Word luaI_findconstant (TaggedString *t)
+{
+ if (t->constindex == NOT_USED)
+ {
+  if (lua_nconstant == lua_maxconstant)
+    lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *,
+                        constantEM, MAX_WORD);
+  t->constindex = lua_nconstant;
+  lua_constant[lua_nconstant] = t;
+  lua_nconstant++;
+ }
+ return t->constindex;
+}
+
+
+Word  luaI_findconstantbyname (char *name)
+{
+  return luaI_findconstant(luaI_createfixedstring(name));
+}
+
+TaggedString *luaI_createfixedstring (char *name)
+{
+  TaggedString *ts = lua_createstring(name);
+  if (!ts->marked)
+    ts->marked = 2;  /* avoid GC */
+  return ts;
+}
+
+
+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)(TObject *))
+{
+ Word i;
  for (i=0; i<lua_ntable; i++)
-  if (streq(s,s_name(i)))
+  if (fn(&s_object(i)))
-   return i;
+    return lua_table[i].varname->str;
- if (lua_ntable >= MAXSYMBOL-1)
+ return NULL;
- {
-  lua_error ("symbol table overflow");
-  return -1;
- }
- s_name(lua_ntable) = strdup(s);
- if (s_name(lua_ntable) == NULL)
- {
-  lua_error ("not enough memory");
-  return -1;
- }
- s_tag(lua_ntable++) = T_NIL;
- 
- return (lua_ntable-1);
-}
-
-/*
-** Given a constant string, eliminate its delimeters (" or '), search it at 
-** constant table and return its index. If not found, allocate at end of 
-** the table, checking oveflow and return its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
-*/
-int lua_findenclosedconstant (char *s)
-{
- int i, j, l=strlen(s);
- char *c = calloc (l, sizeof(char)); 	/* make a copy */
- 
- c++;		/* create mark space */
-
- /* introduce scape characters */ 
- for (i=1,j=0; i<l-1; i++)
- {
-  if (s[i] == '\\')
-  {
-   switch (s[++i])
-   {
-    case 'n': c[j++] = '\n'; break;
-    case 't': c[j++] = '\t'; break;
-    case 'r': c[j++] = '\r'; break;
-    default : c[j++] = '\\'; c[j++] = c[i]; break;
-   }
-  }
-  else
-   c[j++] = s[i];
- }
- c[j++] = 0;
- 
- for (i=0; i<lua_nconstant; i++)
-  if (streq(c,lua_constant[i]))
-  {
-   free (c-1);
-   return i;
-  }
- if (lua_nconstant >= MAXCONSTANT-1)
- {
-  lua_error ("lua: constant string table overflow"); 
-  return -1;
- }
- lua_constant[lua_nconstant++] = c;
- return (lua_nconstant-1);
-}
-
-/*
-** Given a constant string, search it at constant table and return its index.
-** If not found, allocate at end of the table, checking oveflow and return 
-** its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
-*/
-int lua_findconstant (char *s)
-{
- int i;
- for (i=0; i<lua_nconstant; i++)
-  if (streq(s,lua_constant[i]))
-   return i;
- if (lua_nconstant >= MAXCONSTANT-1)
- {
-  lua_error ("lua: constant string table overflow"); 
-  return -1;
- }
- {
-  char *c = calloc(strlen(s)+2,sizeof(char));
-  c++;		/* create mark space */
-  lua_constant[lua_nconstant++] = strcpy(c,s);
- }
- return (lua_nconstant-1);
 }
 
 
 /*
 ** Mark an object if it is a string or a unmarked array.
 */
-void lua_markobject (Object *o)
+int lua_markobject (TObject *o)
-{
+{/* if already marked, does not change mark value */
- if (tag(o) == T_STRING)
+ if (ttype(o) == LUA_T_USERDATA ||
-  lua_markstring (svalue(o)) = 1;
+     (ttype(o) == LUA_T_STRING && !tsvalue(o)->marked))
- else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
+   tsvalue(o)->marked = 1;
+ else if (ttype(o) == LUA_T_ARRAY)
    lua_hashmark (avalue(o));
-}
+ else if ((o->ttype == LUA_T_FUNCTION || o->ttype == LUA_T_MARK)
-
+           && !o->value.tf->marked)
-/*
+   o->value.tf->marked = 1;
-** Mark all strings and arrays used by any object stored at symbol table.
-*/
-static void lua_marktable (void)
-{
- int i;
- for (i=0; i<lua_ntable; i++)
-  lua_markobject (&s_object(i));
-} 
-
-/*
-** Simulate a garbage colection. When string table or array table overflows,
-** this function check if all allocated strings and arrays are in use. If
-** there are unused ones, pack (compress) the tables.
-*/
-static void lua_pack (void)
-{
- lua_markstack ();
- lua_marktable ();
- 
- { /* pack string */
-  int i, j;
-  for (i=j=0; i<lua_nstring; i++)
-   if (lua_markstring(lua_string[i]) == 1)
-   {
-    lua_string[j++] = lua_string[i];
-    lua_markstring(lua_string[i]) = 0;
-   }
-   else
-   {
-    free (lua_string[i]-1);
-   }
-  lua_nstring = j;
- }
-
- { /* pack array */
-  int i, j;
-  for (i=j=0; i<lua_narray; i++)
-   if (markarray(lua_array[i]) == 1)
-   {
-    lua_array[j++] = lua_array[i];
-    markarray(lua_array[i]) = 0;
-   }
-   else
-   {
-    lua_hashdelete (lua_array[i]);
-   }
-  lua_narray = j;
- }
-}
-
-/*
-** Allocate a new string at string table. The given string is already 
-** allocated with mark space and the function puts it at the end of the
-** table, checking overflow, and returns its own pointer, or NULL on error.
-*/
-char *lua_createstring (char *s)
-{
- if (s == NULL) return NULL;
- 
- if (lua_nstring >= MAXSTRING-1)
- {
-  lua_pack ();
-  if (lua_nstring >= MAXSTRING-1)
-  {
-   lua_error ("string table overflow");
-   return NULL;
-  }
- } 
- lua_string[lua_nstring++] = s;
- return s;
-}
-
-/*
-** Allocate a new array, already created, at array table. The function puts 
-** it at the end of the table, checking overflow, and returns its own pointer,
-** or NULL on error.
-*/
-void *lua_createarray (void *a)
-{
- if (a == NULL) return NULL;
- 
- if (lua_narray >= MAXARRAY-1)
- {
-  lua_pack ();
-  if (lua_narray >= MAXARRAY-1)
-  {
-   lua_error ("indexed table overflow");
-   return NULL;
-  }
- } 
- lua_array[lua_narray++] = a;
- return a;
-}
-
-
-/*
-** Add a file name at file table, checking overflow. This function also set
-** the external variable "lua_filename" with the function filename set.
-** Return 0 on success or 1 on error.
-*/
-int lua_addfile (char *fn)
-{
- if (lua_nfile >= MAXFILE-1)
- {
-  lua_error ("too many files");
-  return 1;
- }
- if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
- {
-  lua_error ("not enough memory");
-  return 1;
- }
  return 0;
 }
 
 /*
-** Return the last file name set.
+* returns 0 if the object is going to be (garbage) collected
 */
-char *lua_filename (void)
+int luaI_ismarked (TObject *o)
 {
- return lua_file[lua_nfile-1];
+  switch (o->ttype)
+  {
+   case LUA_T_STRING:
+     return o->value.ts->marked;
+   case LUA_T_FUNCTION:
+    return o->value.tf->marked;
+   case LUA_T_ARRAY:
+    return o->value.a->mark;
+   default:  /* nil, number, cfunction, or user data */
+    return 1;
+  }
 }
 
+
+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)
+{
+  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 */
+  luaI_hashcallIM();
+  luaI_strcallIM();
+  call_nilIM();
+  luaI_invalidaterefs();
+  recovered += lua_strcollector();
+  recovered += lua_hashcollector();
+  recovered += luaI_funccollector();
+  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;
+} 
+
+
 /*
 ** Internal function: return next global variable
 */
-void lua_nextvar (void)
+void luaI_nextvar (void)
 {
- int index;
+  Word next;
- Object *o = lua_getparam (1);
+  if (lua_isnil(lua_getparam(1)))
- if (o == NULL)
+    next = 0;
- { lua_error ("too few arguments to function `nextvar'"); return; }
+  else 
- if (lua_getparam (2) != NULL)
+    next = luaI_findsymbolbyname(luaL_check_string(1)) + 1;
- { lua_error ("too many arguments to function `nextvar'"); return; }
+  while (next < lua_ntable && s_ttype(next) == LUA_T_NIL)
- if (tag(o) == T_NIL)
+    next++;
- {
+  if (next < lua_ntable) {
-  index = 0;
+    lua_pushstring(lua_table[next].varname->str);
- }
+    luaI_pushobject(&s_object(next));
- else if (tag(o) != T_STRING) 
- { 
-  lua_error ("incorrect argument to function `nextvar'"); 
-  return;
- }
- else
- {
-  for (index=0; index<lua_ntable; index++)
-   if (streq(s_name(index),svalue(o))) break;
-  if (index == lua_ntable) 
-  {
-   lua_error ("name not found in function `nextvar'");
-   return;
   }
-  index++;
-  while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
-  
-  if (index == lua_ntable-1)
-  {
-   lua_pushnil();
-   lua_pushnil();
-   return;
-  }
- }
- {
-  Object name;
-  tag(&name) = T_STRING;
-  svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
-  if (lua_pushobject (&name)) return;
-  if (lua_pushobject (&s_object(index))) return;
- }
 }
+
+
+static TObject *functofind;
+static int checkfunc (TObject *o)
+{
+  if (o->ttype == LUA_T_FUNCTION)
+    return
+       ((functofind->ttype == LUA_T_FUNCTION || functofind->ttype == LUA_T_MARK)
+            && (functofind->value.tf == o->value.tf));
+  if (o->ttype == LUA_T_CFUNCTION)
+    return
+       ((functofind->ttype == LUA_T_CFUNCTION ||
+         functofind->ttype == LUA_T_CMARK) &&
+         (functofind->value.f == o->value.f));
+  return 0;
+}
+
+
+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";
+  else if ((*name = lua_travsymbol(checkfunc)) != NULL)
+    return "global";
+  else return "";
+}
+

table.h

@@ -1,39 +1,40 @@
 /*
-** table.c
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** 11 May 93
+** $Id: table.h,v 2.23 1997/03/31 14:02:58 roberto Exp roberto $
 */
 
 #ifndef table_h
 #define table_h
 
+#include "tree.h"
+#include "opcode.h"
+
+typedef struct
+{
+ TObject  object;
+ TaggedString *varname;
+} Symbol;
+
+
 extern Symbol *lua_table;
-extern Word    lua_ntable;
+extern Word lua_ntable;
+extern TaggedString **lua_constant;
+extern Word lua_nconstant;
 
-extern char  **lua_constant;
+void luaI_initsymbol (void);
-extern Word    lua_nconstant;
+void  luaI_initconstant (void);
+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      (TObject *o);
+int luaI_ismarked (TObject *o);
+Long luaI_collectgarbage (void);
+void  lua_pack            (void);
 
-extern char  **lua_string;
-extern Word    lua_nstring;
-
-extern Hash  **lua_array;
-extern Word    lua_narray;
-
-extern char   *lua_file[];
-extern int     lua_nfile;
-
-#define lua_markstring(s)	(*((s)-1))
-
-
-int   lua_findsymbol           (char *s);
-int   lua_findenclosedconstant (char *s);
-int   lua_findconstant         (char *s);
-void  lua_markobject           (Object *o);
-char *lua_createstring         (char *s);
-void *lua_createarray          (void *a);
-int   lua_addfile              (char *fn);
-char *lua_filename             (void);
-void  lua_nextvar              (void);
 
 #endif

tree.c

@@ -0,0 +1,174 @@
+/*
+** tree.c
+** TecCGraf - PUC-Rio
+*/
+ 
+char *rcs_tree="$Id: tree.c,v 1.23 1997/03/31 14:02:58 roberto Exp roberto $";
+
+
+#include <string.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
+
+typedef struct {
+  int size;
+  int nuse;  /* number of elements (including EMPTYs) */
+  TaggedString **hash;
+} stringtable;
+
+static int initialized = 0;
+
+static stringtable string_root[NUM_HASHS];
+
+static TaggedString EMPTY = {LUA_T_STRING, 0, NOT_USED, NOT_USED, 0, 2, {0}};
+
+
+static unsigned long hash (char *buff, long size)
+{
+  unsigned long h = 0;
+  while (size--)
+    h = ((h<<5)-h)^(unsigned char)*(buff++);
+  return h;
+}
+
+static void initialize (void)
+{
+  initialized = 1;
+  luaI_addReserved();
+  luaI_initsymbol();
+  luaI_initconstant();
+  luaI_initfallbacks();
+}
+
+
+static void grow (stringtable *tb)
+{
+  int newsize = luaI_redimension(tb->size);
+  TaggedString **newhash = newvector(newsize, TaggedString *);
+  int i;
+  for (i=0; i<newsize; i++)
+    newhash[i] = NULL;
+  /* rehash */
+  tb->nuse = 0;
+  for (i=0; i<tb->size; i++)
+    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
+    {
+      int h = tb->hash[i]->hash%newsize;
+      while (newhash[h])
+        h = (h+1)%newsize;
+      newhash[h] = tb->hash[i];
+      tb->nuse++;
+    }
+  luaI_free(tb->hash); 
+  tb->size = newsize;
+  tb->hash = newhash;
+}
+
+static TaggedString *insert (char *buff, long size, int tag, stringtable *tb)
+{
+  TaggedString *ts;
+  unsigned long h = hash(buff, size);
+  int i;
+  int j = -1;
+  if ((Long)tb->nuse*3 >= (Long)tb->size*2)
+  {
+    if (!initialized)
+      initialize();
+    grow(tb);
+  }
+  i = h%tb->size;
+  while ((ts = tb->hash[i]) != NULL)
+  {
+    if (ts == &EMPTY)
+      j = i;
+    else if (ts->size == size && ts->tag == tag &&
+             memcmp(buff, ts->str, size) == 0)
+      return ts;
+    i = (i+1)%tb->size;
+  }
+  /* not found */
+  lua_pack();
+  if (j != -1)  /* is there an EMPTY space? */
+    i = j;
+  else
+    tb->nuse++;
+  ts = tb->hash[i] = (TaggedString *)luaI_malloc(sizeof(TaggedString)+size-1);
+  memcpy(ts->str, buff, size);
+  ts->tag = tag;
+  ts->size = size;
+  ts->marked = 0;
+  ts->hash = h;
+  ts->varindex = ts->constindex = NOT_USED;
+  return ts;
+}
+
+TaggedString *luaI_createuserdata (char *buff, long size, int tag)
+{
+  return insert(buff, size, tag, &string_root[(unsigned)buff[0]%NUM_HASHS]);
+}
+
+TaggedString *lua_createstring (char *str)
+{
+  return luaI_createuserdata(str, strlen(str)+1, LUA_T_STRING);
+}
+
+
+void luaI_strcallIM (void)
+{
+  int i;
+  TObject o;
+  ttype(&o) = LUA_T_USERDATA;
+  for (i=0; i<NUM_HASHS; i++) {
+    stringtable *tb = &string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++) {
+      TaggedString *t = tb->hash[j];
+      if (t != NULL && t->tag != LUA_T_STRING && t->marked == 0) {
+        tsvalue(&o) = t;
+        luaI_gcIM(&o);
+      }
+    }
+  }
+}
+
+
+/*
+** Garbage collection function.
+** This function traverse the string list freeing unindexed strings
+*/
+Long lua_strcollector (void)
+{
+  Long counter = 0;
+  int i;
+  for (i=0; i<NUM_HASHS; i++)
+  {
+    stringtable *tb = &string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++)
+    {
+      TaggedString *t = tb->hash[j];
+      if (t != NULL && t->marked <= 1)
+      {
+        if (t->marked)
+          t->marked = 0;
+        else
+        {
+          luaI_free(t);
+          tb->hash[j] = &EMPTY;
+          counter++;
+        }
+      }
+    }
+  }
+  return counter;
+}
+

tree.h

@@ -0,0 +1,32 @@
+/*
+** tree.h
+** TecCGraf - PUC-Rio
+** $Id: tree.h,v 1.15 1997/02/11 11:35:05 roberto Exp roberto $
+*/
+
+#ifndef tree_h
+#define tree_h
+
+#include "types.h"
+
+#define NOT_USED  0xFFFE
+
+
+typedef struct TaggedString
+{
+  int tag;  /* if != LUA_T_STRING, this is a userdata */
+  long size;
+  Word varindex;  /* != NOT_USED  if this is a symbol */
+  Word constindex;  /* != NOT_USED  if this is a constant */
+  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; MAY BE NOT 0 TERMINATED!! */
+} TaggedString;
+ 
+
+TaggedString *lua_createstring (char *str);
+TaggedString *luaI_createuserdata (char *buff, long size, int tag);
+Long lua_strcollector (void);
+void luaI_strcallIM (void);
+
+#endif

types.h

@@ -0,0 +1,29 @@
+/*
+** TeCGraf - PUC-Rio
+** $Id: types.h,v 1.3 1995/02/06 19:32:43 roberto Exp roberto $
+*/
+
+#ifndef types_h
+#define types_h
+
+#include <limits.h>
+
+#ifndef real
+#define real float
+#endif
+
+#define Byte lua_Byte	/* some systems have Byte as a predefined type */
+typedef unsigned char  Byte;  /* unsigned 8 bits */
+
+#define Word lua_Word	/* some systems have Word as a predefined type */
+typedef unsigned short Word;  /* unsigned 16 bits */
+
+#define MAX_WORD  (USHRT_MAX-2)  /* maximum value of a word (-2 for safety) */
+#define MAX_INT   (INT_MAX-2)  /* maximum value of a int (-2 for safety) */
+
+#define Long lua_Long	/* some systems have Long as a predefined type */
+typedef signed long  Long;  /* 32 bits */
+
+typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
+
+#endif

undump.c

@@ -0,0 +1,333 @@
+/*
+** undump.c
+** load bytecodes from files
+*/
+
+char* rcs_undump="$Id: undump.c,v 1.21 1996/11/18 11:18:29 lhf Exp lhf $";
+
+#include <stdio.h>
+#include <string.h>
+#include "auxlib.h"
+#include "opcode.h"
+#include "luamem.h"
+#include "table.h"
+#include "undump.h"
+
+static int swapword=0;
+static int swapfloat=0;
+static TFunc* Main=NULL;			/* functions in a chunk */
+static TFunc* lastF=NULL;
+
+static void FixCode(Byte* code, Byte* end)	/* swap words */
+{
+ Byte* p;
+ for (p=code; p!=end;)
+ {
+	int op=*p;
+	switch (op)
+	{
+	case PUSHNIL:
+	case PUSH0:
+	case PUSH1:
+	case PUSH2:
+	case PUSHLOCAL0:
+	case PUSHLOCAL1:
+	case PUSHLOCAL2:
+	case PUSHLOCAL3:
+	case PUSHLOCAL4:
+	case PUSHLOCAL5:
+	case PUSHLOCAL6:
+	case PUSHLOCAL7:
+	case PUSHLOCAL8:
+	case PUSHLOCAL9:
+	case PUSHINDEXED:
+	case STORELOCAL0:
+	case STORELOCAL1:
+	case STORELOCAL2:
+	case STORELOCAL3:
+	case STORELOCAL4:
+	case STORELOCAL5:
+	case STORELOCAL6:
+	case STORELOCAL7:
+	case STORELOCAL8:
+	case STORELOCAL9:
+	case STOREINDEXED0:
+	case ADJUST0:
+	case EQOP:
+	case LTOP:
+	case LEOP:
+	case GTOP:
+	case GEOP:
+	case ADDOP:
+	case SUBOP:
+	case MULTOP:
+	case DIVOP:
+	case POWOP:
+	case CONCOP:
+	case MINUSOP:
+	case NOTOP:
+	case POP:
+	case RETCODE0:
+		p++;
+		break;
+	case PUSHBYTE:
+	case PUSHLOCAL:
+	case STORELOCAL:
+	case STOREINDEXED:
+	case STORELIST0:
+	case ADJUST:
+	case RETCODE:
+	case VARARGS:
+	case STOREMAP:
+		p+=2;
+		break;
+	case STORELIST:
+	case CALLFUNC:
+		p+=3;
+		break;
+	case PUSHFUNCTION:
+		p+=5;			/* TODO: use sizeof(TFunc*) or old? */
+		break;
+	case PUSHWORD:
+	case PUSHSELF:
+	case CREATEARRAY:
+	case ONTJMP:
+	case ONFJMP:
+	case JMP:
+	case UPJMP:
+	case IFFJMP:
+	case IFFUPJMP:
+	case SETLINE:
+	case PUSHSTRING:
+	case PUSHGLOBAL:
+	case STOREGLOBAL:
+	{
+		Byte t;
+		t=p[1]; p[1]=p[2]; p[2]=t;
+		p+=3;
+		break;
+	}
+	case PUSHFLOAT:			/* assumes sizeof(float)==4 */
+	{
+		Byte t;
+		t=p[1]; p[1]=p[4]; p[4]=t;
+		t=p[2]; p[2]=p[3]; p[3]=t;
+		p+=5;
+		break;
+	}
+	case STORERECORD:
+	{
+		int n=*++p;
+		p++;
+		while (n--)
+		{
+			Byte t;
+			t=p[0]; p[0]=p[1]; p[1]=t;
+			p+=2;
+		}
+		break;
+	}
+	default:
+		luaL_verror("corrupt binary file: bad opcode %d at %d\n",
+			op,(int)(p-code));
+		break;
+	}
+ }
+}
+
+static void Unthread(Byte* code, int i, int v)
+{
+ while (i!=0)
+ {
+  Word w;
+  Byte* p=code+i;
+  memcpy(&w,p,sizeof(w));
+  i=w; w=v;
+  memcpy(p,&w,sizeof(w));
+ }
+}
+
+static int LoadWord(FILE* D)
+{
+ Word w;
+ fread(&w,sizeof(w),1,D);
+ if (swapword)
+ {
+  Byte* p=(Byte*)&w;
+  Byte t;
+  t=p[0]; p[0]=p[1]; p[1]=t;
+ }
+ return w;
+}
+
+static int LoadSize(FILE* D)
+{
+ Word hi=LoadWord(D);
+ Word lo=LoadWord(D);
+ int s=(hi<<16)|lo;
+ if ((Word)s != s) lua_error("code too long");
+ return s;
+}
+
+static void* LoadBlock(int size, FILE* D)
+{
+ void* b=luaI_malloc(size);
+ fread(b,size,1,D);
+ return b;
+}
+
+static char* LoadString(FILE* D)
+{
+ int size=LoadWord(D);
+ char *b=luaI_buffer(size);
+ fread(b,size,1,D);
+ return b;
+}
+
+static char* LoadNewString(FILE* D)
+{
+ return LoadBlock(LoadWord(D),D);
+}
+
+static void LoadFunction(FILE* D)
+{
+ TFunc* tf=new(TFunc);
+ tf->next=NULL;
+ tf->locvars=NULL;
+ tf->size=LoadSize(D);
+ tf->lineDefined=LoadWord(D);
+ if (IsMain(tf))				/* new main */
+ {
+  tf->fileName=LoadNewString(D);
+  Main=lastF=tf;
+ }
+ else						/* fix PUSHFUNCTION */
+ {
+  tf->marked=LoadWord(D);
+  tf->fileName=Main->fileName;
+  memcpy(Main->code+tf->marked,&tf,sizeof(tf));
+  lastF=lastF->next=tf;
+ }
+ tf->code=LoadBlock(tf->size,D);
+ if (swapword || swapfloat) FixCode(tf->code,tf->code+tf->size);
+ while (1)					/* unthread */
+ {
+  int c=getc(D);
+  if (c==ID_VAR)				/* global var */
+  {
+   int i=LoadWord(D);
+   char* s=LoadString(D);
+   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 v=luaI_findconstantbyname(s);
+   Unthread(tf->code,i,v);
+  }
+  else
+  {
+   ungetc(c,D);
+   break;
+  }
+ }
+}
+
+static void LoadSignature(FILE* D)
+{
+ char* s=SIGNATURE;
+ while (*s!=0 && getc(D)==*s)
+  ++s;
+ if (*s!=0) lua_error("cannot load binary file: bad signature");
+}
+
+static void LoadHeader(FILE* D)
+{
+ Word w,tw=TEST_WORD;
+ float f,tf=TEST_FLOAT;
+ int version;
+ LoadSignature(D);
+ version=getc(D);
+ if (version>0x23)				/* after 2.5 */
+ {
+  int oldsizeofW=getc(D);
+  int oldsizeofF=getc(D);
+  int oldsizeofP=getc(D);
+  if (oldsizeofW!=2)
+   luaL_verror(
+	"cannot load binary file created on machine with sizeof(Word)=%d; "
+	"expected 2",oldsizeofW);
+  if (oldsizeofF!=4)
+   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,sizeof(TFunc*));
+ }
+ fread(&w,sizeof(w),1,D);			/* test word */
+ if (w!=tw)
+ {
+  swapword=1;
+ }
+ fread(&f,sizeof(f),1,D);			/* test float */
+ if (f!=tf)
+ {
+  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("cannot load binary file: unknown float representation");
+ }
+}
+
+static void LoadChunk(FILE* D)
+{
+ LoadHeader(D);
+ while (1)
+ {
+  int c=getc(D);
+  if (c==ID_FUN) LoadFunction(D); else { ungetc(c,D); break; }
+ }
+}
+
+/*
+** load one chunk from a file.
+** return list of functions found, headed by main, or NULL at EOF.
+*/
+TFunc* luaI_undump1(FILE* D)
+{
+ while (1)
+ {
+  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");
+ }
+}
+
+/*
+** load and run all chunks in a file
+*/
+int luaI_undump(FILE* D)
+{
+ TFunc* m;
+ while ((m=luaI_undump1(D)))
+ {
+  int status=luaI_dorun(m);
+  luaI_freefunc(m);
+  if (status!=0) return status;
+ }
+ return 0;
+}

undump.h

@@ -0,0 +1,23 @@
+/*
+** undump.h
+** definitions for lua decompiler
+** $Id: undump.h,v 1.3 1996/11/14 11:44:34 lhf Exp lhf $
+*/
+
+#include "func.h"
+
+#define IsMain(f)	(f->lineDefined==0)
+
+/* definitions for chunk headers */
+
+#define ID_CHUNK	27		/* ESC */
+#define ID_FUN		'F'
+#define ID_VAR		'V'
+#define ID_STR		'S'
+#define	SIGNATURE	"Lua"
+#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 */

y_tab.h

@@ -1,35 +0,0 @@
-
-typedef union  
-{
- int   vInt;
- long  vLong;
- float vFloat;
- Word  vWord;
- Byte *pByte;
-} YYSTYPE;
-extern YYSTYPE yylval;
-# define NIL 257
-# define IF 258
-# define THEN 259
-# define ELSE 260
-# define ELSEIF 261
-# define WHILE 262
-# define DO 263
-# define REPEAT 264
-# define UNTIL 265
-# define END 266
-# define RETURN 267
-# define LOCAL 268
-# define NUMBER 269
-# define FUNCTION 270
-# define NAME 271
-# define STRING 272
-# define DEBUG 273
-# define NOT 274
-# define AND 275
-# define OR 276
-# define NE 277
-# define LE 278
-# define GE 279
-# define CONC 280
-# define UNARY 281