new version

new "balanced" pattern.

fallback.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.10 1994/12/20 21:20:36 roberto Exp $";
+char *rcs_fallback="$Id: fallback.c,v 1.24 1996/04/22 18:00:37 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -11,8 +11,8 @@ char *rcs_fallback="$Id: fallback.c,v 1.10 1994/12/20 21:20:36 roberto Exp $";
 #include "mem.h"
 #include "fallback.h"
 #include "opcode.h"
-#include "inout.h"
 #include "lua.h"
+#include "table.h"
 
 
 static void errorFB (void);
@@ -29,15 +29,18 @@ static void funcFB (void);
 ** Warning: This list must be in the same order as the #define's
 */
 struct FB  luaI_fallBacks[] = {
-{"error", {LUA_T_CFUNCTION, errorFB}},
-{"index", {LUA_T_CFUNCTION, indexFB}},
-{"gettable", {LUA_T_CFUNCTION, gettableFB}},
-{"arith", {LUA_T_CFUNCTION, arithFB}},
-{"order", {LUA_T_CFUNCTION, orderFB}},
-{"concat", {LUA_T_CFUNCTION, concatFB}},
-{"settable", {LUA_T_CFUNCTION, gettableFB}},
-{"gc", {LUA_T_CFUNCTION, GDFB}},
-{"function", {LUA_T_CFUNCTION, funcFB}}
+{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0},
+{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
+{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
+{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
+{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
+{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
+{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
+{"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
+{"function", {LUA_T_CFUNCTION, {funcFB}}, -1, -1},
+                                /* no fixed number of params or results */
+{"getglobal", {LUA_T_CFUNCTION, {indexFB}}, 1, 1}
+                                /* same default behavior of index FB */
 };
 
 #define N_FB  (sizeof(luaI_fallBacks)/sizeof(struct FB))
@@ -47,11 +50,8 @@ void luaI_setfallback (void)
   int i;
   char *name = lua_getstring(lua_getparam(1));
   lua_Object func = lua_getparam(2);
-  if (name == NULL || !(lua_isfunction(func) || lua_iscfunction(func)))
-  {
-    lua_pushnil();
-    return;
-  }
+  if (name == NULL || !lua_isfunction(func))
+    lua_error("incorrect argument to function `setfallback'");
   for (i=0; i<N_FB; i++)
   {
     if (strcmp(luaI_fallBacks[i].kind, name) == 0)
@@ -62,7 +62,7 @@ void luaI_setfallback (void)
     }
   }
   /* name not found */
-  lua_pushnil();
+  lua_error("incorrect argument to function `setfallback'");
 }
 
 
@@ -84,88 +84,108 @@ static void indexFB (void)
 
 static void gettableFB (void)
 {
-  lua_reportbug("indexed expression not a table");
+  lua_error("indexed expression not a table");
 }
  
 
 static void arithFB (void)
 {
-  lua_reportbug("unexpected type at conversion to number");
+  lua_error("unexpected type at conversion to number");
 }
 
 static void concatFB (void)
 {
-  lua_reportbug("unexpected type at conversion to string");
+  lua_error("unexpected type at conversion to string");
 }
 
 
 static void orderFB (void)
 {
-  lua_reportbug("unexpected type at comparison");
+  lua_error("unexpected type at comparison");
 }
 
 static void GDFB (void) { }
 
 static void funcFB (void)
 {
-  lua_reportbug("call expression not a function");
+  lua_error("call expression not a function");
 }
 
 
 /*
-** Lock routines
+** Reference routines
 */
 
-static Object *lockArray = NULL;
-static Word lockSize = 0;
+static struct ref {
+  Object o;
+  enum {LOCK, HOLD, FREE, COLLECTED} status;
+} *refArray = NULL;
+static int refSize = 0;
 
-int luaI_lock (Object *object)
+int luaI_ref (Object *object, int lock)
 {
-  Word i;
-  Word oldSize;
+  int i;
+  int oldSize;
   if (tag(object) == LUA_T_NIL)
-    return -1;
-  for (i=0; i<lockSize; i++)
-    if (tag(&lockArray[i]) == LUA_T_NIL)
-    {
-      lockArray[i] = *object;
-      return i;
-    }
+    return -1;   /* special ref for nil */
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == FREE)
+      goto found;
   /* no more empty spaces */
-  oldSize = lockSize;
-  if (lockArray == NULL)
-  {
-    lockSize = 10;
-    lockArray = newvector(lockSize, Object);
-  }
+  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;
+}
+
+
+Object *luaI_getref (int ref)
+{
+  static Object 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
-  {
-    lockSize = 3*oldSize/2 + 5;
-    lockArray = growvector(lockArray, lockSize, Object);
-  }
-  for (i=oldSize; i<lockSize; i++)
-    tag(&lockArray[i]) = LUA_T_NIL;
-  lockArray[oldSize] = *object;
-  return oldSize;
+    return NULL;
 }
 
 
-void lua_unlock (int ref)
+void luaI_travlock (int (*fn)(Object *))
 {
-  tag(&lockArray[ref]) = LUA_T_NIL;
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == LOCK)
+      fn(&refArray[i].o);
 }
 
 
-Object *luaI_getlocked (int ref)
+void luaI_invalidaterefs (void)
 {
-  return &lockArray[ref];
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == HOLD && !luaI_ismarked(&refArray[i].o))
+      refArray[i].status = COLLECTED;
 }
 
-
-void luaI_travlock (void (*fn)(Object *))
+char *luaI_travfallbacks (int (*fn)(Object *))
 {
-  Word i;
-  for (i=0; i<lockSize; i++)
-    fn(&lockArray[i]);
+  int i;
+  for (i=0; i<N_FB; i++)
+    if (fn(&luaI_fallBacks[i].function))
+      return luaI_fallBacks[i].kind;
+  return NULL;
 }
-

fallback.h

@@ -1,15 +1,18 @@
 /*
-** $Id: fallback.h,v 1.6 1994/11/21 13:30:15 roberto Exp roberto $
+** $Id: fallback.h,v 1.12 1996/04/22 18:00:37 roberto Exp roberto $
 */
  
 #ifndef fallback_h
 #define fallback_h
 
+#include "lua.h"
 #include "opcode.h"
 
 extern struct FB {
   char *kind;
   Object function;
+  int nParams;
+  int nResults;
 } luaI_fallBacks[];
 
 #define FB_ERROR  0
@@ -21,11 +24,14 @@ extern struct FB {
 #define FB_SETTABLE  6
 #define FB_GC 7
 #define FB_FUNCTION 8
+#define FB_GETGLOBAL 9
 
 void luaI_setfallback (void);
-int luaI_lock (Object *object);
-Object *luaI_getlocked (int ref);
-void luaI_travlock (void (*fn)(Object *));
+int luaI_ref (Object *object, int lock);
+Object *luaI_getref (int ref);
+void luaI_travlock (int (*fn)(Object *));
+void luaI_invalidaterefs (void);
+char *luaI_travfallbacks (int (*fn)(Object *));
 
 #endif
 

func.c

@@ -0,0 +1,156 @@
+#include <string.h>
+
+#include "luadebug.h"
+#include "table.h"
+#include "mem.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)
+{
+  Object *f = luaI_Address(func);
+  if (f->tag == LUA_T_MARK || f->tag == LUA_T_FUNCTION)
+  {
+    *filename = f->value.tf->fileName;
+    *linedefined = f->value.tf->lineDefined;
+  }
+  else if (f->tag == LUA_T_CMARK || f->tag == LUA_T_CFUNCTION)
+  {
+    *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

@@ -3,18 +3,15 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.23 1995/01/12 14:19:04 roberto Exp $";
+char *rcs_hash="$Id: hash.c,v 2.31 1996/07/12 20:00:26 roberto Exp roberto $";
 
-#include <string.h>
 
 #include "mem.h"
 #include "opcode.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
 #include "lua.h"
 
-#define streq(s1,s2)	(s1 == s2 || (*(s1) == *(s2) && strcmp(s1,s2)==0))
 
 #define nhash(t)	((t)->nhash)
 #define nuse(t)		((t)->nuse)
@@ -25,22 +22,22 @@ char *rcs_hash="$Id: hash.c,v 2.23 1995/01/12 14:19:04 roberto Exp $";
 #define val(n)		(&(n)->val)
 
 
-#define REHASH_LIMIT	0.70	/* avoid more than this % full */
+#define REHASH_LIMIT    0.70    /* avoid more than this % full */
 
 
 static Hash *listhead = NULL;
 
 
-
 /* hash dimensions values */
-static Word dimensions[] = 
- {3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
-  12853, 25717, 51437, 65521, 0};  /* 65521 == last prime < MAX_WORD */
+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};
 
-static Word redimension (Word nhash)
+int luaI_redimension (int nhash)
 {
- Word i;
- for (i=0; dimensions[i]!=0; i++)
+ int i;
+ for (i=0; dimensions[i]<MAX_INT; i++)
  {
   if (dimensions[i] > nhash)
    return dimensions[i];
@@ -49,56 +46,48 @@ static Word redimension (Word nhash)
  return 0;  /* to avoid warnings */
 }
 
-static Word hashindex (Hash *t, Object *ref)		/* hash function */
+static int hashindex (Hash *t, Object *ref)		/* hash function */
 {
- switch (tag(ref))
- {
-  case LUA_T_NIL:
-   lua_reportbug ("unexpected type to index table");
-   return -1;  /* UNREACHEABLE */
-  case LUA_T_NUMBER:
-   return (((Word)nvalue(ref))%nhash(t));
-  case LUA_T_STRING:
-  {
-   unsigned long h = tsvalue(ref)->hash;
-   if (h == 0)
-   {
-     char *name = svalue(ref);
-     while (*name)
-       h = ((h<<5)-h)^(unsigned char)*(name++);
-     tsvalue(ref)->hash = h;
-   }
-   return (Word)h%nhash(t);  /* make it a valid index */
+  long int h;
+  switch (tag(ref)) {
+    case LUA_T_NIL:
+      lua_error ("unexpected type to index table");
+      h = 0;  /* UNREACHEABLE */
+    case LUA_T_NUMBER:
+      h = (long int)nvalue(ref); break;
+    case LUA_T_STRING:
+      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:  /* user data */
+      h = (IntPoint)uvalue(ref); break;
   }
-  case LUA_T_FUNCTION:
-   return (((IntPoint)bvalue(ref))%nhash(t));
-  case LUA_T_CFUNCTION:
-   return (((IntPoint)fvalue(ref))%nhash(t));
-  case LUA_T_ARRAY:
-   return (((IntPoint)avalue(ref))%nhash(t));
-  default:  /* user data */
-   return (((IntPoint)uvalue(ref))%nhash(t));
- }
+  if (h < 0) h = -h;
+  return h%nhash(t);  /* make it a valid index */
 }
 
-Bool lua_equalObj (Object *t1, Object *t2)
+int lua_equalObj (Object *t1, Object *t2)
 {
   if (tag(t1) != tag(t2)) return 0;
   switch (tag(t1))
   {
     case LUA_T_NIL: return 1;
     case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
-    case LUA_T_STRING: return streq(svalue(t1), svalue(t2));
+    case LUA_T_STRING: return svalue(t1) == svalue(t2);
     case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
-    case LUA_T_FUNCTION: return bvalue(t1) == bvalue(t2);
+    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
     case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
     default: return uvalue(t1) == uvalue(t2);
   }
 }
 
-static Word present (Hash *t, Object *ref)
+static int present (Hash *t, Object *ref)
 { 
- Word h = hashindex(t, ref);
+ int h = hashindex(t, ref);
  while (tag(ref(node(t, h))) != LUA_T_NIL)
  {
   if (lua_equalObj(ref, ref(node(t, h))))
@@ -112,9 +101,9 @@ static Word present (Hash *t, Object *ref)
 /*
 ** Alloc a vector node 
 */
-static Node *hashnodecreate (Word nhash)
+static Node *hashnodecreate (int nhash)
 {
- Word i;
+ int i;
  Node *v = newvector (nhash, Node);
  for (i=0; i<nhash; i++)
    tag(ref(&v[i])) = LUA_T_NIL;
@@ -124,10 +113,10 @@ static Node *hashnodecreate (Word nhash)
 /*
 ** Create a new hash. Return the hash pointer or NULL on error.
 */
-static Hash *hashcreate (Word nhash)
+static Hash *hashcreate (int nhash)
 {
  Hash *t = new(Hash);
- nhash = redimension((Word)((float)nhash/REHASH_LIMIT));
+ nhash = luaI_redimension((int)((float)nhash/REHASH_LIMIT));
  nodevector(t) = hashnodecreate(nhash);
  nhash(t) = nhash;
  nuse(t) = 0;
@@ -152,7 +141,7 @@ void lua_hashmark (Hash *h)
 {
  if (markarray(h) == 0)
  {
-  Word i;
+  int i;
   markarray(h) = 1;
   for (i=0; i<nhash(h); i++)
   {
@@ -219,7 +208,7 @@ Long lua_hashcollector (void)
 ** executes garbage collection if the number of arrays created
 ** exceed a pre-defined range.
 */
-Hash *lua_createarray (Word nhash)
+Hash *lua_createarray (int nhash)
 {
  Hash *array;
  lua_pack();
@@ -235,10 +224,10 @@ Hash *lua_createarray (Word nhash)
 */
 static void rehash (Hash *t)
 {
- Word i;
- Word   nold = nhash(t);
+ int i;
+ int   nold = nhash(t);
  Node *vold = nodevector(t);
- nhash(t) = redimension(nhash(t));
+ nhash(t) = luaI_redimension(nhash(t));
  nodevector(t) = hashnodecreate(nhash(t));
  for (i=0; i<nold; i++)
  {
@@ -255,7 +244,7 @@ static void rehash (Hash *t)
 */
 Object *lua_hashget (Hash *t, Object *ref)
 {
- Word h = present(t, ref);
+ int h = present(t, ref);
  if (tag(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
  else return NULL;
 }
@@ -267,7 +256,7 @@ Object *lua_hashget (Hash *t, Object *ref)
 */
 Object *lua_hashdefine (Hash *t, Object *ref)
 {
- Word   h;
+ int   h;
  Node *n;
  h = present(t, ref);
  n = node(t, h);
@@ -293,20 +282,14 @@ Object *lua_hashdefine (Hash *t, Object *ref)
 ** in the hash.
 ** This function pushs the element value and its reference to the stack.
 */
-static void hashnext (Hash *t, Word i)
+static void hashnext (Hash *t, int i)
 {
  if (i >= nhash(t))
- {
-  lua_pushnil(); lua_pushnil();
   return;
- }
  while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
  {
   if (++i >= nhash(t))
-  {
-   lua_pushnil(); lua_pushnil();
    return;
-  }
  }
  luaI_pushobject(ref(node(t,i)));
  luaI_pushobject(val(node(t,i)));
@@ -330,7 +313,7 @@ void lua_next (void)
  }
  else
  {
-  Word h = present (t, luaI_Address(r));
+  int h = present (t, luaI_Address(r));
   hashnext(t, h+1);
  }
 }

hash.h

@@ -1,14 +1,14 @@
 /*
 ** hash.h
 ** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
-** $Id: hash.h,v 2.7 1994/12/20 21:20:36 roberto Exp roberto $
+** $Id: hash.h,v 2.11 1996/03/08 12:04:04 roberto Exp roberto $
 */
 
 #ifndef hash_h
 #define hash_h
 
 #include "types.h"
+#include "opcode.h"
 
 typedef struct node
 {
@@ -19,15 +19,16 @@ typedef struct node
 typedef struct Hash
 {
  struct Hash   *next;
- char           mark;
- Word          nhash;
- Word           nuse;
  Node          *node;
+ int           nhash;
+ int            nuse;
+ char           mark;
 } Hash;
 
 
-Bool     lua_equalObj (Object *t1, Object *t2);
-Hash    *lua_createarray (Word nhash);
+int      lua_equalObj (Object *t1, Object *t2);
+int      luaI_redimension (int nhash);
+Hash    *lua_createarray (int nhash);
 void     lua_hashmark (Hash *h);
 Long     lua_hashcollector (void);
 Object  *lua_hashget (Hash *t, Object *ref);

inout.c

@@ -5,42 +5,25 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.15 1994/12/16 15:55:04 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.42 1996/09/24 21:46:44 roberto Exp roberto $";
 
 #include <stdio.h>
-#include <stdlib.h>
 #include <string.h>
 
-#include "mem.h"
+#include "lex.h"
 #include "opcode.h"
-#include "hash.h"
 #include "inout.h"
 #include "table.h"
 #include "tree.h"
 #include "lua.h"
+#include "mem.h"
+
 
 /* Exported variables */
 Word lua_linenumber;
-Bool lua_debug;
-Word lua_debugline = 0;
+char *lua_parsedfile;
 
 
-/* Internal variables */
- 
-#ifndef MAXFUNCSTACK
-#define MAXFUNCSTACK 100
-#endif
- 
-typedef struct FuncStackNode {
-  struct FuncStackNode *next;
-  char *file;
-  Word function;
-  Word line;
-} FuncStackNode;
- 
-static FuncStackNode *funcStack = NULL;
-static Word nfuncstack=0;
-
 static FILE *fp;
 static char *st;
 
@@ -49,7 +32,8 @@ static char *st;
 */
 static int fileinput (void)
 {
- return fgetc (fp);
+  int c = fgetc(fp);
+  return (c == EOF) ? 0 : c;
 }
 
 /*
@@ -62,20 +46,22 @@ static int stringinput (void)
 
 /*
 ** Function to open a file to be input unit. 
-** Return 0 on success or error message on error.
+** Return the file.
 */
-char *lua_openfile (char *fn)
+FILE *lua_openfile (char *fn)
 {
- lua_linenumber = 1;
  lua_setinput (fileinput);
- fp = fopen (fn, "r");
- if (fp == NULL)
+ if (fn == NULL)
  {
-   static char buff[32];
-   sprintf(buff, "unable to open file %.10s", fn);
-   return buff;
+   fp = stdin;
+   fn = "(stdin)";
  }
- return lua_addfile (fn);
+ else
+   fp = fopen (fn, "r");
+ if (fp == NULL)
+   return NULL;
+ lua_parsedfile = luaI_createfixedstring(fn)->str;
+ return fp;
 }
 
 /*
@@ -83,9 +69,8 @@ char *lua_openfile (char *fn)
 */
 void lua_closefile (void)
 {
- if (fp != NULL)
+ if (fp != NULL && fp != stdin)
  {
-  lua_delfile();
   fclose (fp);
   fp = NULL;
  }
@@ -94,16 +79,16 @@ void lua_closefile (void)
 /*
 ** Function to open a string to be input unit
 */
-char *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;
- lua_setinput (stringinput);
- st = s;
- {
-  char sn[64];
-  sprintf (sn, "String: %10.10s...", s);
-  return lua_addfile (sn);
- }
+  char buff[SIZE_PREF+25];
+  lua_setinput(stringinput);
+  st = s;
+  strcpy(buff, "(dostring) >> ");
+  strncat(buff, s, SIZE_PREF);
+  if (strlen(s) > SIZE_PREF) strcat(buff, "...");
+  lua_parsedfile = luaI_createfixedstring(buff)->str;
 }
 
 /*
@@ -111,88 +96,38 @@ char *lua_openstring (char *s)
 */
 void lua_closestring (void)
 {
- lua_delfile();
 }
 
 
-/*
-** Called to execute  SETFUNCTION opcode, this function pushs a function into
-** function stack.
-*/
-void lua_pushfunction (char *file, Word function)
+static void check_arg (int cond, char *func)
 {
- FuncStackNode *newNode;
- if (nfuncstack++ >= MAXFUNCSTACK)
- {
-  lua_reportbug("function stack overflow");
- }
- newNode = new(FuncStackNode);
- newNode->function = function;
- newNode->file = file;
- newNode->line= lua_debugline;
- newNode->next = funcStack;
- funcStack = newNode;
-}
-
-/*
-** Called to execute RESET opcode, this function pops a function from 
-** function stack.
-*/
-void lua_popfunction (void)
-{
- FuncStackNode *temp = funcStack;
- if (temp == NULL) return;
- --nfuncstack;
- lua_debugline = temp->line;
- funcStack = temp->next;
- luaI_free(temp);
-}
-
-/*
-** Report bug building a message and sending it to lua_error function.
-*/
-void lua_reportbug (char *s)
-{
- char msg[MAXFUNCSTACK*80];
- strcpy (msg, s);
- if (lua_debugline != 0)
- {
-  if (funcStack)
+  if (!cond)
   {
-   FuncStackNode *func = funcStack;
-   int line = lua_debugline;
-   sprintf (strchr(msg,0), "\n\tactive stack:\n");
-   do
-   {
-     sprintf (strchr(msg,0),
-       "\t-> function \"%s\" at file \"%s\":%u\n", 
-              lua_constant[func->function]->str, func->file, line);
-     line = func->line;
-     func = func->next;
-     lua_popfunction();
-   } while (func);
+    char buff[100];
+    sprintf(buff, "incorrect argument to function `%s'", func);
+    lua_error(buff);
   }
-  else
-  {
-   sprintf (strchr(msg,0),
-         "\n\tin statement begining at line %u of file \"%s\"", 
-         lua_debugline, lua_filename());
-  }
- }
- lua_error (msg);
 }
 
+
+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
 */
 void lua_internaldostring (void)
 {
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
-  lua_pushnumber(1);
- else
-  lua_pushnil();
+  lua_Object obj = lua_getparam (1);
+  if (lua_isstring(obj) && lua_dostring(lua_getstring(obj)) == 0)
+    if (passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 }
 
 /*
@@ -201,33 +136,56 @@ void lua_internaldostring (void)
 void lua_internaldofile (void)
 {
  lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
-  lua_pushnumber(1);
- else
-  lua_pushnil();
+ char *fname = NULL;
+ if (lua_isstring(obj))
+   fname = lua_getstring(obj);
+ else if (obj != LUA_NOOBJECT)
+   lua_error("invalid argument to function `dofile'");
+ /* else fname = NULL */
+ if (lua_dofile(fname) == 0)
+    if (passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
 }
  
-/*
-** Internal function: print object values
-*/
-void lua_print (void)
+
+static char *tostring (lua_Object obj)
 {
- int i=1;
- lua_Object obj;
- while ((obj=lua_getparam (i++)) != LUA_NOOBJECT)
- {
-  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber(obj));
-  else if (lua_isstring(obj))    printf("%s\n",lua_getstring(obj));
-  else if (lua_isfunction(obj))  printf("function: %p\n",bvalue(luaI_Address(obj)));
-  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction(obj)
-);
-  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata(obj));
-  else if (lua_istable(obj))     printf("table: %p\n",avalue(luaI_Address(obj)));
-  else if (lua_isnil(obj))       printf("nil\n");
-  else                           printf("invalid value to print\n");
- }
+  char *buff = luaI_buffer(20);
+  if (lua_isstring(obj))   /* get strings and numbers */
+    return lua_getstring(obj);
+  else switch(lua_type(obj))
+  {
+    case LUA_T_FUNCTION:
+      sprintf(buff, "function: %p", (luaI_Address(obj))->value.tf);
+      break;
+    case LUA_T_CFUNCTION:
+      sprintf(buff, "cfunction: %p", lua_getcfunction(obj));
+      break;
+    case LUA_T_ARRAY:
+      sprintf(buff, "table: %p", avalue(luaI_Address(obj)));
+      break;
+    case LUA_T_NIL:
+      sprintf(buff, "nil");
+      break;
+    default:
+      sprintf(buff, "userdata: %p", lua_getuserdata(obj));
+      break;
+  }
+  return buff;
 }
 
+void luaI_tostring (void)
+{
+  lua_pushstring(tostring(lua_getparam(1)));
+}
+
+void luaI_print (void)
+{
+  int i = 1;
+  lua_Object obj;
+  while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
+    printf("%s\n", tostring(obj));
+}
 
 /*
 ** Internal function: return an object type.
@@ -235,9 +193,11 @@ void lua_print (void)
 void luaI_type (void)
 {
   lua_Object o = lua_getparam(1);
+  int t;
   if (o == LUA_NOOBJECT)
     lua_error("no parameter to function 'type'");
-  switch (lua_type(o))
+  t = lua_type(o);
+  switch (t)
   {
     case LUA_T_NIL :
       lua_pushliteral("nil");
@@ -252,15 +212,14 @@ void luaI_type (void)
       lua_pushliteral("table");
       break;
     case LUA_T_FUNCTION :
-      lua_pushliteral("function");
-      break;
     case LUA_T_CFUNCTION :
-      lua_pushliteral("cfunction");
+      lua_pushliteral("function");
       break;
     default :
       lua_pushliteral("userdata");
       break;
   }
+  lua_pushnumber(t);
 }
  
 /*
@@ -270,18 +229,7 @@ void lua_obj2number (void)
 {
   lua_Object o = lua_getparam(1);
   if (lua_isnumber(o))
-    lua_pushobject(o);
-  else if (lua_isstring(o))
-  {
-    char c;
-    float f;
-    if (sscanf(lua_getstring(o),"%f %c",&f,&c) == 1)
-      lua_pushnumber(f);
-    else
-      lua_pushnil();
-  }
-  else
-    lua_pushnil();
+    lua_pushnumber(lua_getnumber(o));
 }
 
 
@@ -289,6 +237,64 @@ void luaI_error (void)
 {
   char *s = lua_getstring(lua_getparam(1));
   if (s == NULL) s = "(no message)";
-  lua_reportbug(s);
+  lua_error(s);
 }
 
+void luaI_assert (void)
+{
+  lua_Object p = lua_getparam(1);
+  if (p == LUA_NOOBJECT || lua_isnil(p))
+    lua_error("assertion failed!");
+}
+
+void luaI_setglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  lua_Object value = lua_getparam(2);
+  check_arg(lua_isstring(name), "setglobal");
+  lua_pushobject(value);
+  lua_storeglobal(lua_getstring(name));
+  lua_pushobject(value);  /* return given value */
+}
+
+void luaI_getglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  check_arg(lua_isstring(name), "getglobal");
+  lua_pushobject(lua_getglobal(lua_getstring(name)));
+}
+
+#define MAXPARAMS	256
+void luaI_call (void)
+{
+  lua_Object f = lua_getparam(1);
+  lua_Object arg = lua_getparam(2);
+  lua_Object temp, params[MAXPARAMS];
+  int narg, i;
+  check_arg(lua_istable(arg), "call");
+  check_arg(lua_isfunction(f), "call");
+  /* narg = arg.n */
+  lua_pushobject(arg);
+  lua_pushstring("n");
+  temp = lua_getsubscript();
+  narg = lua_isnumber(temp) ? lua_getnumber(temp) : MAXPARAMS+1;
+  /* read arg[1...n] */
+  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();
+}

inout.h

@@ -1,5 +1,5 @@
 /*
-** $Id: inout.h,v 1.6 1994/11/21 21:41:09 roberto Stab roberto $
+** $Id: inout.h,v 1.15 1996/03/15 18:21:58 roberto Exp roberto $
 */
 
 
@@ -7,24 +7,28 @@
 #define inout_h
 
 #include "types.h"
+#include <stdio.h>
+
 
 extern Word lua_linenumber;
-extern Bool lua_debug;
 extern Word lua_debugline;
+extern char *lua_parsedfile;
 
-char *lua_openfile     (char *fn);
+FILE *lua_openfile     (char *fn);
 void lua_closefile    (void);
-char *lua_openstring   (char *s);
+void lua_openstring   (char *s);
 void lua_closestring  (void);
-void lua_pushfunction (char *file, Word function);
-void lua_popfunction  (void);
-void lua_reportbug    (char *s);
 
 void    lua_internaldofile (void);
 void    lua_internaldostring (void);
-void    lua_print      (void);
+void    luaI_tostring   (void);
+void    luaI_print      (void);
 void    luaI_type       (void);
 void    lua_obj2number (void);
 void	luaI_error     (void);
+void    luaI_assert    (void);
+void	luaI_setglobal (void);
+void	luaI_getglobal (void);
+void	luaI_call	(void);
 
 #endif

iolib.c

@@ -1,615 +1,295 @@
-/*
-** iolib.c
-** Input/output library to LUA
-*/
-
-char *rcs_iolib="$Id: iolib.c,v 1.20 1995/02/02 18:54:58 roberto Exp roberto $";
-
 #include <stdio.h>
 #include <ctype.h>
-#include <sys/types.h>
-#include <sys/stat.h>
 #include <string.h>
 #include <time.h>
 #include <stdlib.h>
+#include <errno.h>
 
 #include "lua.h"
+#include "luadebug.h"
 #include "lualib.h"
 
-static FILE *in=stdin, *out=stdout;
 
-/*
-** Open a file to read.
-** LUA interface:
-**			status = readfrom (filename)
-** where:
-**			status = 1 -> success
-**			status = 0 -> error
-*/
+FILE *lua_infile, *lua_outfile;
+
+
+#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("system 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 void io_readfrom (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)			/* restore standart input */
- {
-  if (in != stdin)
-  {
-   fclose (in);
-   in = stdin;
+  lua_Object f = lua_getparam(1);
+  if (f == LUA_NOOBJECT)
+    closefile(lua_infile);  /* restore standart input */
+  else if (lua_isuserdata(f))
+    lua_infile = lua_getuserdata(f);
+  else {
+    char *s = lua_check_string(1, "readfrom");
+    FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
+    if (fp)
+      lua_infile = fp;
+    else {
+      pushresult(0);
+      return;
+    }
   }
-  lua_pushnumber (1);
- }
- 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);
-   }
-  }
- }
+  lua_pushuserdata(lua_infile);
 }
 
 
-/*
-** 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);
- if (o == LUA_NOOBJECT)			/* restore standart output */
- {
-  if (out != stdout)
-  {
-   fclose (out);
-   out = stdout;
+  lua_Object f = lua_getparam(1);
+  if (f == LUA_NOOBJECT)
+    closefile(lua_outfile);  /* restore standart output */
+  else if (lua_isuserdata(f))
+    lua_outfile = lua_getuserdata(f);
+  else {
+    char *s = lua_check_string(1, "writeto");
+    FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
+    if (fp)
+      lua_outfile = fp;
+    else {
+      pushresult(0);
+      return;
+    }
   }
-  lua_pushnumber (1);
- }
- 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);
-   }
-  }
- }
+  lua_pushuserdata(lua_outfile);
 }
 
 
-/*
-** Open a file to write appended.
-** LUA interface:
-**			status = appendto (filename)
-** where:
-**			status = 2 -> success (already exist)
-**			status = 1 -> success (new file)
-**			status = 0 -> error
-*/
 static void io_appendto (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)			/* restore standart output */
- {
-  if (out != stdout)
-  {
-   fclose (out);
-   out = stdout;
-  }
-  lua_pushnumber (1);
- }
- else
- {
-  if (!lua_isstring (o))
-  {
-   lua_error ("incorrect argument to function 'appendto`");
-   lua_pushnumber (0);
+  char *s = lua_check_string(1, "appendto");
+  FILE *fp = fopen (s, "a");
+  if (fp != NULL) {
+    lua_outfile = fp;
+    lua_pushuserdata(lua_outfile);
   }
   else
-  {
-   int r;
-   FILE *fp;
-   struct stat st;
-   if (stat(lua_getstring(o), &st) == -1) r = 1;
-   else                                   r = 2;
-   fp = fopen (lua_getstring(o),"a");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (r);
-   }
-  }
- }
+    pushresult(0);
 }
 
 
+#define NEED_OTHER (EOF-1)  /* just some flag different from EOF */
 
-/*
-** Read a variable. On error put nil on stack.
-** LUA interface:
-**			variable = read ([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 numero que representa
-**	o numero de campos a serem lidos.
-*/
 static void io_read (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT || !lua_isstring(o))	/* free format */
- {
-  int c;
-  char s[256];
-  while (isspace(c=fgetc(in)))
-   ;
-  if (c == '\"')
-  {
-   int n=0;
-   while((c = fgetc(in)) != '\"')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
+  char *buff;
+  char *p = lua_opt_string(1, "[^\n]*{\n}", "read");
+  int inskip = 0;  /* to control {skips} */
+  int c = NEED_OTHER;
+  luaI_addchar(0);
+  while (*p) {
+    if (*p == '{' || *p == '}') {
+      inskip = (*p == '{');
+      p++;
     }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else if (c == '\'')
-  {
-   int n=0;
-   while((c = fgetc(in)) != '\'')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
+    else {
+      char *ep = item_end(p);  /* get what is next */
+      int m;  /* match result */
+      if (c == NEED_OTHER) c = getc(lua_infile);
+      m = (c == EOF) ? 0 : singlematch((char)c, p);
+      if (m) {
+        if (!inskip) luaI_addchar(c);
+        c = NEED_OTHER;
+      }
+      switch (*ep) {
+        case '*':  /* repetition */
+          if (!m) p = ep+1;  /* else stay in (repeat) the same item */
+          break;
+        case '?':  /* optional */
+          p = ep+1;  /* continues reading the pattern */
+          break;
+        default:
+          if (m) p = ep;  /* continues reading the pattern */
+          else
+            goto break_while;   /* pattern fails */
+      }
     }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else
-  {
-   double d;
-   ungetc (c, in);
-   if (fscanf (in, "%s", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-   if (sscanf(s, "%lf %*c", &d) == 1)
-   {
-    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);
-   if (fgets (s, m, in) == NULL)
-   {
-    lua_pushnil();
-    return;
-   }
-   else
-   {
-    if (s[strlen(s)-1] == '\n')
-     s[strlen(s)-1] = 0;
-   }
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     long int l;
-     sscanf (s, "%ld", &l);
-     lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float fl;
-     sscanf (s, "%f", &fl);
-     lua_pushnumber(fl);
-    }
-    break;
-    default: 
-     lua_pushstring(s); 
-    break;
-   }
-  }
-  else
-  {
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     long int l;
-     if (fscanf (in, "%ld", &l) == EOF)
-       lua_pushnil();
-       else lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float f;
-     if (fscanf (in, "%f", &f) == EOF)
-       lua_pushnil();
-       else lua_pushnumber(f);
-    }
-    break;
-    default: 
-    {
-     char s[256];
-     if (fscanf (in, "%s", s) == EOF)
-       lua_pushnil();
-       else lua_pushstring(s);
-    }
-    break;
-   }
-  }
- }
+  } break_while:
+  if (c >= 0)  /* not EOF nor NEED_OTHER? */
+     ungetc(c, lua_infile);
+  buff = luaI_addchar(0);
+  if (*buff != 0 || *p == 0)  /* read something or did not fail? */
+    lua_pushstring(buff);
 }
 
 
-/*
-** Read characters until a given one. The delimiter is not read.
-*/
-static void io_readuntil (void)
-{
- int n=255,m=0;
- int c,d;
- char *s;
- lua_Object lo = lua_getparam(1);
- if (!lua_isstring(lo))
-  d = EOF; 
- else
-  d = *lua_getstring(lo);
- 
- s = (char *)malloc(n+1);
- while((c = fgetc(in)) != EOF && c != d)
- {
-  if (m==n)
-  {
-   n *= 2;
-   s = (char *)realloc(s, n+1);
-  }
-  s[m++] = c;
- }
- if (c != EOF) ungetc(c,in);
- s[m] = 0;
- lua_pushstring(s);
- free(s);
-}
-
-
-
-/*
-** 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[2048];
- static char f[80];
- char *string = &buffer[255];
- char *fstart=e, *fspace, *send;
- char t, j='r';
- int  m=0, n=-1, l;
- while (isspace(*e)) e++;
- fspace = e;
- t = *e++;
- if (*e == '<' || *e == '|' || *e == '>') j = *e++;
- while (isdigit(*e))
-  m = m*10 + (*e++ - '0');
- if (*e == '.') e++;	/* skip point */
- while (isdigit(*e))
-  if (n < 0) n = (*e++ - '0');
-  else       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);
- switch (t)
- {
-  case 'i': case 'I': t = 'd';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (long int)lua_getnumber(o));
-  break;
-  case 'f': case 'g': case 'e': case 'G': case 'E': 
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 'F': t = 'f';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 's': case 'S': t = 's';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, lua_getstring(o));
-  break;
-  default: return "";
- }
- l = strlen(string);
- send = string+l;
- if (m!=0 && l>m)
- {
-  int i;
-  for (i=0; i<m; i++)
-   string[i] = '*';
-  string[i] = 0;
- }
- else if (m!=0 && j=='|')
- {
-  int k;
-  int i=l-1;
-  while (isspace(string[i]) || string[i]==0) i--;
-  string -= (m-i)/2;
-  for(k=0; k<(m-i)/2; k++)
-   string[k] = ' ';
- }
- /* add space characteres */
- while (fspace != fstart)
- {
-  string--;
-  fspace--;
-  *string = *fspace; 
- }
- while (isspace(*e)) *send++ = *e++;
- *send = 0;
- return string;
-}
 static void io_write (void)
 {
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- if (o1 == LUA_NOOBJECT)			/* new line */
- {
-  fprintf (out, "\n");
-  lua_pushnumber(1);
- }
- else if (o2 == LUA_NOOBJECT)   		/* 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)));
- }
+  int arg = 1;
+  int status = 1;
+  char *s;
+  while ((s = lua_opt_string(arg++, NULL, "write")) != NULL)
+    status = status && (fputs(s, lua_outfile) != EOF);
+  pushresult(status);
 }
 
-/*
-** Execute a executable program using "system".
-** Return the result of execution.
-*/
+
 static void io_execute (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  int res = system(lua_getstring(o));
-  lua_pushnumber (res);
- }
- return;
+  lua_pushnumber(system(lua_check_string(1, "execute")));
 }
 
-/*
-** Remove a file.
-** On error put 0 on stack, otherwise put 1.
-*/
+
 static void io_remove  (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  if (remove(lua_getstring(o)) == 0)
-   lua_pushnumber (1);
-  else
-   lua_pushnumber (0);
- }
- return;
+  pushresult(remove(lua_check_string(1, "remove")) == 0);
 }
 
 
-/*
-** To get a environment variables
-*/
+static void io_rename (void)
+{
+  pushresult(rename(lua_check_string(1, "rename"),
+                    lua_check_string(2, "rename")) == 0);
+}
+
+
+static void io_tmpname (void)
+{
+  lua_pushstring(tmpnam(NULL));
+}
+
+
+
 static void io_getenv (void)
 {
- lua_Object s = lua_getparam(1);
- if (!lua_isstring(s))
-  lua_pushnil();
- else
- {
-  char *env = getenv(lua_getstring(s));
-  if (env == NULL) lua_pushnil();
-  else             lua_pushstring(env); 
- }
+  lua_pushstring(getenv(lua_check_string(1, "getenv"))); /* if NULL push nil */
 }
 
-/*
-** Return time: hour, min, sec
-*/
-static void io_time (void)
-{
- time_t t;
- struct tm *s;
- 
- time(&t);
- s = localtime(&t);
- lua_pushnumber(s->tm_hour);
- lua_pushnumber(s->tm_min);
- lua_pushnumber(s->tm_sec);
-}
- 
-/*
-** Return date: dd, mm, yyyy
-*/
+
 static void io_date (void)
 {
- time_t t;
- struct tm *s;
- 
- time(&t);
- s = localtime(&t);
- lua_pushnumber(s->tm_mday);
- lua_pushnumber(s->tm_mon+1);
- lua_pushnumber(s->tm_year+1900);
+  time_t t;
+  struct tm *tm;
+  char *s = lua_opt_string(1, "%c", "date");
+  char b[BUFSIZ];
+  time(&t); tm = localtime(&t);
+  if (strftime(b,sizeof(b),s,tm))
+    lua_pushstring(b);
+  else
+    lua_error("invalid `date' format");
 }
  
-/*
-** Beep
-*/
-static void io_beep (void)
-{
- printf("\a");
-}
- 
-/*
-** To exit
-*/
+
 static void io_exit (void)
 {
- lua_Object o = lua_getparam(1);
- if (lua_isstring(o))
-  printf("%s\n", lua_getstring(o));
- exit(1);
+  lua_Object o = lua_getparam(1);
+  exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);
 }
 
-/*
-** To debug a lua program. Start a dialog with the user, interpreting
-   lua commands until an 'cont'.
-*/
+
 static void io_debug (void)
 {
-  while (1)
-  {
+  while (1) {
     char buffer[250];
     fprintf(stderr, "lua_debug> ");
-    if (gets(buffer) == 0) return;
-    if (strcmp(buffer, "cont") == 0) return;
+    if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
+    if (strcmp(buffer, "cont\n") == 0) return;
     lua_dostring(buffer);
   }
 }
 
-/*
-** Open io library
-*/
+
+static void lua_printstack (FILE *f)
+{
+  int level = 0;
+  lua_Object func;
+  fprintf(f, "Active Stack:\n");
+  while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
+    char *name;
+    int currentline;
+    fprintf(f, "\t");
+    switch (*lua_getobjname(func, &name)) {
+      case 'g':
+        fprintf(f, "function %s", name);
+        break;
+      case 'f':
+        fprintf(f, "`%s' fallback", 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)
+{
+  char *s = lua_opt_string(1, "(no messsage)", NULL);
+  fprintf(stderr, "lua: %s\n", s);
+  lua_printstack(stderr);
+}
+
+
+static struct lua_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},
+{"print_stack", errorfb}
+};
+
 void iolib_open (void)
 {
- lua_register ("readfrom", io_readfrom);
- lua_register ("writeto",  io_writeto);
- lua_register ("appendto", io_appendto);
- lua_register ("read",     io_read);
- lua_register ("readuntil",io_readuntil);
- lua_register ("write",    io_write);
- lua_register ("execute",  io_execute);
- lua_register ("remove",   io_remove);
- lua_register ("getenv",   io_getenv);
- lua_register ("time",     io_time);
- lua_register ("date",     io_date);
- lua_register ("beep",     io_beep);
- lua_register ("exit",     io_exit);
- lua_register ("debug",    io_debug);
+  lua_infile=stdin; lua_outfile=stdout;
+  luaI_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
+  lua_setfallback("error", errorfb);
 }

lex.c

@@ -1,45 +1,47 @@
-char *rcs_lex = "$Id: lex.c,v 2.13 1994/12/20 21:20:36 roberto Exp celes $";
- 
+char *rcs_lex = "$Id: lex.c,v 2.38 1996/11/08 12:49:35 roberto Exp roberto $";
+
 
 #include <ctype.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
 #include <string.h>
 
+#include "mem.h"
 #include "tree.h"
 #include "table.h"
-#include "opcode.h"
+#include "lex.h"
 #include "inout.h"
+#include "luadebug.h"
 #include "parser.h"
-#include "ugly.h"
 
-#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
+#define MINBUFF 260
 
-#define next() { current = input(); }
-#define save(x) { *yytextLast++ = (x); }
-#define save_and_next()  { save(current); next(); }
+#define next() (current = input())
+#define save(x) (yytext[tokensize++] = (x))
+#define save_and_next()  (save(current), next())
 
-static int current;
-static char yytext[256];
-static char *yytextLast;
 
-static Input input;
+static int current;  /* look ahead character */
+static Input input;  /* input function */
+
 
 void lua_setinput (Input fn)
 {
-  current = ' ';
+  current = '\n';
+  lua_linenumber = 0;
   input = fn;
 }
 
-char *lua_lasttext (void)
+void luaI_syntaxerror (char *s)
 {
-  *yytextLast = 0;
-  return yytext;
+  char msg[256];
+  char *token = luaI_buffer(1);
+  if (token[0] == 0)
+    token = "<eof>";
+  sprintf (msg,"%s;\n> last token read: \"%s\" at line %d in file %s",
+           s, token, lua_linenumber, lua_parsedfile);
+  lua_error (msg);
 }
 
 
-/* The reserved words must be listed in lexicographic order */
 static struct
   {
     char *name;
@@ -66,61 +68,107 @@ static struct
 #define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
 
 
-static int findReserved (char *name)
+void luaI_addReserved (void)
 {
-  int l = 0;
-  int h = RESERVEDSIZE - 1;
-  while (l <= h)
+  int i;
+  for (i=0; i<RESERVEDSIZE; i++)
   {
-    int m = (l+h)/2;
-    int comp = lua_strcmp(name, reserved[m].name);
-    if (comp < 0)
-      h = m-1;
-    else if (comp == 0)
-      return reserved[m].token;
-    else
-      l = m+1;
+    TaggedString *ts = lua_createstring(reserved[i].name);
+    ts->marked = reserved[i].token;  /* reserved word  (always > 255) */
   }
-  return 0;
 }
 
-
-int yylex (void)
+static int inclinenumber (int pragma_allowed)
 {
-  float a;
+  ++lua_linenumber;
+  if (pragma_allowed && current == '$') {  /* is a pragma? */
+    char *buff = luaI_buffer(MINBUFF+1);
+    int i = 0;
+    next();  /* skip $ */
+    while (isalnum(current)) {
+      if (i >= MINBUFF) luaI_syntaxerror("pragma too long");
+      buff[i++] = current;
+      next();
+    }
+    buff[i] = 0;
+    if (strcmp(buff, "debug") == 0)
+      lua_debug = 1;
+    else if (strcmp(buff, "nodebug") == 0)
+      lua_debug = 0;
+    else luaI_syntaxerror("invalid pragma");
+  }
+  return lua_linenumber;
+}
+
+static int read_long_string (char *yytext, int buffsize)
+{
+  int cont = 0;
+  int tokensize = 2;  /* '[[' already stored */
   while (1)
   {
-    yytextLast = yytext;
-#if 0
-    fprintf(stderr,"'%c' %d\n",current,current);
-#endif
+    if (buffsize-tokensize <= 2) /* may read more than 1 char in one cicle */
+      yytext = luaI_buffer(buffsize *= 2);
     switch (current)
     {
-      case EOF:
       case 0:
-       return 0;
-      case '\n': lua_linenumber++;
-      case ' ':
-      case '\t':
+        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_and_next();
+        inclinenumber(0);
+        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':
         next();
+        linelasttoken = inclinenumber(1);
         continue;
 
-      case '$':
-	next();
-	while (isalnum(current) || current == '_')
-          save_and_next();
-        *yytextLast = 0;
-	if (lua_strcmp(yytext, "debug") == 0)
-	{
-	  yylval.vInt = 1;
-	  return DEBUG;
-        }
-	else if (lua_strcmp(yytext, "nodebug") == 0)
-	{
-	  yylval.vInt = 0;
-	  return DEBUG;
-        }
-	return WRONGTOKEN;
+      case ' ': case '\t': case '\r':  /* CR: to avoid problems with DOS */
+        next();
+        continue;
 
       case '-':
         save_and_next();
@@ -128,6 +176,15 @@ int yylex (void)
         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 '=';
@@ -152,14 +209,16 @@ int yylex (void)
       case '\'':
       {
         int del = current;
-        next();  /* skip the delimiter */
+        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 EOF:
             case 0:
             case '\n':
+              save(0);
               return WRONGTOKEN;
             case '\\':
               next();  /* do not save the '\' */
@@ -168,16 +227,19 @@ int yylex (void)
                 case 'n': save('\n'); next(); break;
                 case 't': save('\t'); next(); break;
                 case 'r': save('\r'); next(); break;
-                default : save(current); next(); break;
+                case '\n': save_and_next(); inclinenumber(0); break;
+                default : save_and_next(); break;
               }
               break;
             default:
               save_and_next();
           }
         }
-        next();  /* skip the delimiter */
-        *yytextLast = 0;
-        yylval.vWord = luaI_findconstant(lua_constcreate(yytext));
+        next();  /* skip delimiter */
+        save(0);
+        luaY_lval.vWord = luaI_findconstantbyname(yytext+1);
+        tokensize--;
+        save(del); save(0);  /* restore delimiter */
         return STRING;
       }
 
@@ -195,12 +257,14 @@ int yylex (void)
       case 'Z':
       case '_':
       {
-        Word res;
+        TaggedString *ts;
         do { save_and_next(); } while (isalnum(current) || current == '_');
-        *yytextLast = 0;
-        res = findReserved(yytext);
-        if (res) return res;
-        yylval.pNode = lua_constcreate(yytext);
+        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;
       }
 
@@ -209,7 +273,12 @@ int yylex (void)
         if (current == '.')
         {
           save_and_next();
-          return CONC;
+          if (current == '.')
+          {
+            save_and_next();
+            return DOTS;   /* ... */
+          }
+          else return CONC;   /* .. */
         }
         else if (!isdigit(current)) return '.';
         /* current is a digit: goes through to number */
@@ -219,49 +288,49 @@ int yylex (void)
       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*a+current-'0'; save_and_next(); } while (isdigit(current));
-        if (current == '.') save_and_next();
-fraction:
-	{ float da=0.1;
+        do {
+          a=10.0*a+(current-'0');
+          save_and_next();
+        } while (isdigit(current));
+        if (current == '.') {
+          save_and_next();
+          if (current == '.')
+            luaI_syntaxerror(
+              "ambiguous syntax (decimal point x string concatenation)");
+        }
+      fraction:
+	{ double da=0.1;
 	  while (isdigit(current))
-	  {a+=(current-'0')*da; da/=10.0; save_and_next()};
+	  {
+            a+=(current-'0')*da;
+            da/=10.0;
+            save_and_next();
+          }
           if (current == 'e' || current == 'E')
           {
 	    int e=0;
 	    int neg;
-	    float ea;
+	    double ea;
             save_and_next();
 	    neg=(current=='-');
             if (current == '+' || current == '-') save_and_next();
-            if (!isdigit(current)) return WRONGTOKEN;
-            do { e=10*e+current-'0'; save_and_next(); } while (isdigit(current));
-	    for (ea=neg?0.1:10.0; e>0; e>>=1) 
+            if (!isdigit(current)) { save(0); return WRONGTOKEN; }
+            do {
+              e=10.0*e+(current-'0');
+              save_and_next();
+            } while (isdigit(current));
+	    for (ea=neg?0.1:10.0; e>0; e>>=1)
 	    {
 	      if (e & 1) a*=ea;
 	      ea*=ea;
 	    }
           }
-          yylval.vFloat = a;
+          luaY_lval.vFloat = a;
+          save(0);
           return NUMBER;
         }
 
-      case U_and: case U_do: case U_else: case U_elseif: case U_end:
-      case U_function: case U_if: case U_local: case U_nil: case U_not:
-      case U_or: case U_repeat: case U_return: case U_then:
-      case U_until: case U_while:
-      {
-        int old = current;
-        next();
-        return reserved[old-U_and].token;
-      }
-
-      case U_eq:	next(); return EQ;
-      case U_le:	next(); return LE;
-      case U_ge:	next(); return GE;
-      case U_ne:	next(); return NE;
-      case U_sc:	next(); return CONC;
-
-      default: 		/* also end of file */
+      default: 		/* also end of program (0) */
       {
         save_and_next();
         return yytext[0];
@@ -269,3 +338,4 @@ fraction:
     }
   }
 }
+

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

lua.c

@@ -3,7 +3,7 @@
 ** Linguagem para Usuarios de Aplicacao
 */
 
-char *rcs_lua="$Id: lua.c,v 1.3 1994/12/14 19:58:20 celes Exp $";
+char *rcs_lua="$Id: lua.c,v 1.13 1996/07/06 20:20:35 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -11,64 +11,61 @@ char *rcs_lua="$Id: lua.c,v 1.3 1994/12/14 19:58:20 celes Exp $";
 #include "lua.h"
 #include "lualib.h"
 
-static int lua_argc;
-static char **lua_argv;
 
-/*
-%F Allow Lua code to access argv strings.
-%i Receive from Lua the argument number (starting with 1).
-%o Return to Lua the argument, or nil if it does not exist.
-*/
-static void lua_getargv (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_Object lo = lua_getparam(1);
- if (!lua_isnumber(lo))
-  lua_pushnil();
- else
- {
-  int n = (int)lua_getnumber(lo);
-  if (n < 1 || n > lua_argc) lua_pushnil();
-  else                       lua_pushstring(lua_argv[n]);
- }
+  if (isatty(0)) {
+    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 */
 }
 
 
 int main (int argc, char *argv[])
 {
- int i;
- int result = 0;
- iolib_open ();
- strlib_open ();
- mathlib_open ();
-
- lua_register("argv", lua_getargv);
-
- if (argc < 2)
- {
-   char buffer[250];
-   while (gets(buffer) != 0)
-     result = lua_dostring(buffer);
- }
- else
- {
-  for (i=1; i<argc; i++)
-  {
-   if (strcmp(argv[i], "--") == 0)
-   {
-    lua_argc = argc-i-1;
-    lua_argv = argv+i;
-    break;
-   }
+  int i;
+  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 `%s' - ", argv[i]);
+          perror(NULL);
+        }
+        return 1;
+      }
+    }
   }
-  for (i=1; i<argc; i++)
-  {
-   if (strcmp(argv[i], "--") == 0)
-    break;
-   else
-    result = lua_dofile (argv[i]);
-  }
- }
- return result;
+  return result;
 }
 
-

lua.h

@@ -2,13 +2,18 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lua.h,v 3.15 1995/01/18 20:15:05 celes Exp celes $
+** $Id: lua.h,v 3.31 1996/11/12 16:00:16 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+#define LUA_VERSION	"Lua 2.5.1"
+#define LUA_COPYRIGHT	"Copyright (C) 1994-1996 TeCGraf"
+#define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
+
+
 /* Private Part */
  
 typedef enum
@@ -19,6 +24,9 @@ typedef enum
  LUA_T_ARRAY	= -4,
  LUA_T_FUNCTION	= -5,
  LUA_T_CFUNCTION= -6,
+ LUA_T_MARK	= -7,
+ LUA_T_CMARK	= -8,
+ LUA_T_LINE	= -9,
  LUA_T_USERDATA = 0
 } lua_Type;
  
@@ -44,6 +52,14 @@ void	       lua_endblock		(void);
 lua_Object     lua_getparam 		(int number);
 #define	       lua_getresult(_)		lua_getparam(_)
 
+#define        lua_isnil(_)             (lua_type(_)==LUA_T_NIL)
+#define        lua_istable(_)           (lua_type(_)==LUA_T_ARRAY)
+#define        lua_isuserdata(_)        (lua_type(_)>=LUA_T_USERDATA)
+#define        lua_iscfunction(_)       (lua_type(_)==LUA_T_CFUNCTION)
+int            lua_isnumber             (lua_Object object);
+int            lua_isstring             (lua_Object object);
+int            lua_isfunction           (lua_Object object);
+
 float          lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
@@ -52,7 +68,6 @@ void          *lua_getuserdata  	(lua_Object object);
 void 	       lua_pushnil 		(void);
 void           lua_pushnumber 		(float n);
 void           lua_pushstring 		(char *s);
-void           lua_pushliteral 		(char *s);
 void           lua_pushcfunction	(lua_CFunction fn);
 void           lua_pushusertag     	(void *u, int tag);
 void           lua_pushobject       	(lua_Object object);
@@ -65,32 +80,33 @@ lua_Object     lua_getsubscript         (void);
 
 int            lua_type 		(lua_Object object);
 
-int	       lua_lock			(void);
-lua_Object     lua_getlocked		(int ref);
-void	       lua_pushlocked		(int ref);
-void	       lua_unlock		(int ref);
+
+int            lua_ref			(int lock);
+lua_Object     lua_getref		(int ref);
+void	       lua_pushref		(int ref);
+void	       lua_unref		(int ref);
 
 lua_Object     lua_createtable		(void);
 
 
 /* some useful macros */
 
-#define lua_lockobject(o)  (lua_pushobject(o), lua_lock())
+#define lua_refobject(o,l)	(lua_pushobject(o), lua_ref(l))
 
 #define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
 
 #define lua_pushuserdata(u)     lua_pushusertag(u, LUA_T_USERDATA)
 
-#define lua_isnil(_)            (lua_type(_)==LUA_T_NIL)
-#define lua_isnumber(_)         (lua_type(_)==LUA_T_NUMBER)
-#define lua_isstring(_)         (lua_type(_)==LUA_T_STRING)
-#define lua_istable(_)          (lua_type(_)==LUA_T_ARRAY)
-#define lua_isfunction(_)       (lua_type(_)==LUA_T_FUNCTION)
-#define lua_iscfunction(_)      (lua_type(_)==LUA_T_CFUNCTION)
-#define lua_isuserdata(_)       (lua_type(_)>=LUA_T_USERDATA)
 
+/* for compatibility with old versions. Avoid using these macros */
 
-/* for lua 1.1 compatibility. Avoid using these macros */
+#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_getsubscript())
 #define lua_getfield(o,f)   (lua_pushobject(o), lua_pushliteral(f), lua_getsubscript())

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

@@ -2,15 +2,37 @@
 ** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lualib.h,v 1.2 1994/08/24 15:29:02 celes Stab roberto $
+** $Id: lualib.h,v 1.9 1996/08/01 14:55:33 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) */
+
+struct lua_reg {
+  char *name;
+  lua_CFunction func;
+};
+
+void luaI_openlib (struct lua_reg *l, int n);
+void lua_arg_check(int cond, char *funcname);
+char *lua_check_string (int numArg, char *funcname);
+char *lua_opt_string (int numArg, char *def, char *funcname);
+double lua_check_number (int numArg, char *funcname);
+long lua_opt_number (int numArg, long def, char *funcname);
+char *luaI_addchar (int c);
+void luaI_addquoted (char *s);
+
+char *item_end (char *p);
+int singlematch (int c, char *p);
+
 #endif
 

luamem.c

@@ -3,42 +3,56 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_mem = "$Id: mem.c,v 1.4 1995/01/13 22:11:12 roberto Exp roberto $";
+char *rcs_mem = "$Id: mem.c,v 1.12 1996/05/06 16:59:00 roberto Exp roberto $";
 
 #include <stdlib.h>
-#include <string.h>
 
 #include "mem.h"
 #include "lua.h"
 
+
 void luaI_free (void *block)
 {
-  *((int *)block) = -1;  /* to catch errors */
-  free(block);
-}
-
-
-void *luaI_malloc (unsigned long size)
-{
-  void *block = malloc((size_t)size);
-  if (block == NULL)
-    lua_error("not enough memory");
-  return block;
+  if (block)
+  {
+    *((int *)block) = -1;  /* to catch errors */
+    free(block);
+  }
 }
 
 
 void *luaI_realloc (void *oldblock, unsigned long size)
 {
-  void *block = realloc(oldblock, (size_t)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("not enough memory");
+    lua_error(memEM);
   return block;
 }
 
 
-char *luaI_strdup (char *str)
+int luaI_growvector (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit)
 {
-  char *newstr = luaI_malloc(strlen(str)+1);
-  strcpy(newstr, str);
-  return newstr;
+  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;
+}
+

luamem.h

@@ -1,7 +1,7 @@
 /*
 ** mem.c
 ** memory manager for lua
-** $Id: mem.h,v 1.1 1994/11/16 17:38:08 roberto Stab roberto $
+** $Id: mem.h,v 1.7 1996/04/22 18:00:37 roberto Exp roberto $
 */
  
 #ifndef mem_h
@@ -11,15 +11,29 @@
 #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_malloc (unsigned long size);
 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);
 
-char *luaI_strdup (char *str);
-
+#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) ((s *)luaI_realloc(old,(n)*sizeof(s)))
+#define growvector(old,n,s,e,l) \
+          (luaI_growvector((void**)old,n,sizeof(s),e,l))
 
 #endif 
 

makefile

@@ -1,7 +1,15 @@
-# $Id: makefile,v 1.12 1995/02/02 19:02:03 roberto Exp $
+# $Id: makefile,v 1.27 1996/08/28 20:45:48 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
-CFLAGS = -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
+CFLAGS = $(CONFIG) -Wall -Wmissing-prototypes -Wshadow -ansi -O2 -pedantic
 
 #CC = acc
 #CFLAGS = -fast -I/usr/5include
@@ -9,70 +17,82 @@ CFLAGS = -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
 AR = ar
 ARFLAGS	= rvl
 
+
 # Aplication modules
-LUAMOD =	\
-	parser 	\
-	lex	\
-	opcode	\
-	hash	\
-	table	\
-	inout	\
-	tree    \
-	fallback\
-	mem
+LUAOBJS = \
+	parser.o \
+	lex.o \
+	opcode.o \
+	hash.o \
+	table.o \
+	inout.o \
+	tree.o \
+	fallback.o \
+	mem.o \
+	func.o \
+	undump.o
 
-LIBMOD = 	\
-	iolib	\
-	strlib	\
-	mathlib
+LIBOBJS = 	\
+	iolib.o \
+	mathlib.o \
+	strlib.o
 
-LUAOBJS	= $(LUAMOD:%=%.o)
 
-LIBOBJS	= $(LIBMOD:%=%.o)
+lua : lua.o liblua.a liblualib.a
+	$(CC) $(CFLAGS) -o $@ lua.o -L. -llua -llualib -lm
 
-lua : lua.o lua.a lualib.a
-	$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
-
-lua.a : parser.c $(LUAOBJS)
+liblua.a : $(LUAOBJS)
 	$(AR) $(ARFLAGS) $@  $?
-	ranlib lua.a
+	ranlib $@
 
-lualib.a : $(LIBOBJS)
+liblualib.a : $(LIBOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib $@
 
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
-%.o	: %.c
-	$(CC) $(CFLAGS) -c -o $@ $<
+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.c : lua.stx
-	yacc++ -d lua.stx ; mv -f y.tab.c parser.c ; mv -f y.tab.h parser.h
+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
-	co lua.h lualib.h
+	rm -f parser.c parser.h y.tab.c y.tab.h
+	co lua.h lualib.h luadebug.h
 
-% : RCS/%,v
+
+%.h : RCS/%.h,v
+	co $@
+
+%.c : RCS/%.c,v
 	co $@
 
 
-fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h inout.h 
-hash.o : hash.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
-inout.o : inout.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
-iolib.o : iolib.c mem.h lua.h lualib.h 
-lex.o : lex.c tree.h types.h table.h opcode.h lua.h inout.h parser.h ugly.h 
+fallback.o : fallback.c mem.h fallback.h lua.h opcode.h types.h tree.h func.h \
+  table.h 
+func.o : func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h mem.h 
+hash.o : hash.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h 
+inout.o : inout.c lex.h opcode.h lua.h types.h tree.h func.h inout.h table.h \
+  mem.h 
+iolib.o : iolib.c lua.h luadebug.h lualib.h 
+lex.o : lex.c mem.h tree.h types.h table.h opcode.h lua.h func.h lex.h inout.h \
+  luadebug.h parser.h 
 lua.o : lua.c lua.h lualib.h 
 mathlib.o : mathlib.c lualib.h lua.h 
-mem.o : mem.c mem.h lua.h 
-opcode.o : opcode.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
-  fallback.h 
-strlib.o : strlib.c mem.h lua.h lualib.h 
-table.o : table.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
-  fallback.h 
-tree.o : tree.c mem.h lua.h tree.h types.h table.h opcode.h 
-parser.o : parser.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+mem.o : mem.c mem.h lua.h
+opcode.o : opcode.c luadebug.h lua.h mem.h opcode.h types.h tree.h func.h hash.h \
+  inout.h table.h fallback.h undump.h 
+parser.o : parser.c luadebug.h lua.h mem.h lex.h opcode.h types.h tree.h func.h \
+  hash.h inout.h table.h 
+strlib.o : strlib.c lua.h lualib.h 
+table.o : table.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h \
+  inout.h fallback.h luadebug.h 
+tree.o : tree.c mem.h lua.h tree.h types.h lex.h hash.h opcode.h func.h table.h 
+undump.o : undump.c opcode.h lua.h types.h tree.h func.h mem.h table.h undump.h 

mathlib.c

@@ -3,27 +3,23 @@
 ** Mathematics library to LUA
 */
 
-char *rcs_mathlib="$Id: mathlib.c,v 1.8 1995/01/04 18:49:54 roberto Exp $";
+char *rcs_mathlib="$Id: mathlib.c,v 1.17 1996/04/30 21:13:55 roberto Exp roberto $";
 
-#include <stdio.h>		/* NULL */
+#include <stdlib.h>
 #include <math.h>
 
 #include "lualib.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;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `abs'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `abs'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "abs"); 
  if (d < 0) d = -d;
  lua_pushnumber (d);
 }
@@ -31,13 +27,7 @@ static void math_abs (void)
 
 static void math_sin (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `sin'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `sin'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "sin");
  lua_pushnumber (sin(TORAD(d)));
 }
 
@@ -45,13 +35,7 @@ static void math_sin (void)
 
 static void math_cos (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `cos'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `cos'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "cos");
  lua_pushnumber (cos(TORAD(d)));
 }
 
@@ -59,104 +43,64 @@ static void math_cos (void)
 
 static void math_tan (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `tan'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `tan'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "tan");
  lua_pushnumber (tan(TORAD(d)));
 }
 
 
 static void math_asin (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `asin'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `asin'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "asin");
  lua_pushnumber (TODEGREE(asin(d)));
 }
 
 
 static void math_acos (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `acos'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `acos'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "acos");
  lua_pushnumber (TODEGREE(acos(d)));
 }
 
 
-
 static void math_atan (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `atan'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `atan'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "atan");
  lua_pushnumber (TODEGREE(atan(d)));
 }
 
 
+static void math_atan2 (void)
+{
+ double d1 = lua_check_number(1, "atan2");
+ double d2 = lua_check_number(2, "atan2");
+ lua_pushnumber (TODEGREE(atan2(d1, d2)));
+}
+
+
 static void math_ceil (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `ceil'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `ceil'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "ceil");
  lua_pushnumber (ceil(d));
 }
 
 
 static void math_floor (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `floor'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `floor'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "floor");
  lua_pushnumber (floor(d));
 }
 
 static void math_mod (void)
 {
- int d1, d2;
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
-   lua_error ("incorrect arguments to function `mod'");
- d1 = (int) lua_getnumber(o1);
- d2 = (int) lua_getnumber(o2);
- lua_pushnumber (d1%d2);
+  float x = lua_check_number(1, "mod");
+  float y = lua_check_number(2, "mod");
+  lua_pushnumber(fmod(x, y));
 }
 
 
 static void math_sqrt (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `sqrt'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `sqrt'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "sqrt");
  lua_pushnumber (sqrt(d));
 }
 
@@ -169,7 +113,7 @@ static void math_pow (void)
  lua_Object op = lua_getparam(3);
  if (!lua_isnumber(o1) || !lua_isnumber(o2) || *(lua_getstring(op)) != 'p')
  {
-   lua_Object old = lua_getlocked(old_pow);
+   lua_Object old = lua_getref(old_pow);
    lua_pushobject(o1);
    lua_pushobject(o2);
    lua_pushobject(op);
@@ -187,129 +131,100 @@ static void math_pow (void)
 static void math_min (void)
 {
  int i=1;
- double d, dmin;
- lua_Object o;
- if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `min'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `min'");
- dmin = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
+ double dmin = lua_check_number(i, "min");
+ while (lua_getparam(++i) != LUA_NOOBJECT)
  {
-  if (!lua_isnumber(o))
-    lua_error ("incorrect arguments to function `min'");
-  d = lua_getnumber (o);
+  double d = lua_check_number(i, "min");
   if (d < dmin) dmin = d;
  }
  lua_pushnumber (dmin);
 }
 
-
 static void math_max (void)
 {
  int i=1;
- double d, dmax;
- lua_Object o;
- if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `max'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `max'");
- dmax = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
+ double dmax = lua_check_number(i, "max");
+ while (lua_getparam(++i) != LUA_NOOBJECT)
  {
-  if (!lua_isnumber(o))
-    lua_error ("incorrect arguments to function `max'");
-  d = lua_getnumber (o);
+  double d = lua_check_number(i, "max");
   if (d > dmax) dmax = d;
  }
  lua_pushnumber (dmax);
 }
 
-
 static void math_log (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `log'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `log'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "log");
  lua_pushnumber (log(d));
 }
 
 
 static void math_log10 (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `log10'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `log10'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "log10");
  lua_pushnumber (log10(d));
 }
 
 
 static void math_exp (void)
 {
- double d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `exp'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `exp'");
- d = lua_getnumber(o);
+ double d = lua_check_number(1, "exp");
  lua_pushnumber (exp(d));
 }
 
 static void math_deg (void)
 {
- float d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `deg'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `deg'");
- d = lua_getnumber(o);
+ float d = lua_check_number(1, "deg");
  lua_pushnumber (d*180./PI);
 }
 
 static void math_rad (void)
 {
- float d;
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `rad'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `rad'");
- d = lua_getnumber(o);
+ float d = lua_check_number(1, "rad");
  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(lua_check_number(1, "randomseed"));
+}
+
+
+static struct lua_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);
- lua_register ("sin",   math_sin);
- 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 ("min",   math_min);
- lua_register ("max",   math_max);
- lua_register ("log",   math_log);
- lua_register ("log10", math_log10);
- lua_register ("exp",   math_exp);
- lua_register ("deg",   math_deg);
- lua_register ("rad",   math_rad);
- old_pow = lua_lockobject(lua_setfallback("arith", math_pow));
+  luaI_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
+  old_pow = lua_refobject(lua_setfallback("arith", math_pow), 1);
 }
+

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.9 1994/11/23 14:31:11 roberto Stab $
+** $Id: opcode.h,v 3.23 1996/09/26 21:08:41 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -9,89 +9,101 @@
 #include "lua.h"
 #include "types.h"
 #include "tree.h"
+#include "func.h"
 
-#ifndef STACKGAP
-#define STACKGAP	128
-#endif 
-
-#ifndef real
-#define real float
-#endif
 
 #define FIELDS_PER_FLUSH 40
 
-#define MAX_TEMPS	20
 
+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,/*	w	-		LOC[w]  */
+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,/*	w	x		-		LOC[w]=x  */
+STOREGLOBAL,/*	w	x		-		VAR[w]=x  */
+STOREINDEXED0,/*	v i t		-		t[i]=v  */
+STOREINDEXED,/*	b	v a_b...a_1 i t	a_b...a_1 i t	t[i]=v  */
+STORELIST0,/*	w	v_w...v_1 t	-		t[i]=v_i  */
+STORELIST,/*	w n	v_w...v_1 t	-		t[i+n*FPF]=v_i  */
+STORERECORD,/*	n
+		w_n...w_1 v_n...v_1 t	-		t[STR[w_i]]=v_i  */
+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,/*	n m	v_n...v_1 f	r_m...r_1	f(v1,...,v_n)  */
+RETCODE0,
+RETCODE,/*	b	-		-  */
+SETLINE,/*	w	-		-		LINE=w  */
+VARARGS/*	b	v_n...v_1	{v_1...v_n;n=n}  */
 
-typedef enum 
-{ 
- PUSHNIL,
- PUSH0, PUSH1, PUSH2,
- PUSHBYTE,
- PUSHWORD,
- PUSHFLOAT,
- PUSHSTRING,
- PUSHFUNCTION,
- PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
- PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
- PUSHLOCAL,
- PUSHGLOBAL,
- PUSHINDEXED,
- PUSHSELF,
- STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
- STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
- STORELOCAL,
- STOREGLOBAL,
- STOREINDEXED0,
- STOREINDEXED,
- STORELIST0,
- STORELIST,
- STORERECORD,
- ADJUST0,
- ADJUST,
- CREATEARRAY,
- EQOP,
- LTOP,
- LEOP,
- GTOP,
- GEOP,
- ADDOP,
- SUBOP,
- MULTOP,
- DIVOP,
- POWOP,
- CONCOP,
- MINUSOP,
- NOTOP,
- ONTJMP,
- ONFJMP,
- JMP,
- UPJMP,
- IFFJMP,
- IFFUPJMP,
- POP,
- CALLFUNC,
- RETCODE0,
- RETCODE,
- SETFUNCTION,
- SETLINE,
- RESET
 } OpCode;
 
+
 #define MULT_RET	255
 
 
-typedef void (*Cfunction) (void);
-typedef int  (*Input) (void);
-
 typedef union
 {
- Cfunction     f;
+ lua_CFunction f;
  real          n;
  TaggedString *ts;
- Byte         *b;
+ TFunc         *tf;
  struct Hash    *a;
  void           *u;
+ int	       i;
 } Value;
 
 typedef struct Object
@@ -100,17 +112,12 @@ typedef struct Object
  Value value;
 } Object;
 
-typedef struct
-{
- Object  object;
-} Symbol;
 
 /* Macros to access structure members */
 #define tag(o)		((o)->tag)
 #define nvalue(o)	((o)->value.n)
 #define svalue(o)	((o)->value.ts->str)
 #define tsvalue(o)	((o)->value.ts)
-#define bvalue(o)	((o)->value.b)
 #define avalue(o)	((o)->value.a)
 #define fvalue(o)	((o)->value.f)
 #define uvalue(o)	((o)->value.u)
@@ -120,45 +127,24 @@ typedef struct
 #define s_tag(i)	(tag(&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)))
 
-typedef union
-{
- struct {char c1; char c2;} m;
- Word w;
-} CodeWord;
-#define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
-
-typedef union
-{
- struct {char c1; char c2; char c3; char c4;} m;
- float f;
-} CodeFloat;
-#define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
-                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
-
-typedef union
-{
- struct {char c1; char c2; char c3; char c4;} m;
- Byte *b;
-} CodeCode;
-#define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
-                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
+#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 */
-char   *lua_strdup (char *l);
-
-void    lua_setinput   (Input fn);	/* from "lex.c" module */
-char   *lua_lasttext   (void);		/* from "lex.c" module */
-int     yylex (void);		        /* from "lex.c" module */
-void    lua_parse      (Byte **code);	/* from "lua.stx" module */
-void    lua_travstack (void (*fn)(Object *));
+void    lua_parse      (TFunc *tf);	/* from "lua.stx" module */
+void	luaI_codedebugline (int line);  /* from "lua.stx" module */
+void    lua_travstack (int (*fn)(Object *));
 Object *luaI_Address (lua_Object o);
 void	luaI_pushobject (Object *o);
 void    luaI_gcFB       (Object *o);
+int     luaI_dorun (TFunc *tf);
 
 #endif

strlib.c

@@ -3,9 +3,10 @@
 ** String library to LUA
 */
 
-char *rcs_strlib="$Id: strlib.c,v 1.11 1995/02/02 20:05:37 roberto Exp roberto $";
+char *rcs_strlib="$Id: strlib.c,v 1.32 1996/11/07 20:26:19 roberto Exp roberto $";
 
 #include <string.h>
+#include <stdio.h>
 #include <stdlib.h>
 #include <ctype.h>
 
@@ -13,145 +14,554 @@ char *rcs_strlib="$Id: strlib.c,v 1.11 1995/02/02 20:05:37 roberto Exp roberto $
 #include "lualib.h"
 
 
-static char *newstring (lua_Object o)
+struct lbuff {
+  char *b;
+  size_t max;
+  size_t size;
+};
+
+static struct lbuff lbuffer = {NULL, 0, 0};
+
+
+static char *lua_strbuffer (unsigned long size)
 {
-  char *s = lua_getstring(o);
-  char *ns = (char *)malloc(strlen(s)+1);
-  if (ns == 0)
-    lua_error("not enough memory for new string");
-  strcpy(ns, s);
-  return ns;
+  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 = lua_strbuffer(lbuffer.size+size);
+  return buff+lbuffer.size;
+}
+
+void lua_arg_check(int cond, char *funcname)
+{
+  if (!cond) {
+    char buff[100];
+    sprintf(buff, "incorrect argument to function `%s'", funcname);
+    lua_error(buff);
+  }
+}
+
+char *lua_check_string (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  lua_arg_check(lua_isstring(o), funcname);
+  return lua_getstring(o);
+}
+
+char *lua_opt_string (int numArg, char *def, char *funcname)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              lua_check_string(numArg, funcname);
+}
+
+double lua_check_number (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  lua_arg_check(lua_isnumber(o), funcname);
+  return lua_getnumber(o);
+}
+
+long lua_opt_number (int numArg, long def, char *funcname)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              (long)lua_check_number(numArg, funcname);
+}
+
+char *luaI_addchar (int c)
+{
+  if (lbuffer.size >= lbuffer.max)
+    lua_strbuffer(lbuffer.max == 0 ? 100 : lbuffer.max*2);
+  lbuffer.b[lbuffer.size++] = c;
+  if (c == 0)
+    lbuffer.size = 0;  /* prepare for next string */
+  return lbuffer.b;
+}
+
+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
-** LUA interface:
-**			n = strfind (string, substring, init, end)
+** Interface to strtok
 */
-static void str_find (void)
+static void str_tok (void)
 {
- char *s1, *s2, *f;
- int init; 
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- lua_Object o3 = lua_getparam (3);
- lua_Object o4 = lua_getparam (4);
- if (!lua_isstring(o1) || !lua_isstring(o2))
-   lua_error ("incorrect arguments to function `strfind'");
- if (o3 == LUA_NOOBJECT)
-  init = 0;
- else if (lua_isnumber(o3))
-  init = lua_getnumber(o3)-1;
- else
- {
-   lua_error ("incorrect arguments to function `strfind'");
-   return;  /* to avoid warnings */
- }
- s1 = lua_getstring(o1);
- s2 = lua_getstring(o2);
- f = strstr(s1+init,s2);
- if (f != NULL)
- {
-  int pos = f-s1+1;
-  if (o4 == LUA_NOOBJECT)
-   lua_pushnumber (pos);
-  else if (!lua_isnumber(o4))
-   lua_error ("incorrect arguments to function `strfind'");
-  else if ((int)lua_getnumber(o4) >= pos+strlen(s2)-1)
-   lua_pushnumber (pos);
-  else
-   lua_pushnil();
- }
- else
-  lua_pushnil();
+  char *s1 = lua_check_string(1, "strtok");
+  char *del = lua_check_string(2, "strtok");
+  lua_Object t = lua_createtable();
+  int i = 1;
+  /* As strtok changes s1, and s1 is "constant",  make a copy of it */
+  s1 = strcpy(lua_strbuffer(strlen(s1+1)), s1);
+  while ((s1 = strtok(s1, del)) != NULL) {
+    lua_pushobject(t);
+    lua_pushnumber(i++);
+    lua_pushstring(s1);
+    lua_storesubscript();
+    s1 = NULL;  /* prepare for next strtok */
+  }
+  lua_pushobject(t);
+  lua_pushnumber(i-1);  /* total number of tokens */
 }
 
+
 /*
 ** Return the string length
-** LUA interface:
-**			n = strlen (string)
 */
 static void str_len (void)
 {
- lua_Object o = lua_getparam (1);
- if (!lua_isstring(o))
-   lua_error ("incorrect arguments to function `strlen'");
- lua_pushnumber(strlen(lua_getstring(o)));
+ lua_pushnumber(strlen(lua_check_string(1, "strlen")));
 }
 
-
 /*
-** Return the substring of a string, from start to end
-** LUA interface:
-**			substring = strsub (string, start, end)
+** Return the substring of a string
 */
 static void str_sub (void)
 {
- int start, end;
- char *s;
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- lua_Object o3 = lua_getparam (3);
- if (!lua_isstring(o1) || !lua_isnumber(o2))
-   lua_error ("incorrect arguments to function `strsub'");
- if (o3 != LUA_NOOBJECT && !lua_isnumber(o3))
-   lua_error ("incorrect third argument to function `strsub'");
- s = newstring(o1);
- start = lua_getnumber (o2);
- end = o3 == LUA_NOOBJECT ? strlen(s) : lua_getnumber (o3);
- if (end < start || start < 1 || end > strlen(s))
-  lua_pushliteral("");
- else
- {
-  s[end] = 0;
-  lua_pushstring (&s[start-1]);
- }
- free(s);
+  char *s = lua_check_string(1, "strsub");
+  long start = (long)lua_check_number(2, "strsub");
+  long end = lua_opt_number(3, strlen(s), "strsub");
+  if (1 <= start && start <= end && end <= strlen(s)) {
+    luaI_addchar(0);
+    addnchar(s+start-1, end-start+1);
+    lua_pushstring(luaI_addchar(0));
+  }
+  else lua_pushliteral("");
 }
 
 /*
 ** Convert a string to lower case.
-** LUA interface:
-**			lowercase = strlower (string)
 */
 static void str_lower (void)
 {
- char *s, *c;
- lua_Object o = lua_getparam (1);
- if (!lua_isstring(o))
-   lua_error ("incorrect arguments to function `strlower'");
- c = s = newstring(o);
- while (*c != 0)
- {
-  *c = tolower(*c);
-  c++;
- }
- lua_pushstring(s);
- free(s);
-} 
-
+  char *s = lua_check_string(1, "strlower");
+  luaI_addchar(0);
+  while (*s)
+    luaI_addchar(tolower(*s++));
+  lua_pushstring(luaI_addchar(0));
+}
 
 /*
 ** Convert a string to upper case.
-** LUA interface:
-**			uppercase = strupper (string)
 */
 static void str_upper (void)
 {
- char *s, *c;
- lua_Object o = lua_getparam (1);
- if (!lua_isstring(o))
-   lua_error ("incorrect arguments to function `strlower'");
- c = s = newstring(o);
- while (*c != 0)
- {
-  *c = toupper(*c);
-  c++;
- }
- lua_pushstring(s);
- free(s);
-} 
+  char *s = lua_check_string(1, "strupper");
+  luaI_addchar(0);
+  while (*s)
+    luaI_addchar(toupper(*s++));
+  lua_pushstring(luaI_addchar(0));
+}
+
+static void str_rep (void)
+{
+  char *s = lua_check_string(1, "strrep");
+  int n = (int)lua_check_number(2, "strrep");
+  luaI_addchar(0);
+  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 = lua_check_string(1, "ascii");
+  long pos = lua_opt_number(2, 1, "ascii") - 1;
+  lua_arg_check(0<=pos && pos<strlen(s), "ascii");
+  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 *item_end (char *p)
+{
+  switch (*p++) {
+    case '\0': return p-1;
+    case ESC:
+      if (*p == 0) lua_error("incorrect pattern");
+      return p+1;
+    case '[': {
+      char *end = bracket_end(p);
+      if (end == NULL) lua_error("incorrect pattern");
+      return end+1;
+    }
+    default:
+      return p;
+  }
+}
+
+static int matchclass (int c, int cl)
+{
+  int res;
+  switch (tolower(cl)) {
+    case 'a' : res = isalpha(c); break;
+    case 'c' : res = iscntrl(c); break;
+    case 'd' : res = isdigit(c); break;
+    case 'l' : res = islower(c); break;
+    case 'p' : res = ispunct(c); break;
+    case 's' : res = isspace(c); break;
+    case 'u' : res = isupper(c); break;
+    case 'w' : res = isalnum(c); break;
+    default: return (cl == c);
+  }
+  return (islower(cl) ? res : !res);
+}
+
+int 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(*(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 = singlematch(*s, p);
+      char *ep = 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 '?': {  /* 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 = lua_check_string(1, "strfind");
+  char *p = lua_check_string(2, "strfind");
+  long init = lua_opt_number(3, 1, "strfind") - 1;
+  lua_arg_check(0 <= init && init <= strlen(s), "strfind");
+  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(*++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 lua_arg_check(0, "gsub");
+}
+
+static void str_gsub (void)
+{
+  char *src = lua_check_string(1, "gsub");
+  char *p = lua_check_string(2, "gsub");
+  lua_Object newp = lua_getparam(3);
+  int max_s = lua_opt_number(4, strlen(src), "gsub");
+  int anchor = (*p == '^') ? (p++, 1) : 0;
+  int n = 0;
+  luaI_addchar(0);
+  while (*src && n < max_s) {
+    char *e;
+    if ((e=match(src, p, 0)) == NULL)
+      luaI_addchar(*src++);
+    else {
+      if (e == src) lua_error("empty pattern in substitution");
+      add_s(newp);
+      src = e;
+      n++;
+    }
+    if (anchor) break;
+  }
+  addstr(src);
+  lua_pushstring(luaI_addchar(0));
+  lua_pushnumber(n);  /* number of substitutions */
+}
+
+static void str_set (void)
+{
+  char *item = lua_check_string(1, "strset");
+  int i;
+  lua_arg_check(*item_end(item) == 0, "strset");
+  luaI_addchar(0);
+  for (i=1; i<256; i++)  /* 0 cannot be part of a set */
+    if (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 = lua_check_string(arg++, "format");
+  luaI_addchar(0);  /* 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/precision too long)");
+      strncpy(form, initf, strfrmt-initf+1); /* +1 to include convertion */
+      form[strfrmt-initf+1] = 0;
+      buff = openspace(1000);  /* to store the formated value */
+      switch (*strfrmt++) {
+        case 'q':
+          luaI_addquoted(lua_check_string(arg++, "format"));
+          continue;
+        case 's': {
+          char *s = lua_check_string(arg++, "format");
+          buff = openspace(strlen(s));
+          sprintf(buff, form, s);
+          break;
+        }
+        case 'c':  case 'd':  case 'i': case 'o':
+        case 'u':  case 'x':  case 'X':
+          sprintf(buff, form, (int)lua_check_number(arg++, "format"));
+          break;
+        case 'e':  case 'E': case 'f': case 'g':
+          sprintf(buff, form, lua_check_number(arg++, "format"));
+          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 */
+}
+
+
+void luaI_openlib (struct lua_reg *l, int n)
+{
+  int i;
+  for (i=0; i<n; i++)
+    lua_register(l[i].name, l[i].func);
+}
+
+
+static struct lua_reg strlib[] = {
+{"strtok", str_tok},
+{"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}
+};
 
 
 /*
@@ -159,9 +569,5 @@ static void str_upper (void)
 */
 void strlib_open (void)
 {
- lua_register ("strfind", str_find);
- lua_register ("strlen", str_len);
- lua_register ("strsub", str_sub);
- lua_register ("strlower", str_lower);
- lua_register ("strupper", str_upper);
+  luaI_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
 }

table.c

@@ -3,83 +3,86 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.27 1995/01/13 22:11:12 roberto Exp celes $";
-
-#include <string.h>
+char *rcs_table="$Id: table.c,v 2.57 1996/07/12 20:00:26 roberto Exp roberto $";
 
 #include "mem.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 BUFFER_BLOCK 256
 
-Symbol *lua_table;
-static Word lua_ntable = 0;
+Symbol *lua_table = NULL;
+Word lua_ntable = 0;
 static Long lua_maxsymbol = 0;
 
-TaggedString **lua_constant;
-static Word lua_nconstant = 0;
+TaggedString **lua_constant = NULL;
+Word lua_nconstant = 0;
 static Long lua_maxconstant = 0;
 
 
-
-#define MAXFILE 	20
-char  		       *lua_file[MAXFILE];
-int      		lua_nfile;
-
-#define GARBAGE_BLOCK 256
-#define MIN_GARBAGE_BLOCK 10
+#define GARBAGE_BLOCK 50
 
 static void lua_nextvar (void);
-static void setglobal (void);
-static void getglobal (void);
 
 /*
-** Initialise symbol table with internal functions
+** Internal functions
 */
-static void lua_initsymbol (void)
+static struct {
+  char *name;
+  lua_CFunction func;
+} int_funcs[] = {
+  {"assert", luaI_assert},
+  {"call", luaI_call},
+  {"dofile", lua_internaldofile},
+  {"dostring", lua_internaldostring},
+  {"error", luaI_error},
+  {"getglobal", luaI_getglobal},
+  {"next", lua_next},
+  {"nextvar", lua_nextvar},
+  {"print", luaI_print},
+  {"setfallback", luaI_setfallback},
+  {"setglobal", luaI_setglobal},
+  {"tonumber", lua_obj2number},
+  {"tostring", luaI_tostring},
+  {"type", luaI_type}
+};
+
+#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+
+
+void luaI_initsymbol (void)
 {
- Word n;
- lua_maxsymbol = BUFFER_BLOCK;
- lua_table = newvector(lua_maxsymbol, Symbol);
- n = luaI_findsymbolbyname("next");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
- n = luaI_findsymbolbyname("dofile");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
- n = luaI_findsymbolbyname("setglobal");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = setglobal;
- n = luaI_findsymbolbyname("getglobal");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = getglobal;
- n = luaI_findsymbolbyname("nextvar");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
- n = luaI_findsymbolbyname("type"); 
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
- n = luaI_findsymbolbyname("tonumber");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
- n = luaI_findsymbolbyname("print");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
- n = luaI_findsymbolbyname("dostring");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
- n = luaI_findsymbolbyname("setfallback");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
- n = luaI_findsymbolbyname("error");
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
+  int i;
+  Word n;
+  lua_maxsymbol = BUFFER_BLOCK;
+  lua_table = newvector(lua_maxsymbol, Symbol);
+  for (i=0; i<INTFUNCSIZE; i++)
+  {
+    n = luaI_findsymbolbyname(int_funcs[i].name);
+    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
+  }
+  n = luaI_findsymbolbyname("_VERSION_");
+  s_tag(n) = LUA_T_STRING; s_tsvalue(n) = lua_createstring(LUA_VERSION);
 }
 
 
 /*
 ** Initialise constant table with pre-defined constants
 */
-void lua_initconstant (void)
+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);
 }
 
 
@@ -87,22 +90,15 @@ void lua_initconstant (void)
 ** Given a name, search it at symbol table and return its index. If not
 ** found, allocate it.
 */
-Word luaI_findsymbol (TreeNode *t)
+Word luaI_findsymbol (TaggedString *t)
 {
- if (lua_table == NULL)
-  lua_initsymbol(); 
  if (t->varindex == NOT_USED)
  {
   if (lua_ntable == lua_maxsymbol)
-  {
-   if (lua_maxsymbol >= MAX_WORD)
-     lua_error("symbol table overflow");
-   lua_maxsymbol *= 2;
-   if (lua_maxsymbol >= MAX_WORD)
-     lua_maxsymbol = MAX_WORD; 
-   lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
-  }
+    lua_maxsymbol = growvector(&lua_table, lua_maxsymbol, Symbol,
+                      symbolEM, MAX_WORD);
   t->varindex = lua_ntable;
+  lua_table[lua_ntable].varname = t;
   s_tag(lua_ntable) = LUA_T_NIL;
   lua_ntable++;
  }
@@ -112,58 +108,87 @@ Word luaI_findsymbol (TreeNode *t)
 
 Word luaI_findsymbolbyname (char *name)
 {
-  return luaI_findsymbol(lua_constcreate(name));
+  return luaI_findsymbol(luaI_createfixedstring(name));
 }
 
 
 /*
-** Given a name, search it at constant table and return its index. If not
-** found, allocate it.
-** On error, return -1.
+** Given a tree node, check it is has a correspondent constant index. If not,
+** allocate it.
 */
-Word luaI_findconstant (TreeNode *t)
+Word luaI_findconstant (TaggedString *t)
 {
- if (lua_constant == NULL)
-  lua_initconstant();
  if (t->constindex == NOT_USED)
  {
   if (lua_nconstant == lua_maxconstant)
-  {
-   if (lua_maxconstant >= MAX_WORD)
-     lua_error("constant table overflow");
-   lua_maxconstant *= 2;
-   if (lua_maxconstant >= MAX_WORD)
-     lua_maxconstant = MAX_WORD;
-   lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
-  }
+    lua_maxconstant = growvector(&lua_constant, lua_maxconstant, TaggedString *,
+                        constantEM, MAX_WORD);
   t->constindex = lua_nconstant;
-  lua_constant[lua_nconstant] = &(t->ts);
+  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;
+}
+
+
 /*
 ** Traverse symbol table objects
 */
-void lua_travsymbol (void (*fn)(Object *))
+static char *lua_travsymbol (int (*fn)(Object *))
 {
  Word i;
  for (i=0; i<lua_ntable; i++)
-  fn(&s_object(i));
+  if (fn(&s_object(i)))
+    return lua_table[i].varname->str;
+ return NULL;
 }
 
 
 /*
 ** Mark an object if it is a string or a unmarked array.
 */
-void lua_markobject (Object *o)
-{
+int lua_markobject (Object *o)
+{/* if already marked, does not change mark value */
  if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
    tsvalue(o)->marked = 1;
  else if (tag(o) == LUA_T_ARRAY)
    lua_hashmark (avalue(o));
+ else if ((o->tag == LUA_T_FUNCTION || o->tag == LUA_T_MARK)
+           && !o->value.tf->marked)
+   o->value.tf->marked = 1;
+ return 0;
+}
+
+/*
+* returns 0 if the object is going to be (garbage) collected
+*/
+int luaI_ismarked (Object *o)
+{
+  switch (o->tag)
+  {
+   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;
+  }
 }
 
 
@@ -171,107 +196,83 @@ void lua_markobject (Object *o)
 ** Garbage collection. 
 ** Delete all unused strings and arrays.
 */
-void lua_pack (void)
+Long luaI_collectgarbage (void)
 {
-  static Long block = GARBAGE_BLOCK; /* when garbage collector will be called */
-  static Long nentity = 0;  /* counter of new entities (strings and arrays) */
   Long recovered = 0;
-  if (nentity++ < block) return;
   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_invalidaterefs();
   recovered += lua_strcollector();
   recovered += lua_hashcollector();
-  nentity = 0;				/* reset counter */
-  block=(16*block-7*recovered)/12;	/* adapt block size */
-  if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
+  recovered += luaI_funccollector();
+  return recovered;
 } 
 
-
-/*
-** 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 error message on error.
-*/
-char *lua_addfile (char *fn)
+void lua_pack (void)
 {
- if (lua_nfile >= MAXFILE)
-   return "too many files";
- if ((lua_file[lua_nfile++] = luaI_strdup (fn)) == NULL)
-   return "not enough memory";
- return NULL;
-}
+  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;
+} 
 
-/*
-** Delete a file from file stack
-*/
-int lua_delfile (void)
-{
- luaI_free(lua_file[--lua_nfile]); 
- return 1;
-}
-
-/*
-** Return the last file name set.
-*/
-char *lua_filename (void)
-{
- return lua_file[lua_nfile-1];
-}
 
 /*
 ** Internal function: return next global variable
 */
 static void lua_nextvar (void)
 {
- char *varname;
- TreeNode *next;
+ Word next;
  lua_Object o = lua_getparam(1);
  if (o == LUA_NOOBJECT)
-   lua_reportbug("too few arguments to function `nextvar'");
+   lua_error("too few arguments to function `nextvar'");
  if (lua_getparam(2) != LUA_NOOBJECT)
-   lua_reportbug("too many arguments to function `nextvar'");
+   lua_error("too many arguments to function `nextvar'");
  if (lua_isnil(o))
-   varname = NULL;
+   next = 0;
  else if (!lua_isstring(o))
  {
-   lua_reportbug("incorrect argument to function `nextvar'"); 
+   lua_error("incorrect argument to function `nextvar'"); 
    return;  /* to avoid warnings */
  }
  else
-   varname = lua_getstring(o);
- next = lua_varnext(varname);
- if (next == NULL)
+   next = luaI_findsymbolbyname(lua_getstring(o)) + 1;
+ while (next < lua_ntable && s_tag(next) == LUA_T_NIL) next++;
+ if (next < lua_ntable)
  {
-  lua_pushnil();
-  lua_pushnil();
- }
- else
- {
-  Object name;
-  tag(&name) = LUA_T_STRING;
-  tsvalue(&name) = &(next->ts);
-  luaI_pushobject(&name);
-  luaI_pushobject(&s_object(next->varindex));
+  lua_pushstring(lua_table[next].varname->str);
+  luaI_pushobject(&s_object(next));
  }
 }
 
 
-static void setglobal (void)
+static Object *functofind;
+static int checkfunc (Object *o)
 {
-  lua_Object name = lua_getparam(1);
-  lua_Object value = lua_getparam(2);
-  if (!lua_isstring(name))
-    lua_reportbug("incorrect argument to function `setglobal'");
-  lua_pushobject(value);
-  lua_storeglobal(lua_getstring(name));
+  if (o->tag == LUA_T_FUNCTION)
+    return
+       ((functofind->tag == LUA_T_FUNCTION || functofind->tag == LUA_T_MARK)
+            && (functofind->value.tf == o->value.tf));
+  if (o->tag == LUA_T_CFUNCTION)
+    return
+       ((functofind->tag == LUA_T_CFUNCTION || functofind->tag == LUA_T_CMARK)
+            && (functofind->value.f == o->value.f));
+  return 0;
 }
 
 
-static void getglobal (void)
-{
-  lua_Object name = lua_getparam(1);
-  if (!lua_isstring(name))
-    lua_reportbug("incorrect argument to function `getglobal'");
-  lua_pushobject(lua_getglobal(lua_getstring(name)));
+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,7 +1,7 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.9 1994/11/23 14:31:11 roberto Stab roberto $
+** $Id: table.h,v 2.20 1996/03/14 15:57:19 roberto Exp roberto $
 */
 
 #ifndef table_h
@@ -10,22 +10,29 @@
 #include "tree.h"
 #include "opcode.h"
 
+typedef struct
+{
+ Object  object;
+ TaggedString *varname;
+} Symbol;
+
+
 extern Symbol *lua_table;
+extern Word lua_ntable;
 extern TaggedString **lua_constant;
+extern Word lua_nconstant;
 
-extern char   *lua_file[];
-extern int     lua_nfile;
-
-
-void  lua_initconstant (void);
+void luaI_initsymbol (void);
+void  luaI_initconstant (void);
 Word  luaI_findsymbolbyname (char *name);
-Word  luaI_findsymbol      (TreeNode *t);
-Word  luaI_findconstant    (TreeNode *t);
-void  lua_travsymbol      (void (*fn)(Object *));
-void  lua_markobject      (Object *o);
+Word  luaI_findsymbol      (TaggedString *t);
+Word  luaI_findconstant    (TaggedString *t);
+Word  luaI_findconstantbyname (char *name);
+TaggedString *luaI_createfixedstring  (char *str);
+int   lua_markobject      (Object *o);
+int luaI_ismarked (Object *o);
+Long luaI_collectgarbage (void);
 void  lua_pack            (void);
-char *lua_addfile         (char *fn);
-int   lua_delfile 	  (void);
-char *lua_filename        (void);
+
 
 #endif

tree.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: tree.c,v 1.12 1994/12/20 21:20:36 roberto Exp roberto $";
+char *rcs_tree="$Id: tree.c,v 1.19 1996/02/22 20:34:33 roberto Exp $";
 
 
 #include <string.h>
@@ -11,66 +11,104 @@ char *rcs_tree="$Id: tree.c,v 1.12 1994/12/20 21:20:36 roberto Exp roberto $";
 #include "mem.h"
 #include "lua.h"
 #include "tree.h"
+#include "lex.h"
+#include "hash.h"
 #include "table.h"
 
 
-#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b))) 
+#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 = {NOT_USED, NOT_USED, 0, 2, {0}};
 
 
-typedef struct StringNode {
-  struct StringNode *next;
-  TaggedString ts;
-} StringNode;
-
-static StringNode *string_root = NULL;
-
-static TreeNode *constant_root = NULL;
-
-/*
-** Insert a new constant/variable at the tree. 
-*/
-static TreeNode *tree_create (TreeNode **node, char *str)
+static unsigned long hash (char *str)
 {
- if (*node == NULL)
- {
-  *node = (TreeNode *) luaI_malloc(sizeof(TreeNode)+strlen(str));
-  (*node)->left = (*node)->right = NULL;
-  strcpy((*node)->ts.str, str);
-  (*node)->ts.marked = 0;
-  (*node)->ts.hash = 0;
-  (*node)->varindex = (*node)->constindex = NOT_USED;
-  return *node;
- }
- else
- {
-  int c = lua_strcmp(str, (*node)->ts.str);
-  if (c < 0) 
-   return tree_create(&(*node)->left, str);
-  else if (c > 0)
-   return tree_create(&(*node)->right, str);
+  unsigned long h = 0;
+  while (*str)
+    h = ((h<<5)-h)^(unsigned char)*(str++);
+  return h;
+}
+
+static void initialize (void)
+{
+  initialized = 1;
+  luaI_addReserved();
+  luaI_initsymbol();
+  luaI_initconstant();
+}
+
+
+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 *str, stringtable *tb)
+{
+  TaggedString *ts;
+  unsigned long h = hash(str);
+  int i;
+  int j = -1;
+  if ((Long)tb->nuse*3 >= (Long)tb->size*2)
+  {
+    if (!initialized)
+      initialize();
+    grow(tb);
+  }
+  i = h%tb->size;
+  while (tb->hash[i])
+  {
+    if (tb->hash[i] == &EMPTY)
+      j = i;
+    else if (strcmp(str, tb->hash[i]->str) == 0)
+      return tb->hash[i];
+    i = (i+1)%tb->size;
+  }
+  /* not found */
+  lua_pack();
+  if (j != -1)  /* is there an EMPTY space? */
+    i = j;
   else
-   return *node;
- }
+    tb->nuse++;
+  ts = tb->hash[i] = (TaggedString *)luaI_malloc(sizeof(TaggedString)+strlen(str));
+  strcpy(ts->str, str);
+  ts->marked = 0;
+  ts->hash = h;
+  ts->varindex = ts->constindex = NOT_USED;
+  return ts;
 }
 
 TaggedString *lua_createstring (char *str) 
 {
-  StringNode *newString;
-  if (str == NULL) return NULL;
-  lua_pack();
-  newString = (StringNode *)luaI_malloc(sizeof(StringNode)+strlen(str));
-  newString->ts.marked = 0;
-  newString->ts.hash = 0;
-  strcpy(newString->ts.str, str);
-  newString->next = string_root;
-  string_root = newString;
-  return &(newString->ts);
-}
-
-
-TreeNode *lua_constcreate (char *str) 
-{
- return tree_create(&constant_root, str);
+  return insert(str, &string_root[(unsigned)str[0]%NUM_HASHS]);
 }
 
 
@@ -80,62 +118,28 @@ TreeNode *lua_constcreate (char *str)
 */
 Long lua_strcollector (void)
 {
-  StringNode *curr = string_root, *prev = NULL;
   Long counter = 0;
-  while (curr)
+  int i;
+  for (i=0; i<NUM_HASHS; i++)
   {
-    StringNode *next = curr->next;
-    if (!curr->ts.marked)
+    stringtable *tb = &string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++)
     {
-      if (prev == NULL) string_root = next;
-      else prev->next = next;
-      luaI_free(curr);
-      ++counter;
+      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++;
+        }
+      }
     }
-    else
-    {
-      curr->ts.marked = 0;
-      prev = curr;
-    }
-    curr = next;
   }
   return counter;
 }
 
-/*
-** Return next variable.
-*/
-static TreeNode *tree_next (TreeNode *node, char *str)
-{
- if (node == NULL) return NULL;
- else if (str == NULL) return node;
- else
- {
-  int c = lua_strcmp(str, node->ts.str);
-  if (c == 0)
-   return node->left != NULL ? node->left : node->right;
-  else if (c < 0)
-  {
-   TreeNode *result = tree_next(node->left, str);
-   return result != NULL ? result : node->right;
-  }
-  else
-   return tree_next(node->right, str);
- }
-}
-
-TreeNode *lua_varnext (char *n)
-{
-  TreeNode *result;
-  char *name = n;
-  while (1)
-  { /* repeat until a valid (non nil) variable */
-    result = tree_next(constant_root, name);
-    if (result == NULL) return NULL;
-    if (result->varindex != NOT_USED &&
-        s_tag(result->varindex) != LUA_T_NIL)
-      return result;
-    name = result->ts.str;
-  }
-}
-

tree.h

@@ -1,7 +1,7 @@
 /*
 ** tree.h
 ** TecCGraf - PUC-Rio
-** $Id: tree.h,v 1.8 1994/12/20 21:20:36 roberto Exp roberto $
+** $Id: tree.h,v 1.13 1996/02/14 13:35:51 roberto Exp roberto $
 */
 
 #ifndef tree_h
@@ -14,24 +14,15 @@
 
 typedef struct TaggedString
 {
+  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 */
-  char marked;   /* for garbage collection */
+  int marked;   /* for garbage collection; never collect (nor change) if > 1 */
   char str[1];   /* \0 byte already reserved */
 } TaggedString;
  
-typedef struct TreeNode
-{
- struct TreeNode *right;
- struct TreeNode *left;
- unsigned short varindex;  /* != NOT_USED  if this is a symbol */
- unsigned short constindex;  /* != NOT_USED  if this is a constant */
- TaggedString ts;
-} TreeNode;
-
 
 TaggedString *lua_createstring (char *str);
-TreeNode *lua_constcreate  (char *str);
 Long lua_strcollector (void);
-TreeNode *lua_varnext      (char *n);
 
 #endif

types.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: types.h,v 1.2 1994/12/27 20:41:47 celes Exp roberto $
+** $Id: types.h,v 1.3 1995/02/06 19:32:43 roberto Exp roberto $
 */
 
 #ifndef types_h
@@ -12,8 +12,6 @@
 #define real float
 #endif
 
-typedef int Bool;  /* boolean values */
-
 #define Byte lua_Byte	/* some systems have Byte as a predefined type */
 typedef unsigned char  Byte;  /* unsigned 8 bits */
 

ugly.h

@@ -1,36 +0,0 @@
-/*
-** ugly.h
-** TecCGraf - PUC-Rio
-** $Id: $
-*/
-
-#ifndef ugly_h
-#define ugly_h
-
-/* This enum must have the same order of the array 'reserved' in lex.c */
-
-enum {
- U_and=128,
- U_do,
- U_else,
- U_elseif,
- U_end,
- U_function,
- U_if,
- U_local,
- U_nil,
- U_not,
- U_or,
- U_repeat,
- U_return,
- U_then,
- U_until,
- U_while,
- U_eq = '='+128,
- U_le = '<'+128,
- U_ge = '>'+128,
- U_ne = '~'+128,
- U_sc = '.'+128
-};
-
-#endif

undump.c

@@ -0,0 +1,333 @@
+/*
+** undump.c
+** load bytecodes from files
+*/
+
+char* rcs_undump="$Id: undump.c,v 1.20 1996/11/16 20:14:23 lhf Exp lhf $";
+
+#include <stdio.h>
+#include <string.h>
+#include "opcode.h"
+#include "mem.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 warn(char* s)			/* TODO: remove */
+{
+#if 0
+ fprintf(stderr,"undump: %s\n",s);
+#endif
+}
+
+static void FixCode(Byte* code, Byte* end)	/* swap words */
+{
+ Byte* p;
+ for (p=code; p!=end;)
+ {
+	OpCode op=(OpCode)*p;
+	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:
+		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:
+		lua_error("corrupt binary file");
+		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;				/* TODO: need union? */
+  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("bad signature");
+}
+
+static void LoadHeader(FILE* D)			/* TODO: error handling */
+{
+ 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)
+   lua_error("cannot load binary file created on machine with sizeof(Word)!=2");
+  if (oldsizeofF!=4)
+   lua_error("cannot load binary file created on machine with sizeof(float)!=4. not an IEEE machine?");
+  if (oldsizeofP!=sizeof(TFunc*))		/* TODO: pack */
+   lua_error("cannot load binary file: different pointer sizes");
+ }
+ fread(&w,sizeof(w),1,D);			/* test word */
+ if (w!=tw)
+ {
+  swapword=1;
+  warn("different byte order");
+ }
+ fread(&f,sizeof(f),1,D);			/* test float */
+ if (f!=tf)
+ {
+  Byte* p=(Byte*)&f;				/* TODO: need union? */
+  Byte t;
+  swapfloat=1;
+  t=p[0]; p[0]=p[3]; p[3]=t;
+  t=p[1]; p[1]=p[2]; p[2]=t;
+  if (f!=tf)					/* TODO: try another perm? */
+   lua_error("different float representation");
+  else
+   warn("different byte order in floats");
+ }
+}
+
+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.2 1996/03/11 21:59:41 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		/* 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 */