unused "#include".

so that it collects half of the total objects when it is called.

fallback.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.16 1995/10/17 11:52:38 roberto Exp roberto $";
+char *rcs_fallback="$Id: fallback.c,v 1.24 1996/04/22 18:00:37 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -12,6 +12,7 @@ char *rcs_fallback="$Id: fallback.c,v 1.16 1995/10/17 11:52:38 roberto Exp rober
 #include "fallback.h"
 #include "opcode.h"
 #include "lua.h"
+#include "table.h"
 
 
 static void errorFB (void);
@@ -36,8 +37,10 @@ struct FB  luaI_fallBacks[] = {
 {"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}
+{"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,7 +50,7 @@ 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)))
+  if (name == NULL || !lua_isfunction(func))
     lua_error("incorrect argument to function `setfallback'");
   for (i=0; i<N_FB; i++)
   {
@@ -110,66 +113,77 @@ static void funcFB (void)
 
 
 /*
-** 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;
-}
-
-
-void lua_unlock (int ref)
-{
-  tag(&lockArray[ref]) = LUA_T_NIL;
-}
-
-
-Object *luaI_getlocked (int ref)
-{
-  return &lockArray[ref];
+    return NULL;
 }
 
 
 void luaI_travlock (int (*fn)(Object *))
 {
-  Word i;
-  for (i=0; i<lockSize; i++)
-    fn(&lockArray[i]);
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == LOCK)
+      fn(&refArray[i].o);
 }
 
 
+void luaI_invalidaterefs (void)
+{
+  int i;
+  for (i=0; i<refSize; i++)
+    if (refArray[i].status == HOLD && !luaI_ismarked(&refArray[i].o))
+      refArray[i].status = COLLECTED;
+}
+
 char *luaI_travfallbacks (int (*fn)(Object *))
 {
-  Word i;
+  int i;
   for (i=0; i<N_FB; i++)
     if (fn(&luaI_fallBacks[i].function))
       return luaI_fallBacks[i].kind;

fallback.h

@@ -1,10 +1,11 @@
 /*
-** $Id: fallback.h,v 1.9 1995/10/09 13:14:29 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 {
@@ -23,11 +24,13 @@ 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);
+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

@@ -1,4 +1,4 @@
-#include <stdio.h>
+#include <stdlib.h>
 
 #include "luadebug.h"
 #include "table.h"
@@ -6,8 +6,26 @@
 #include "func.h"
 #include "opcode.h"
 
-static TFunc *function_root = NULL;
 
+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
@@ -24,9 +42,10 @@ void luaI_insertfunction (TFunc *f)
 /*
 ** Free function
 */
-static void freefunc (TFunc *f)
+void luaI_freefunc (TFunc *f)
 {
   luaI_free (f->code);
+  luaI_free (f->locvars);
   luaI_free (f);
 }
 
@@ -48,7 +67,7 @@ Long luaI_funccollector (void)
         function_root = next;
       else
         prev->next = next;
-      freefunc (curr);
+      luaI_freefunc (curr);
       ++counter;
     }
     else
@@ -77,3 +96,61 @@ void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
   }
 }
 
+/*
+** 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

@@ -1,24 +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;
+
 
 /*
-** Header para funcoes.
+** Function Headers
 */
 typedef struct TFunc
 {
   struct TFunc	*next;
-  char		marked;
+  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,9 +3,8 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.25 1995/05/02 18:43:03 roberto Exp $";
+char *rcs_hash="$Id: hash.c,v 2.29 1996/02/14 18:25:04 roberto Exp roberto $";
 
-#include <string.h>
 
 #include "mem.h"
 #include "opcode.h"
@@ -13,7 +12,6 @@ char *rcs_hash="$Id: hash.c,v 2.25 1995/05/02 18:43:03 roberto Exp $";
 #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)
@@ -24,22 +22,22 @@ char *rcs_hash="$Id: hash.c,v 2.25 1995/05/02 18:43:03 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];
@@ -48,7 +46,7 @@ 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))
  {
@@ -56,19 +54,9 @@ static Word hashindex (Hash *t, Object *ref)		/* hash function */
    lua_error ("unexpected type to index table");
    return -1;  /* UNREACHEABLE */
   case LUA_T_NUMBER:
-   return (((Word)nvalue(ref))%nhash(t));
+   return (((int)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 */
-  }
+   return (int)((tsvalue(ref)->hash)%nhash(t));  /* make it a valid index */
   case LUA_T_FUNCTION:
    return (((IntPoint)ref->value.tf)%nhash(t));
   case LUA_T_CFUNCTION:
@@ -80,14 +68,14 @@ static Word hashindex (Hash *t, Object *ref)		/* hash function */
  }
 }
 
-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 t1->value.tf == t2->value.tf;
     case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
@@ -95,9 +83,9 @@ Bool lua_equalObj (Object *t1, Object *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))))
@@ -111,9 +99,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;
@@ -123,10 +111,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;
@@ -151,7 +139,7 @@ void lua_hashmark (Hash *h)
 {
  if (markarray(h) == 0)
  {
-  Word i;
+  int i;
   markarray(h) = 1;
   for (i=0; i<nhash(h); i++)
   {
@@ -218,7 +206,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();
@@ -234,10 +222,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++)
  {
@@ -254,7 +242,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;
 }
@@ -266,7 +254,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);
@@ -292,7 +280,7 @@ 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))
  {
@@ -329,7 +317,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,31 +5,21 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.24 1995/10/23 13:54:11 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.35 1996/03/19 16:50:24 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"
-
-
-#ifndef MAXFUNCSTACK
-#define MAXFUNCSTACK 100
-#endif
-
-#define MAXMESSAGE MAXFUNCSTACK*80
+#include "mem.h"
 
 
 /* Exported variables */
 Word lua_linenumber;
-Bool lua_debug = 0;
 char *lua_parsedfile;
 
 
@@ -54,9 +44,9 @@ 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_setinput (fileinput);
  if (fn == NULL)
@@ -67,14 +57,10 @@ char *lua_openfile (char *fn)
  else
    fp = fopen (fn, "r");
  if (fp == NULL)
- {
-   static char buff[255];
-   sprintf(buff, "unable to open file `%.200s'", fn);
-   return buff;
- }
+   return NULL;
  lua_linenumber = 1;
- lua_parsedfile = lua_constcreate(fn)->ts.str;
- return NULL;
+ lua_parsedfile = luaI_createfixedstring(fn)->str;
+ return fp;
 }
 
 /*
@@ -97,7 +83,7 @@ void lua_openstring (char *s)
  lua_setinput (stringinput);
  st = s;
  lua_linenumber = 1;
- lua_parsedfile = lua_constcreate("(string)")->ts.str;
+ lua_parsedfile = luaI_createfixedstring("(string)")->str;
 }
 
 /*
@@ -126,33 +112,57 @@ void lua_internaldostring (void)
 void lua_internaldofile (void)
 {
  lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
+ 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))
   lua_pushnumber(1);
  else
   lua_pushnil();
 }
  
-/*
-** 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",(luaI_Address(obj))->value.tf);
-  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.
@@ -196,16 +206,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();
-  }
+    lua_pushnumber(lua_getnumber(o));
   else
     lua_pushnil();
 }
@@ -218,3 +219,28 @@ void luaI_error (void)
   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);
+  if (!lua_isstring(name))
+    lua_error("incorrect argument to function `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);
+  if (!lua_isstring(name))
+    lua_error("incorrect argument to function `getglobal'");
+  lua_pushobject(lua_getglobal(lua_getstring(name)));
+}

inout.h

@@ -1,5 +1,5 @@
 /*
-** $Id: inout.h,v 1.9 1995/05/16 17:23:58 roberto Exp roberto $
+** $Id: inout.h,v 1.14 1996/03/15 13:13:13 roberto Exp roberto $
 */
 
 
@@ -7,23 +7,27 @@
 #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);
 void lua_openstring   (char *s);
 void lua_closestring  (void);
 
 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);
 
 #endif

iolib.c

@@ -3,15 +3,14 @@
 ** Input/output library to LUA
 */
 
-char *rcs_iolib="$Id: iolib.c,v 1.28 1995/11/10 17:55:48 roberto Exp roberto $";
+char *rcs_iolib="$Id: iolib.c,v 1.43 1996/04/30 21:13:55 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"
@@ -29,6 +28,14 @@ int pclose();
 #endif
 
 
+static void pushresult (int i)
+{
+  if (i)
+    lua_pushnumber (1);
+  else
+   lua_pushnil();
+}
+
 static void closeread (void)
 {
   if (in != stdin)
@@ -116,15 +123,12 @@ static void io_writeto (void)
 ** LUA interface:
 **			status = appendto (filename)
 ** where:
-**			status = 2 -> success (already exist)
-**			status = 1 -> success (new file)
+**			status = 1 -> success
 **			status = nil -> error
 */
 static void io_appendto (void)
 {
  char *s = lua_check_string(1, "appendto");
- struct stat st;
- int r = (stat(s, &st) == -1) ? 1 : 2;
  FILE *fp = fopen (s, "a");
  if (fp == NULL)
   lua_pushnil();
@@ -132,7 +136,7 @@ static void io_appendto (void)
  {
   if (out != stdout) fclose (out);
   out = fp;
-  lua_pushnumber (r);
+  lua_pushnumber(1);
  }
 }
 
@@ -142,15 +146,14 @@ static char getformat (char *f, int *just, int *m, int *n)
   int t;
   switch (*f++)
   {
+    case 'q': case 'Q':
     case 's': case 'S':
-      t = 's';
+    case 'i': case 'I':
+      t = tolower(*(f-1));
       break;
     case 'f': case 'F': case 'g': case 'G': case 'e': case 'E':
       t = 'f';
       break;
-    case 'i': case 'I':
-      t = 'i';
-      break;
     default:
       t = 0;  /* to avoid compiler warnings */
       lua_arg_error("read/write (format)");
@@ -177,32 +180,6 @@ static char getformat (char *f, int *just, int *m, int *n)
 }
 
 
-static char *add_char (int c)
-{
-  static char *buff = NULL;
-  static int max = 0;
-  static int n = 0;
-  if (n >= max)
-  {
-    if (max == 0)
-    {
-      max = 100;
-      buff = (char *)malloc(max);
-    }
-    else
-    {
-      max *= 2;
-      buff = (char *)realloc(buff, max);
-    }
-    if (buff == NULL)
-      lua_error("memory overflow");
-  }
-  buff[n++] = c;
-  if (c == 0)
-    n = 0;  /* prepare for next string */
-  return buff;
-}
-
 /*
 ** Read a variable. On error put nil on stack.
 ** LUA interface:
@@ -222,23 +199,23 @@ static int read_until_char (int del)
 {
   int c;
   while((c = fgetc(in)) != EOF && c != del)
-    add_char(c);
+    luaI_addchar(c);
   return c;
 }
 
-static int read_until_blank (void)
+static void read_until_blank (void)
 {
   int c;
   while((c = fgetc(in)) != EOF && !isspace(c))
-    add_char(c);
-  return c;
+    luaI_addchar(c);
+  if (c != EOF) ungetc(c,in);
 }
 
 static void read_m (int m)
 {
   int c;
   while (m-- && (c = fgetc(in)) != EOF)
-    add_char(c);
+    luaI_addchar(c);
 }
 
 
@@ -256,21 +233,18 @@ static void read_free (void)
   { /* string */
     c = read_until_char(c);
     if (c == EOF)
-    {
-      add_char(0);  /* to be ready for next time */
       lua_pushnil();
-    }
     else
-      lua_pushstring(add_char(0));
+      lua_pushstring(luaI_addchar(0));
   }
   else
   {
     double d;
     char dummy;
     char *s;
-    add_char(c);
+    luaI_addchar(c);
     read_until_blank();
-    s = add_char(0);
+    s = luaI_addchar(0);
     if (sscanf(s, "%lf %c", &d, &dummy) == 1)
       lua_pushnumber(d);
     else
@@ -281,6 +255,7 @@ static void read_free (void)
 static void io_read (void)
 {
   lua_Object o = lua_getparam (1);
+  luaI_addchar(0);  /* initialize buffer */
   if (o == LUA_NOOBJECT) 	/* free format */
     read_free();
   else				/* formatted */
@@ -289,12 +264,19 @@ static void io_read (void)
     switch (getformat(lua_check_string(1, "read"), &dummy1, &m, &dummy2))
     {
       case 's':
+      {
+        char *s;
         if (m < 0)
           read_until_blank();
         else
           read_m(m);
-        lua_pushstring(add_char(0));
+        s = luaI_addchar(0);
+        if ((m >= 0 && strlen(s) == m) || (m < 0 && strlen(s) > 0))
+          lua_pushstring(s);
+        else
+          lua_pushnil();
         break;
+      }
 
       case 'i':  /* can read as float, since it makes no difference to Lua */
       case 'f':
@@ -306,7 +288,7 @@ static void io_read (void)
         else
         {
           read_m(m);
-          result = sscanf(add_char(0), "%lf", &d);
+          result = sscanf(luaI_addchar(0), "%lf", &d);
         }
         if (result == 1)
           lua_pushnumber(d);
@@ -314,6 +296,8 @@ static void io_read (void)
           lua_pushnil();
         break;
       }
+      default:
+        lua_arg_error("read (format)");
     }
   }
 }
@@ -324,10 +308,16 @@ static void io_read (void)
 */
 static void io_readuntil (void)
 {
- int del = *lua_check_string(1, "readuntil");
- int c = read_until_char(del);
+ int del, c;
+ lua_Object p = lua_getparam(1);
+ luaI_addchar(0);  /* initialize buffer */
+ if (p == LUA_NOOBJECT || lua_isnil(p))
+   del = EOF;
+ else
+  del = *lua_check_string(1, "readuntil");
+ c = read_until_char(del);
  if (c != EOF) ungetc(c,in);
- lua_pushstring(add_char(0));
+ lua_pushstring(luaI_addchar(0));
 }
 
 
@@ -384,6 +374,13 @@ static int write_string (char *s, int just, int m)
   return status;
 }
 
+static int write_quoted (int just, int m)
+{
+  luaI_addchar(0);
+  luaI_addquoted(lua_check_string(1, "write"));
+  return write_string(luaI_addchar(0), just, m);
+}
+
 static int write_float (int just, int m, int n)
 {
   char buffer[100];
@@ -420,15 +417,16 @@ static void io_write (void)
   if (lua_getparam (2) == LUA_NOOBJECT)   /* free format */
   {
     lua_Object o1 = lua_getparam(1);
-    if (lua_isnumber(o1))
+    int t = lua_type(o1);
+    if (t == LUA_T_NUMBER)
       status = fprintf (out, "%g", lua_getnumber(o1)) >= 0;
-    else if (lua_isstring(o1))
+    else if (t == LUA_T_STRING)
       status = fprintf (out, "%s", lua_getstring(o1)) >= 0;
   }
   else					/* formated */
   {
     int just, m, n;
-    switch (getformat (lua_check_string(2, "write"), &just, &m, &n))
+    switch (getformat(lua_check_string(2, "write"), &just, &m, &n))
     {
       case 's':
       {
@@ -439,6 +437,9 @@ static void io_write (void)
           status = 0;
         break;
       }
+      case 'q':
+        status = write_quoted(just, m);
+        break;
       case 'f':
         status = write_float(just, m, n);
         break;
@@ -467,59 +468,54 @@ static void io_execute (void)
 */
 static void io_remove  (void)
 {
- if (remove(lua_check_string(1, "remove")) == 0)
-   lua_pushnumber (1);
- else
-   lua_pushnil();
+  pushresult(remove(lua_check_string(1, "remove")) == 0);
+}
+
+static void io_rename (void)
+{
+  char *f1 = lua_check_string(1, "rename");
+  char *f2 = lua_check_string(2, "rename");
+  pushresult(rename(f1, f2) == 0);
+}
+
+static void io_tmpname (void)
+{
+  lua_pushstring(tmpnam(NULL));
+}
+
+static void io_errorno (void)
+{
+/*  lua_pushstring(strerror(errno));*/
 }
 
 
 /*
-** To get a environment variables
+** To get a environment variable
 */
 static void io_getenv (void)
 {
  char *env = getenv(lua_check_string(1, "getenv"));
- if (env == NULL) lua_pushnil();
- else             lua_pushstring(env); 
+ lua_pushstring(env);  /* 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
+** Return user formatted time stamp
 */
 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);
-}
- 
-/*
-** Beep
-*/
-static void io_beep (void)
-{
- printf("\a");
+ struct tm *tm;
+ char *s;
+ char b[BUFSIZ];
+ if (lua_getparam(1) == LUA_NOOBJECT)
+  s = "%c";
+ else
+  s = lua_check_string(1, "date");
+ time(&t); tm = localtime(&t);
+ if (strftime(b,sizeof(b),s,tm))
+  lua_pushstring(b);
+ else
+  lua_error("invalid `date' format");
 }
  
 /*
@@ -528,9 +524,8 @@ static void io_beep (void)
 static void io_exit (void)
 {
  lua_Object o = lua_getparam(1);
- if (lua_isstring(o))
-  fprintf(stderr, "%s\n", lua_getstring(o));
- exit(1);
+ int code = lua_isnumber(o) ? (int)lua_getnumber(o) : 1;
+ exit(code);
 }
 
 /*
@@ -543,14 +538,14 @@ static void io_debug (void)
   {
     char buffer[250];
     fprintf(stderr, "lua_debug> ");
-    if (gets(buffer) == 0) return;
+    if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
     if (strcmp(buffer, "cont") == 0) return;
     lua_dostring(buffer);
   }
 }
 
 
-void lua_printstack (FILE *f)
+static void lua_printstack (FILE *f)
 {
   int level = 0;
   lua_Object func;
@@ -560,13 +555,13 @@ void lua_printstack (FILE *f)
     char *name;
     int currentline;
     fprintf(f, "\t");
-    switch (*getobjname(func, &name))
+    switch (*lua_getobjname(func, &name))
     {
       case 'g':
         fprintf(f, "function %s", name);
         break;
       case 'f':
-        fprintf(f, "fallback %s", name);
+        fprintf(f, "`%s' fallback", name);
         break;
       default:
       {
@@ -582,7 +577,7 @@ void lua_printstack (FILE *f)
       }
     }
     if ((currentline = lua_currentline(func)) > 0)
-      fprintf(f, "  at line %d", currentline);
+      fprintf(f, " at line %d", currentline);
     fprintf(f, "\n");
   }
 }
@@ -597,26 +592,27 @@ static void errorfb (void)
 }
 
 
-/*
-** Open io library
-*/
+static struct lua_reg iolib[] = {
+{"readfrom", io_readfrom},
+{"writeto",  io_writeto},
+{"appendto", io_appendto},
+{"read",     io_read},
+{"readuntil",io_readuntil},
+{"write",    io_write},
+{"execute",  io_execute},
+{"remove",   io_remove},
+{"rename",   io_rename},
+{"tmpname",   io_tmpname},
+{"ioerror",   io_errorno},
+{"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_register ("print_stack", errorfb);
- lua_setfallback("error", errorfb);
+  luaI_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
+  lua_setfallback("error", errorfb);
 }
-

lex.c

@@ -1,23 +1,19 @@
-char *rcs_lex = "$Id: lex.c,v 2.20 1995/10/25 13:05:51 roberto Exp roberto $";
+char *rcs_lex = "$Id: lex.c,v 2.31 1996/03/19 16:50:24 roberto Exp roberto $";
  
 
 #include <ctype.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 MINBUFF 260
 
-#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
-
 #define next() { current = input(); }
 #define save(x) { *yytextLast++ = (x); }
 #define save_and_next()  { save(current); next(); }
@@ -47,7 +43,6 @@ char *lua_lasttext (void)
 }
 
 
-/* The reserved words must be listed in lexicographic order */
 static struct
   {
     char *name;
@@ -74,30 +69,21 @@ 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;
 }
 
 
 static void growtext (void)
 {
   int size = yytextLast - yytext;
-  textsize *= 2;
-  yytext = growvector(yytext, textsize, char);
+  textsize = growvector(&yytext, textsize, char, lexEM, MAX_WORD);
   yytextLast = yytext + size;
 }
 
@@ -144,9 +130,9 @@ static int read_long_string (void)
 }
 
 
-int yylex (void)
+int luaY_lex (void)
 {
-  float a;
+  double a;
   static int linelasttoken = 0;
   if (lua_debug)
     luaI_codedebugline(linelasttoken);
@@ -154,9 +140,6 @@ int yylex (void)
   while (1)
   {
     yytextLast = yytext;
-#if 0
-    fprintf(stderr,"'%c' %d\n",current,current);
-#endif
     switch (current)
     {
       case EOF:
@@ -174,22 +157,21 @@ int yylex (void)
 	while (isalnum(current) || current == '_')
           save_and_next();
         *yytextLast = 0;
-	if (lua_strcmp(yytext, "debug") == 0)
+	if (strcmp(yytext, "debug") == 0)
 	{
-	  yylval.vInt = 1;
+	  luaY_lval.vInt = 1;
 	  return DEBUG;
         }
-	else if (lua_strcmp(yytext, "nodebug") == 0)
+	else if (strcmp(yytext, "nodebug") == 0)
 	{
-	  yylval.vInt = 0;
+	  luaY_lval.vInt = 0;
 	  return DEBUG;
         }
 	return WRONGTOKEN;
 
       case '-':
         save_and_next();
-        if (current != '-') return '-';  /* else goes through */
-      case '#':
+        if (current != '-') return '-';
         do { next(); } while (current != '\n' && current != 0);
         continue;
 
@@ -203,7 +185,7 @@ int yylex (void)
             return WRONGTOKEN;
           save_and_next();  /* pass the second ']' */
           *(yytextLast-2) = 0;  /* erases ']]' */
-          yylval.vWord = luaI_findconstantbyname(yytext+2);
+          luaY_lval.vWord = luaI_findconstantbyname(yytext+2);
           return STRING;
         }
 
@@ -254,6 +236,7 @@ int yylex (void)
                 case 'n': save('\n'); next(); break;
                 case 't': save('\t'); next(); break;
                 case 'r': save('\r'); next(); break;
+                case '\n': lua_linenumber++;  /* goes through */
                 default : save(current); next(); break;
               }
               break;
@@ -263,7 +246,7 @@ int yylex (void)
         }
         next();  /* skip the delimiter */
         *yytextLast = 0;
-        yylval.vWord = luaI_findconstantbyname(yytext);
+        luaY_lval.vWord = luaI_findconstantbyname(yytext);
         return STRING;
       }
 
@@ -281,12 +264,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);
+        ts = lua_createstring(yytext);
+        if (ts->marked > 2)
+          return ts->marked;  /* reserved word */
+        luaY_lval.pTStr = ts;
+        ts->marked = 2;  /* avoid GC */
         return NAME;
       }
 
@@ -305,48 +290,32 @@ 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));
+        do { a=10.0*a+(current-'0'); save_and_next(); } while (isdigit(current));
         if (current == '.') save_and_next();
 fraction:
-	{ float da=0.1;
+	{ double da=0.1;
 	  while (isdigit(current))
 	  {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));
+            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;
           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 */
       {
         save_and_next();

lex.h

@@ -0,0 +1,19 @@
+/*
+** lex.h
+** TecCGraf - PUC-Rio
+** $Id: lex.h,v 1.1 1996/02/13 17:30:39 roberto Exp roberto $
+*/
+
+#ifndef lex_h
+#define lex_h
+
+
+typedef int  (*Input) (void);
+
+void    lua_setinput   (Input fn);
+char   *lua_lasttext   (void);
+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.6 1995/10/23 13:54:11 roberto Exp roberto $";
+char *rcs_lua="$Id: lua.c,v 1.9 1996/04/23 12:43:07 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -14,11 +14,15 @@ char *rcs_lua="$Id: lua.c,v 1.6 1995/10/23 13:54:11 roberto Exp roberto $";
 static int lua_argc;
 static char **lua_argv;
 
+#ifdef POSIX
 /*
 ** although this function is POSIX, there is no standard header file that
 ** defines it
 */
 int isatty (int fd);
+#else
+#define isatty(x)       (x==0)  /* assume stdin is a tty */
+#endif
 
 /*
 %F Allow Lua code to access argv strings.
@@ -41,10 +45,10 @@ static void lua_getargv (void)
 
 static void manual_input (void)
 {
-  if (isatty(fileno(stdin)))
+  if (isatty(0))
   {
    char buffer[250];
-   while (gets(buffer) != 0)
+   while (fgets(buffer, sizeof(buffer), stdin) != 0)
      lua_dostring(buffer);
   }
   else
@@ -83,7 +87,11 @@ int main (int argc, char *argv[])
     printf("%s  %s\n(written by %s)\n\n",
             LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
    else
+   {
     result = lua_dofile (argv[i]);
+    if (result)
+      fprintf(stderr, "lua: error trying to run file %s\n", argv[i]);
+   }
   }
  }
  return result;

lua.h

@@ -2,14 +2,14 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lua.h,v 3.20 1995/10/31 16:41:53 roberto Exp roberto $
+** $Id: lua.h,v 3.27 1996/04/25 14:10:00 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
-#define LUA_VERSION	"Lua 2.2"
+#define LUA_VERSION	"Lua 2.4"
 #define LUA_COPYRIGHT	"Copyright (C) 1994, 1995 TeCGraf"
 #define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
 
@@ -52,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);
@@ -60,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);
@@ -73,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())

lua.stx

@@ -1,12 +1,13 @@
 %{
 
-char *rcs_luastx = "$Id: lua.stx,v 3.24 1995/10/26 14:21:56 roberto Exp roberto $";
+char *rcs_luastx = "$Id: lua.stx,v 3.35 1996/03/08 12:02:37 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <stdlib.h>
-#include <string.h>
 
+#include "luadebug.h"
 #include "mem.h"
+#include "lex.h"
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
@@ -30,7 +31,7 @@ int yyparse (void);
 #endif
 static int   maxcode;
 static int   maxmain;
-static Long   maxcurr;  /* to allow maxcurr *= 2 without overflow */
+static int   maxcurr;
 static Byte  *funcCode = NULL;
 static Byte **initcode;
 static Byte  *basepc;
@@ -44,35 +45,32 @@ static Long    varbuffer[MAXVAR];    /* variables in an assignment list;
 static int     nvarbuffer=0;	     /* number of variables at a list */
 
 #define MAXLOCALS 32
-static Word    localvar[MAXLOCALS];  /* store local variable names */
+static TaggedString *localvar[MAXLOCALS];  /* store local variable names */
 static int     nlocalvar=0;	     /* number of local variables */
 
 #define MAXFIELDS FIELDS_PER_FLUSH*2
 static Word    fields[MAXFIELDS];     /* fieldnames to be flushed */
 static int     nfields=0;
 
+int lua_debug = 0;
 
 /* Internal functions */
 
 static void yyerror (char *s)
 {
- static char msg[256];
- sprintf (msg,"%s near \"%s\" at line %d in file `%s'",
-          s, lua_lasttext (), lua_linenumber, lua_parsedfile);
+ char msg[256];
+ char *token = lua_lasttext();
+ if (token[0] == 0)
+   token = "<eof>";
+ sprintf (msg,"%s; last token read: \"%s\" at line %d in file `%s'",
+          s, token, lua_linenumber, lua_parsedfile);
  lua_error (msg);
 }
 
 static void code_byte (Byte c)
 {
  if (pc>maxcurr-2)  /* 1 byte free to code HALT of main code */
- {
-  if (maxcurr >= MAX_INT)
-    lua_error("code size overflow");
-  maxcurr *= 2;
-  if (maxcurr >= MAX_INT)
-    maxcurr = MAX_INT;
-  basepc = growvector(basepc, maxcurr, Byte);
- }
+   maxcurr = growvector(&basepc, maxcurr, Byte, codeEM, MAX_INT);
  basepc[pc++] = c;
 }
 
@@ -104,10 +102,12 @@ static void code_code (TFunc *tf)
  code_byte(code.m.c4);
 }
 
-static void code_word_at (Byte *p, Word n)
+static void code_word_at (Byte *p, int n)
 {
  CodeWord code;
- code.w = n;
+ if ((Word)n != n)
+   yyerror("block too big");
+ code.w = (Word)n;
  *p++ = code.m.c1;
  *p++ = code.m.c2;
 }
@@ -117,7 +117,7 @@ static void push_field (Word name)
   if (nfields < MAXFIELDS)
     fields[nfields++] = name;
   else
-   lua_error ("too many fields in nested constructors");
+   yyerror ("too many fields in nested constructors");
 }
 
 static void flush_record (int n)
@@ -142,24 +142,24 @@ static void flush_list (int m, int n)
     code_byte(m);
   }
   else
-   lua_error ("list constructor too long");
+   yyerror ("list constructor too long");
   code_byte(n);
 }
 
-static void add_localvar (Word name)
-{
- if (nlocalvar < MAXLOCALS)
-  localvar[nlocalvar++] = name;
- else
-  lua_error ("too many local variables");
-}
-
-static void store_localvar (Word name, int n)
+static void store_localvar (TaggedString *name, int n)
 {
  if (nlocalvar+n < MAXLOCALS)
   localvar[nlocalvar+n] = name;
  else
-  lua_error ("too many local variables");
+  yyerror ("too many local variables");
+ if (lua_debug)
+   luaI_registerlocalvar(name, lua_linenumber);
+}
+
+static void add_localvar (TaggedString *name)
+{
+  store_localvar(name, 0);
+  nlocalvar++;
 }
 
 static void add_varbuffer (Long var)
@@ -167,7 +167,7 @@ static void add_varbuffer (Long var)
  if (nvarbuffer < MAXVAR)
   varbuffer[nvarbuffer++] = var;
  else
-  lua_error ("variable buffer overflow");
+  yyerror ("variable buffer overflow");
 }
 
 static void code_number (float f)
@@ -197,7 +197,7 @@ static void code_number (float f)
 /*
 ** Search a local name and if find return its index. If do not find return -1
 */
-static int lua_localname (Word n)
+static int lua_localname (TaggedString *n)
 {
  int i;
  for (i=nlocalvar-1; i >= 0; i--)
@@ -388,7 +388,6 @@ static void codeIf (Long thenAdd, Long elseAdd)
 */
 void lua_parse (TFunc *tf)
 {
- lua_debug = 0;
  initcode = &(tf->code);
  *initcode = newvector(CODE_BLOCK, Byte);
  maincode = 0; 
@@ -416,7 +415,7 @@ void lua_parse (TFunc *tf)
  Word  vWord;
  Long  vLong;
  TFunc *pFunc;
- TreeNode *pNode;
+ TaggedString *pTStr;
 }
 
 %start functionlist
@@ -429,7 +428,7 @@ void lua_parse (TFunc *tf)
 %token FUNCTION
 %token <vFloat> NUMBER
 %token <vWord>  STRING
-%token <pNode>  NAME 
+%token <pTStr>  NAME 
 %token <vInt>   DEBUG
 
 %type <vLong> PrepJump
@@ -481,7 +480,7 @@ funcname	: var { $$ =$1; init_func(); }
 	  code_word(luaI_findconstant($3));
 	  $$ = 0;  /* indexed variable */
 	  init_func();
-	  add_localvar(luaI_findsymbolbyname("self"));
+	  add_localvar(luaI_createfixedstring("self"));
 	}
 		;
 
@@ -489,11 +488,14 @@ body :  '(' parlist ')' block END
 	{
           codereturn();
 	  $$ = new(TFunc);
+          luaI_initTFunc($$);
 	  $$->size = pc;
 	  $$->code = newvector(pc, Byte);
 	  $$->fileName = lua_parsedfile;
 	  $$->lineDefined = $2;
 	  memcpy($$->code, basepc, pc*sizeof(Byte));
+          if (lua_debug)
+            luaI_closelocalvars($$);
 	  /* save func values */
 	  funcCode = basepc; maxcode=maxcurr;
 #if LISTING
@@ -554,7 +556,11 @@ block    : {$<vInt>$ = nlocalvar;} statlist ret
          {
 	  if (nlocalvar != $<vInt>1)
 	  {
-           nlocalvar = $<vInt>1;
+           if (lua_debug)
+             for (; nlocalvar > $<vInt>1; nlocalvar--)
+               luaI_unregisterlocalvar(lua_linenumber);
+           else
+             nlocalvar = $<vInt>1;
 	   lua_codeadjust (0);
 	  }
          }
@@ -672,14 +678,8 @@ parlist  :	/* empty */ { lua_codeadjust(0); $$ = lua_linenumber; }
 	  |	parlist1    { lua_codeadjust(0); $$ = lua_linenumber; }
 	  ;
 		
-parlist1 :	NAME		  
-		{
-		 add_localvar(luaI_findsymbol($1));
-		}
-	  |	parlist1 ',' NAME 
-		{
-		 add_localvar(luaI_findsymbol($3));
-		}
+parlist1 :	NAME		  { add_localvar($1); }
+	  |	parlist1 ',' NAME { add_localvar($3); }
 	  ;
 		
 fieldlist  : lfieldlist
@@ -759,10 +759,9 @@ var	  :	singlevar { $$ = $1; }
 		
 singlevar :	NAME
 	  {
-	   Word s = luaI_findsymbol($1);
-	   int local = lua_localname (s);
+	   int local = lua_localname($1);
 	   if (local == -1)	/* global var */
-	    $$ = s + 1;		/* return positive value */
+	    $$ = luaI_findsymbol($1)+1;  /* return positive value */
            else
 	    $$ = -(local+1);		/* return negative value */
 	  }
@@ -771,10 +770,10 @@ singlevar :	NAME
 varexp	: var { lua_pushvar($1); }
 	;
 	  
-localdeclist  : NAME {store_localvar(luaI_findsymbol($1), 0); $$ = 1;}
+localdeclist  : NAME {store_localvar($1, 0); $$ = 1;}
      	  | localdeclist ',' NAME 
 	    {
-	     store_localvar(luaI_findsymbol($3), $1);
+	     store_localvar($3, $1);
 	     $$ = $1+1;
 	    }
 	  ;
@@ -787,228 +786,3 @@ setdebug  : DEBUG  { lua_debug = $1; }
 	  ;
 
 %%
-
-#if LISTING
-
-static void PrintCode (Byte *code, Byte *end)
-{
- Byte *p = code;
- printf ("\n\nCODE\n");
- while (p != end)
- {
-  switch ((OpCode)*p)
-  {
-   case PUSHNIL:	printf ("%d    PUSHNIL\n", (p++)-code); break;
-   case PUSH0: case PUSH1: case PUSH2:
-    			printf ("%d    PUSH%c\n", p-code, *p-PUSH0+'0');
-    			p++;
-   			break;
-   case PUSHBYTE:
-    			printf ("%d    PUSHBYTE   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case PUSHWORD:
-                        {
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    PUSHWORD   %d\n", n, c.w);
-			}
-   			break;
-   case PUSHFLOAT:
-			{
-			 CodeFloat c;
-			 int n = p-code;
-			 p++;
-			 get_float(c,p);
-    			 printf ("%d    PUSHFLOAT  %f\n", n, c.f);
-			}
-   			break;
-   case PUSHSTRING:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    PUSHSTRING   %d\n", n, c.w);
-			}
-   			break;
-   case PUSHFUNCTION:
-			{
-			 CodeCode c;
-			 int n = p-code;
-			 p++;
-			 get_code(c,p);
-			 printf ("%d    PUSHFUNCTION  %p\n", n, c.tf);
-			}
-			break;
-
-   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
-   case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
-   case PUSHLOCAL8: case PUSHLOCAL9:
-    			printf ("%d    PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
-    			p++;
-   			break;
-   case PUSHLOCAL:	printf ("%d    PUSHLOCAL   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case PUSHGLOBAL:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    PUSHGLOBAL   %d\n", n, c.w);
-			}
-   			break;
-   case PUSHINDEXED:    printf ("%d    PUSHINDEXED\n", (p++)-code); break;
-   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
-   case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
-   case STORELOCAL8: case STORELOCAL9:
-    			printf ("%d    STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
-    			p++;
-   			break;
-   case STORELOCAL:
-    			printf ("%d    STORELOCAL   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case STOREGLOBAL:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    STOREGLOBAL   %d\n", n, c.w);
-			}
-   			break;
-   case PUSHSELF:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    PUSHSELF   %d\n", n, c.w);
-			}
-			break;
-   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
-   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case STORELIST0:
-	printf("%d      STORELIST0  %d\n", p-code, *(++p));
-        p++;
-        break;
-   case STORELIST:
-	printf("%d      STORELIST  %d %d\n", p-code, *(p+1), *(p+2));
-        p+=3;
-        break;
-   case STORERECORD:
-       printf("%d      STORERECORD  %d\n", p-code, *(++p));
-       p += *p*sizeof(Word) + 1;
-       break;
-   case ADJUST0: printf ("%d    ADJUST0\n", (p++)-code); break;
-   case ADJUST:
-    			printf ("%d    ADJUST   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case CREATEARRAY:	
-    {
-      CodeWord c;
-      int n = p-code;
-      p++;
-      get_word(c,p);
-      printf ("%d    CREATEARRAY %d\n", n, c.w);
-      break;
-    }
-   case EQOP:       	printf ("%d    EQOP\n", (p++)-code); break;
-   case LTOP:       	printf ("%d    LTOP\n", (p++)-code); break;
-   case LEOP:       	printf ("%d    LEOP\n", (p++)-code); break;
-   case ADDOP:       	printf ("%d    ADDOP\n", (p++)-code); break;
-   case SUBOP:       	printf ("%d    SUBOP\n", (p++)-code); break;
-   case MULTOP:      	printf ("%d    MULTOP\n", (p++)-code); break;
-   case DIVOP:       	printf ("%d    DIVOP\n", (p++)-code); break;
-   case POWOP:       	printf ("%d    POWOP\n", (p++)-code); break;
-   case CONCOP:       	printf ("%d    CONCOP\n", (p++)-code); break;
-   case MINUSOP:       	printf ("%d    MINUSOP\n", (p++)-code); break;
-   case NOTOP:       	printf ("%d    NOTOP\n", (p++)-code); break;
-   case ONTJMP:	   
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    ONTJMP  %d\n", n, c.w);
-			}
-   			break;
-   case ONFJMP:	   
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    ONFJMP  %d\n", n, c.w);
-			}
-   			break;
-   case JMP:	   
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    JMP  %d\n", n, c.w);
-			}
-   			break;
-   case UPJMP:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    UPJMP  %d\n", n, c.w);
-			}
-   			break;
-   case IFFJMP:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    IFFJMP  %d\n", n, c.w);
-			}
-   			break;
-   case IFFUPJMP:
-    			{
-			 CodeWord c;
-			 int n = p-code;
-			 p++;
-			 get_word(c,p);
-    			 printf ("%d    IFFUPJMP  %d\n", n, c.w);
-			}
-   			break;
-   case POP:       	printf ("%d    POP\n", (p++)-code); break;
-   case CALLFUNC:
-	printf ("%d    CALLFUNC %d %d\n", p-code, *(p+1), *(p+2));
-	p+=3;
-	break;
-   case RETCODE0: printf ("%d    RETCODE0\n", (p++)-code); break;
-   case RETCODE:
-    			printf ("%d    RETCODE   %d\n", p-code, *(++p));
-    			p++;
-   			break;
-   case SETLINE:
-                        {
-                         CodeWord c;
-                         int n = p-code;
-                         p++;
-                         get_word(c,p);
-                         printf ("%d    SETLINE  %d\n", n, c.w);
-                        }
-                        break;
-
-   default:		printf ("%d    Cannot happen: code %d\n", (p++)-code, *(p-1)); break;
-  }
- }
-}
-#endif
-

luadebug.h

@@ -2,7 +2,7 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: luadebug.h,v 1.1 1995/10/17 14:12:45 roberto Exp roberto $
+** $Id: luadebug.h,v 1.5 1996/02/08 17:03:20 roberto Exp roberto $
 */
 
 
@@ -11,10 +11,21 @@
 
 #include "lua.h"
 
-lua_Object lua_stackedfunction(int level);
-void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
-int lua_currentline (lua_Object func);
-char *getobjname (lua_Object o, char **name);
+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,21 +2,32 @@
 ** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lualib.h,v 1.3 1994/12/13 15:59:16 roberto Exp roberto $
+** $Id: lualib.h,v 1.7 1996/03/14 15:53:09 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_error(char *funcname);
 char *lua_check_string (int numArg, char *funcname);
-float lua_check_number (int numArg, char *funcname);
+double lua_check_number (int numArg, char *funcname);
+char *luaI_addchar (int c);
+void luaI_addquoted (char *s);
 
 #endif
 

luamem.c

@@ -3,18 +3,24 @@
 ** 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.11 1996/03/21 18:54:29 roberto Exp roberto $";
 
 #include <stdlib.h>
-#include <string.h>
 
 #include "mem.h"
 #include "lua.h"
 
+
+#define mem_error()  lua_error(memEM)
+ 
+
 void luaI_free (void *block)
 {
-  *((int *)block) = -1;  /* to catch errors */
-  free(block);
+  if (block)
+  {
+    *((int *)block) = -1;  /* to catch errors */
+    free(block);
+  }
 }
 
 
@@ -22,23 +28,40 @@ void *luaI_malloc (unsigned long size)
 {
   void *block = malloc((size_t)size);
   if (block == NULL)
-    lua_error("not enough memory");
+    mem_error();
   return block;
 }
 
 
 void *luaI_realloc (void *oldblock, unsigned long size)
 {
-  void *block = realloc(oldblock, (size_t)size);
+  void *block = oldblock ? realloc(oldblock, (size_t)size) :
+                           malloc((size_t)size);
   if (block == NULL)
-    lua_error("not enough memory");
+    mem_error();
   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.6 1996/03/21 18:54:29 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);
-
-char *luaI_strdup (char *str);
+void *luaI_buffer (unsigned long size);
+int luaI_growvector (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit);
 
 #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,9 +1,10 @@
-# $Id: makefile,v 1.15 1995/10/17 18:16:58 roberto Exp roberto $
+# $Id: makefile,v 1.25 1996/05/06 14:38:40 roberto Exp $
 
 #configuration
 
 # define (undefine) POPEN if your system (does not) support piped I/O
-CONFIG = -DPOPEN
+# define (undefine) POSIX if your system is (not) POSIX compliant
+CONFIG = -DPOPEN -DPOSIX
 # Compilation parameters
 CC = gcc
 CFLAGS = $(CONFIG) -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
@@ -25,7 +26,8 @@ LUAOBJS = \
 	tree.o \
 	fallback.o \
 	mem.o \
-	func.o
+	func.o \
+	undump.o
 
 LIBOBJS = 	\
 	iolib.o \
@@ -36,7 +38,7 @@ LIBOBJS = 	\
 lua : lua.o lua.a lualib.a
 	$(CC) $(CFLAGS) -o $@ lua.o lua.a lualib.a -lm
 
-lua.a : parser.o $(LUAOBJS)
+lua.a : $(LUAOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib lua.a
 
@@ -47,36 +49,44 @@ lualib.a : $(LIBOBJS)
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
+#y.tab.c y.tab.h  : lua.stx
+#	yacc++ -d lua.stx
 
-parser.c : lua.stx
-	yacc++ -d lua.stx ; mv -f y.tab.c parser.c ; mv -f y.tab.h parser.h
+#parser.c : y.tab.c
+#	sed -e 's/yy/luaY_/g' -e 's/malloc\.h/stdlib\.h/g' y.tab.c > parser.c
+
+#parser.h : y.tab.h
+#	sed -e 's/yy/luaY_/g' y.tab.h > parser.h
 
 clear	:
 	rcsclean
 	rm -f *.o
-	rm -f parser.c parser.h
+	rm -f parser.c parser.h y.tab.c y.tab.h
 	co lua.h lualib.h luadebug.h
 
-% : RCS/%,v
-	co $@
+
+#% : RCS/%,v
+#	co $@
 
 
-fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h func.h 
-func.o : func.c table.h tree.h types.h opcode.h lua.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 mem.h opcode.h lua.h types.h tree.h func.h hash.h inout.h \
+fallback.o : fallback.c mem.h fallback.h lua.h opcode.h types.h tree.h func.h \
   table.h 
-iolib.o : iolib.c lua.h lualib.h luadebug.h
-lex.o : lex.c mem.h tree.h types.h table.h opcode.h lua.h func.h inout.h parser.h \
-  ugly.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 func.h hash.h inout.h \
-  table.h fallback.h luadebug.h
-parser.o : parser.c mem.h opcode.h lua.h types.h tree.h func.h hash.h inout.h \
-  table.h 
+mem.o : mem.c mem.h lua.h table.h tree.h types.h opcode.h func.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 
-tree.o : tree.c mem.h lua.h tree.h types.h table.h opcode.h func.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,9 +3,9 @@
 ** Mathematics library to LUA
 */
 
-char *rcs_mathlib="$Id: mathlib.c,v 1.12 1995/10/09 12:48:38 roberto Exp roberto $";
+char *rcs_mathlib="$Id: mathlib.c,v 1.16 1996/04/25 14:10:00 roberto Exp roberto $";
 
-#include <stdio.h>		/* NULL */
+#include <stdlib.h>
 #include <math.h>
 
 #include "lualib.h"
@@ -113,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);
@@ -184,29 +184,47 @@ static void math_rad (void)
  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 ("atan2",  math_atan2);
- 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.c

@@ -3,10 +3,9 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.49 1995/11/10 14:12:02 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.67 1996/04/22 18:00:37 roberto Exp roberto $";
 
 #include <setjmp.h>
-#include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
 
@@ -18,6 +17,7 @@ char *rcs_opcode="$Id: opcode.c,v 3.49 1995/11/10 14:12:02 roberto Exp roberto $
 #include "table.h"
 #include "lua.h"
 #include "fallback.h"
+#include "undump.h"
 
 #define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
 #define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
@@ -25,6 +25,10 @@ char *rcs_opcode="$Id: opcode.c,v 3.49 1995/11/10 14:12:02 roberto Exp roberto $
 
 #define STACK_SIZE 	128
 
+#ifndef STACK_LIMIT
+#define STACK_LIMIT     6000
+#endif
+
 typedef int StkId;  /* index to stack elements */
 
 static Object initial_stack;
@@ -53,6 +57,11 @@ static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
 static  jmp_buf *errorJmp = NULL; /* current error recover point */
 
 
+/* Hooks */
+lua_LHFunction lua_linehook = NULL;
+lua_CHFunction lua_callhook = NULL;
+
+
 static StkId lua_execute (Byte *pc, StkId base);
 static void do_call (StkId base, int nResults);
 
@@ -64,7 +73,6 @@ Object *luaI_Address (lua_Object o)
 }
 
 
-
 /*
 ** Init stack
 */
@@ -89,14 +97,17 @@ static void growstack (void)
    lua_initstack();
  else
  {
+  static int limit = STACK_LIMIT;
   StkId t = top-stack;
-  Long maxstack = stackLimit - stack;
-  maxstack *= 2;
-  stack = growvector(stack, maxstack, Object);
-  stackLimit = stack+maxstack;
+  Long stacksize = stackLimit - stack;
+  stacksize = growvector(&stack, stacksize, Object, stackEM, limit+100);
+  stackLimit = stack+stacksize;
   top = stack + t;
-  if (maxstack >= MAX_WORD/2)
-    lua_error("stack size overflow");
+  if (stacksize >= limit)
+  {
+    limit = stacksize;
+    lua_error(stackEM);
+  }
  }
 }
 
@@ -106,18 +117,9 @@ static void growstack (void)
 */
 static char *lua_strconc (char *l, char *r)
 {
- static char *buffer = NULL;
- static int buffer_size = 0;
- int nl = strlen(l);
- int n = nl+strlen(r)+1;
- if (n > buffer_size)
-  {
-   buffer_size = n;
-   if (buffer != NULL)
-     luaI_free(buffer);
-   buffer = newvector(buffer_size, char);
-  }
-  strcpy(buffer,l);
+  int nl = strlen(l);
+  char *buffer = luaI_buffer(nl+strlen(r)+1);
+  strcpy(buffer, l);
   strcpy(buffer+nl, r);
   return buffer;
 }
@@ -150,7 +152,7 @@ static int lua_tonumber (Object *obj)
 */
 static int lua_tostring (Object *obj)
 {
- static char s[256];
+ char s[256];
  if (tag(obj) != LUA_T_NUMBER)
    return 1;
  if ((int) nvalue(obj) == nvalue(obj))
@@ -158,8 +160,6 @@ static int lua_tostring (Object *obj)
  else
    sprintf (s, "%g", nvalue(obj));
  tsvalue(obj) = lua_createstring(s);
- if (tsvalue(obj) == NULL)
-  return 1;
  tag(obj) = LUA_T_STRING;
  return 0;
 }
@@ -192,6 +192,48 @@ static void open_stack (int nelems)
 }
 
 
+/*
+** call Line hook
+*/
+static void lineHook (int line)
+{
+  StkId oldBase = CBase;
+  int oldCnResults = CnResults;
+  StkId old_top = CBase = top-stack;
+  CnResults = 0;
+  (*lua_linehook)(line);
+  top = stack+old_top;
+  CnResults = oldCnResults;
+  CBase = oldBase;
+}
+
+
+/*
+** Call hook
+** The function being called is in [stack+base-1]
+*/
+static void callHook (StkId base, lua_Type type, int isreturn)
+{
+  StkId oldBase = CBase;
+  int oldCnResults = CnResults;
+  StkId old_top = CBase = top-stack;
+  CnResults = 0;
+  if (isreturn)
+    (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
+  else
+  {
+    Object *f = stack+base-1;
+    if (type == LUA_T_MARK)
+      (*lua_callhook)(Ref(f), f->value.tf->fileName, f->value.tf->lineDefined);
+    else
+      (*lua_callhook)(Ref(f), "(C)", -1);
+  }
+  top = stack+old_top;
+  CnResults = oldCnResults;
+  CBase = oldBase;
+}
+
+
 /*
 ** Call a C function. CBase will point to the top of the stack,
 ** and CnResults is the number of parameters. Returns an index
@@ -204,8 +246,12 @@ static StkId callC (lua_CFunction func, StkId base)
   StkId firstResult;
   CnResults = (top-stack) - base;
   /* incorporate parameters on the stack */
-  CBase = base+CnResults;
+  CBase = base+CnResults;  /* == top-stack */
+  if (lua_callhook)
+    callHook(base, LUA_T_CMARK, 0);
   (*func)();
+  if (lua_callhook)  /* func may have changed lua_callhook */
+    callHook(base, LUA_T_CMARK, 1);
   firstResult = CBase;
   CBase = oldBase;
   CnResults = oldCnResults;
@@ -303,6 +349,18 @@ static void storesubscript (void)
 }
 
 
+static void getglobal (Word n)
+{
+  *top = lua_table[n].object;
+  incr_top;
+  if (tag(top-1) == LUA_T_NIL)
+  { /* must call getglobal fallback */
+    tag(top-1) = LUA_T_STRING;
+    tsvalue(top-1) = lua_table[n].varname;
+    callFB(FB_GETGLOBAL);
+  }
+}
+
 /*
 ** Traverse all objects on stack
 */
@@ -340,7 +398,7 @@ void lua_error (char *s)
 }
 
 
-lua_Object lua_stackedfunction (int level)
+lua_Function lua_stackedfunction (int level)
 {
   Object *p = top;
   while (--p >= stack)
@@ -351,13 +409,45 @@ lua_Object lua_stackedfunction (int level)
 }
 
 
-int lua_currentline (lua_Object func)
+int lua_currentline (lua_Function func)
 {
   Object *f = Address(func);
   return (f+1 < top && (f+1)->tag == LUA_T_LINE) ? (f+1)->value.i : -1;
 }
 
 
+lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
+{
+  Object *f = luaI_Address(func);
+  *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
+  if (*name)
+  {
+    /* if "*name", there must be a LUA_T_LINE */
+    /* therefore, f+2 points to function base */
+    return Ref((f+2)+(local_number-1));
+  }
+  else
+    return LUA_NOOBJECT;
+}
+
+int lua_setlocal (lua_Function func, int local_number)
+{
+  Object *f = Address(func);
+  char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func));
+  adjustC(1);
+  --top;
+  if (name)
+  {
+    /* if "name", there must be a LUA_T_LINE */
+    /* therefore, f+2 points to function base */
+    *((f+2)+(local_number-1)) = *top;
+    return 1;
+  }
+  else
+    return 0;
+}
+
+
 /*
 ** Execute a protected call. Assumes that function is at CBase and
 ** parameters are on top of it. Leave nResults on the stack. 
@@ -386,6 +476,16 @@ static int do_protectedrun (int nResults)
   return status;
 }
 
+int luaI_dorun (TFunc *tf)
+{
+  int status;
+  adjustC(1);  /* one slot for the pseudo-function */
+  stack[CBase].tag = LUA_T_FUNCTION;
+  stack[CBase].value.tf = tf;
+  status = do_protectedrun(0);
+  adjustC(0);
+  return status;
+}
 
 static int do_protectedmain (void)
 {
@@ -394,16 +494,12 @@ static int do_protectedmain (void)
   jmp_buf myErrorJmp;
   jmp_buf *oldErr = errorJmp;
   errorJmp = &myErrorJmp;
-  adjustC(1);  /* one slot for the pseudo-function */
-  stack[CBase].tag = LUA_T_FUNCTION;
-  stack[CBase].value.tf = &tf;
-  tf.lineDefined = 0;
+  luaI_initTFunc(&tf);
   tf.fileName = lua_parsedfile;
-  tf.code = NULL;
   if (setjmp(myErrorJmp) == 0)
   {
     lua_parse(&tf);
-    status = do_protectedrun(0);
+    status = luaI_dorun(&tf);
   }
   else
   {
@@ -411,8 +507,7 @@ static int do_protectedmain (void)
     adjustC(0);  /* erase extra slot */
   }
   errorJmp = oldErr;
-  if (tf.code)
-    luaI_free(tf.code);
+  luaI_free(tf.code);
   return status;
 }
 
@@ -449,13 +544,13 @@ int lua_call (char *funcname)
 int lua_dofile (char *filename)
 {
   int status;
-  char *message = lua_openfile (filename);
-  if (message)
-  {
-    lua_message(message);
+  int c;
+  FILE *f = lua_openfile(filename);
+  if (f == NULL)
     return 1;
-  }
-  status = do_protectedmain();
+  c = fgetc(f);
+  ungetc(c, f);
+  status = (c == ID_CHUNK) ? luaI_undump(f) : do_protectedmain();
   lua_closefile();
   return status;
 }
@@ -514,8 +609,9 @@ static StkId Cblocks[MAX_C_BLOCKS];
 */
 void lua_beginblock (void)
 {
-  if (numCblocks < MAX_C_BLOCKS)
-    Cblocks[numCblocks] = CBase;
+  if (numCblocks >= MAX_C_BLOCKS)
+    lua_error("`lua_beginblock': too many nested blocks");
+  Cblocks[numCblocks] = CBase;
   numCblocks++;
 }
 
@@ -525,11 +621,8 @@ void lua_beginblock (void)
 void lua_endblock (void)
 {
   --numCblocks;
-  if (numCblocks < MAX_C_BLOCKS)
-  {
-    CBase = Cblocks[numCblocks];
-    adjustC(0);
-  }
+  CBase = Cblocks[numCblocks];
+  adjustC(0);
 }
 
 /* 
@@ -566,6 +659,23 @@ lua_Object lua_getparam (int number)
  return CBase-CnResults+number;
 }
 
+int lua_isnumber (lua_Object object)
+{
+  return (object != LUA_NOOBJECT) && (tonumber(Address(object)) == 0);
+}
+
+int lua_isstring (lua_Object object)
+{
+  int t = lua_type(object);
+  return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
+}
+
+int lua_isfunction (lua_Object object)
+{
+  int t = lua_type(object);
+  return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION);
+}
+
 /*
 ** Given an object handle, return its number value. On error, return 0.0.
 */
@@ -607,27 +717,31 @@ void *lua_getuserdata (lua_Object object)
 }
 
 
-lua_Object lua_getlocked (int ref)
+lua_Object lua_getref (int ref)
 {
- adjustC(0);
- *top = *luaI_getlocked(ref);
- incr_top;
- CBase++;  /* incorporate object in the stack */
- return Ref(top-1);
+  Object *o = luaI_getref(ref);
+  if (o == NULL)
+    return LUA_NOOBJECT;
+  adjustC(0);
+  luaI_pushobject(o);
+  CBase++;  /* incorporate object in the stack */
+  return Ref(top-1);
 }
 
 
-void lua_pushlocked (int ref)
+void lua_pushref (int ref)
 {
- *top = *luaI_getlocked(ref);
- incr_top;
+  Object *o = luaI_getref(ref);
+  if (o == NULL)
+    lua_error("access to invalid (possibly garbage collected) reference");
+  luaI_pushobject(o);
 }
 
 
-int lua_lock (void)
+int lua_ref (int lock)
 {
   adjustC(1);
-  return luaI_lock(--top);
+  return luaI_ref(--top, lock);
 }
 
 
@@ -637,10 +751,8 @@ int lua_lock (void)
 */
 lua_Object lua_getglobal (char *name)
 {
- Word n = luaI_findsymbolbyname(name);
  adjustC(0);
- *top = s_object(n);
- incr_top;
+ getglobal(luaI_findsymbolbyname(name));
  CBase++;  /* incorporate object in the stack */
  return Ref(top-1);
 }
@@ -678,20 +790,17 @@ void lua_pushnumber (real n)
 */
 void lua_pushstring (char *s)
 {
- tsvalue(top) = lua_createstring(s);
- tag(top) = LUA_T_STRING;
- incr_top;
-}
-
-/*
-** Push an object (tag=string) on stack and register it on the constant table.
-*/
-void lua_pushliteral (char *s)
-{
- tsvalue(top) = lua_constant[luaI_findconstantbyname(s)];
- tag(top) = LUA_T_STRING;
- incr_top;
+  if (s == NULL)
+    tag(top) = LUA_T_NIL;
+  else
+  {
+    tsvalue(top) = lua_createstring(s);
+    tag(top) = LUA_T_STRING;
+  }
+  incr_top;
 }
+/*>>>>>>>>>#undef lua_pushliteral
+void lua_pushliteral(char *s) { lua_pushstring(s); }*/
 
 /*
 ** Push an object (tag=cfunction) to stack.
@@ -707,20 +816,12 @@ void lua_pushcfunction (lua_CFunction fn)
 */
 void lua_pushusertag (void *u, int tag)
 {
- if (tag < LUA_T_USERDATA) return;
+ if (tag < LUA_T_USERDATA) 
+   lua_error("invalid tag in `lua_pushusertag'");
  tag(top) = tag; uvalue(top) = u;
  incr_top;
 }
 
-/*
-** Push a lua_Object to stack.
-*/
-void lua_pushobject (lua_Object o)
-{
- *top = *Address(o);
- incr_top;
-}
-
 /*
 ** Push an object on the stack.
 */
@@ -730,6 +831,16 @@ void luaI_pushobject (Object *o)
  incr_top;
 }
 
+/*
+** Push a lua_Object on stack.
+*/
+void lua_pushobject (lua_Object o)
+{
+  if (o == LUA_NOOBJECT)
+    lua_error("attempt to push a NOOBJECT");
+  luaI_pushobject(Address(o));
+}
+
 int lua_type (lua_Object o)
 {
   if (o == LUA_NOOBJECT)
@@ -783,6 +894,8 @@ static void comparison (lua_Type tag_less, lua_Type tag_equal,
 */
 static StkId lua_execute (Byte *pc, StkId base)
 {
+  if (lua_callhook)
+    callHook (base, LUA_T_MARK, 0);
  while (1)
  {
   OpCode opcode;
@@ -849,8 +962,7 @@ static StkId lua_execute (Byte *pc, StkId base)
    {
     CodeWord code;
     get_word(code,pc);
-    *top = s_object(code.w);
-    incr_top;
+    getglobal(code.w);
    }
    break;
 
@@ -1143,10 +1255,10 @@ static StkId lua_execute (Byte *pc, StkId base)
    break;
 
    case RETCODE0:
-     return base;
-
    case RETCODE:
-     return base+*pc;
+     if (lua_callhook)
+       callHook (base, LUA_T_MARK, 1);
+     return (base + ((opcode==RETCODE0) ? 0 : *pc));
 
    case SETLINE:
    {
@@ -1160,6 +1272,8 @@ static StkId lua_execute (Byte *pc, StkId base)
       (stack+base-1)->tag = LUA_T_LINE;
     }
     (stack+base-1)->value.i = code.w;
+    if (lua_linehook)
+      lineHook (code.w);
     break;
    }
 
@@ -1169,4 +1283,3 @@ static StkId lua_execute (Byte *pc, StkId base)
  }
 }
 
-

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.13 1995/10/17 11:58:41 roberto Exp roberto $
+** $Id: opcode.h,v 3.19 1996/03/06 13:11:23 roberto Exp $
 */
 
 #ifndef opcode_h
@@ -11,9 +11,6 @@
 #include "tree.h"
 #include "func.h"
 
-#ifndef real
-#define real float
-#endif
 
 #define FIELDS_PER_FLUSH 40
 
@@ -74,12 +71,9 @@ typedef enum
 #define MULT_RET	255
 
 
-typedef void (*Cfunction) (void);
-typedef int  (*Input) (void);
-
 typedef union
 {
- Cfunction     f;
+ lua_CFunction f;
  real          n;
  TaggedString *ts;
  TFunc         *tf;
@@ -94,10 +88,6 @@ typedef struct Object
  Value value;
 } Object;
 
-typedef struct
-{
- Object  object;
-} Symbol;
 
 /* Macros to access structure members */
 #define tag(o)		((o)->tag)
@@ -119,14 +109,14 @@ typedef struct
 
 typedef union
 {
- struct {char c1; char c2;} m;
+ struct {Byte c1; Byte 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;
+ struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
  float f;
 } CodeFloat;
 #define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
@@ -134,7 +124,7 @@ typedef union
 
 typedef union
 {
- struct {char c1; char c2; char c3; char c4;} m;
+ struct {Byte c1; Byte c2; Byte c3; Byte c4;} m;
  TFunc *tf;
 } CodeCode;
 #define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
@@ -142,16 +132,12 @@ typedef union
 
 
 /* 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      (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,12 +3,13 @@
 ** String library to LUA
 */
 
-char *rcs_strlib="$Id: strlib.c,v 1.13 1995/10/09 12:49:21 roberto Exp roberto $";
+char *rcs_strlib="$Id: strlib.c,v 1.22 1996/03/22 17:57:24 roberto Exp roberto $";
 
 #include <string.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <ctype.h>
+#include <limits.h>
 
 #include "lua.h"
 #include "lualib.h"
@@ -24,12 +25,12 @@ void lua_arg_error(char *funcname)
 char *lua_check_string (int numArg, char *funcname)
 {
   lua_Object o = lua_getparam(numArg);
-  if (!(lua_isstring(o) || lua_isnumber(o)))
+  if (!lua_isstring(o))
     lua_arg_error(funcname);
   return lua_getstring(o);
 }
 
-float lua_check_number (int numArg, char *funcname)
+double lua_check_number (int numArg, char *funcname)
 {
   lua_Object o = lua_getparam(numArg);
   if (!lua_isnumber(o))
@@ -37,13 +38,36 @@ float lua_check_number (int numArg, char *funcname)
   return lua_getnumber(o);
 }
 
-static char *newstring (char *s)
+static int lua_opt_number (int numArg, int def, char *funcname)
 {
-  char *ns = (char *)malloc(strlen(s)+1);
-  if (ns == 0)
-    lua_error("not enough memory for new string");
-  strcpy(ns, s);
-  return ns;
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              (int)lua_check_number(numArg, funcname);
+}
+
+char *luaI_addchar (int c)
+{
+  static char *buff = NULL;
+  static int max = 0;
+  static int n = 0;
+  if (n >= max)
+  {
+    if (max == 0)
+    {
+      max = 100;
+      buff = (char *)malloc(max);
+    }
+    else
+    {
+      max *= 2;
+      buff = (char *)realloc(buff, max);
+    }
+    if (buff == NULL)
+      lua_error("memory overflow");
+  }
+  buff[n++] = c;
+  if (c == 0)
+    n = 0;  /* prepare for next string */
+  return buff;
 }
 
 
@@ -56,15 +80,12 @@ static void str_find (void)
 {
  char *s1 = lua_check_string(1, "strfind");
  char *s2 = lua_check_string(2, "strfind");
- int init = (lua_getparam(3) == LUA_NOOBJECT) ? 0 :
-                                 (int)lua_check_number(3, "strfind")-1;
- char *f = strstr(s1+init,s2);
+ int init = lua_opt_number(3, 1, "strfind") - 1;
+ char *f = (init>=0 && init<=strlen(s1)) ? strstr(s1+init,s2) : NULL;
  if (f != NULL)
  {
   int pos = f-s1+1;
-  if (lua_getparam (4) == LUA_NOOBJECT)
-   lua_pushnumber (pos);
-  else if ((int)lua_check_number(4, "strfind") >= pos+strlen(s2)-1)
+  if (lua_opt_number(4, INT_MAX, "strfind") >= pos+strlen(s2)-1)
    lua_pushnumber (pos);
   else
    lua_pushnil();
@@ -94,36 +115,18 @@ static void str_sub (void)
 {
  char *s = lua_check_string(1, "strsub");
  int start = (int)lua_check_number(2, "strsub");
- int end = (lua_getparam(3) == LUA_NOOBJECT) ? strlen(s) :
-                                    (int)lua_check_number(3, "strsub");
+ int end = lua_opt_number(3, strlen(s), "strsub");
  if (end < start || start < 1 || end > strlen(s))
   lua_pushliteral("");
  else
  {
-  char temp = s[end];
-  s[end] = 0;
-  lua_pushstring (&s[start-1]);
-  s[end] = temp;
+   luaI_addchar(0);
+   while (start <= end) 
+     luaI_addchar(s[start++ - 1]);
+   lua_pushstring (luaI_addchar(0));
  }
 }
 
-/*
-** Convert a string according to given function.
-*/
-typedef int (*strfunc)(int s);
-static void str_apply (strfunc f, char *funcname)
-{
- char *s, *c;
- c = s = newstring(lua_check_string(1, funcname));
- while (*c != 0)
- {
-  *c = f(*c);
-  c++;
- }
- lua_pushstring(s);
- free(s);
-}
-
 /*
 ** Convert a string to lower case.
 ** LUA interface:
@@ -131,7 +134,11 @@ static void str_apply (strfunc f, char *funcname)
 */
 static void str_lower (void)
 {
-  str_apply(tolower, "strlower");
+  char *s = lua_check_string(1, "strlower");
+  luaI_addchar(0);
+  while (*s)
+    luaI_addchar(tolower(*s++));
+  lua_pushstring(luaI_addchar(0));
 }
 
 
@@ -142,7 +149,11 @@ static void str_lower (void)
 */
 static void str_upper (void)
 {
-  str_apply(toupper, "strupper");
+  char *s = lua_check_string(1, "strupper");
+  luaI_addchar(0);
+  while (*s)
+    luaI_addchar(toupper(*s++));
+  lua_pushstring(luaI_addchar(0));
 }
 
 /*
@@ -151,42 +162,115 @@ static void str_upper (void)
 static void str_ascii (void)
 {
   char *s = lua_check_string(1, "ascii");
-  lua_Object o2 = lua_getparam(2);
-  int pos;
-  pos = (o2 == LUA_NOOBJECT) ? 0 : (int)lua_check_number(2, "ascii")-1;
+  int pos = lua_opt_number(2, 1, "ascii") - 1;
   if (pos<0 || pos>=strlen(s))
     lua_arg_error("ascii");
   lua_pushnumber(s[pos]);
 }
 
-/*
-** converts one or more integers to chars in a string
-*/
-#define maxparams 50
-static void str_int2str (void)
+void luaI_addquoted (char *s)
 {
-  char s[maxparams+1];
-  int i = 0;
-  while (lua_getparam(++i) != LUA_NOOBJECT)
+  luaI_addchar('"');
+  for (; *s; s++)
   {
-    if (i > maxparams)
-      lua_error("too many parameters to function `int2str'");
-    s[i-1] = (int)lua_check_number(i, "int2str");
+    if (*s == '"' || *s == '\\' || *s == '\n')
+      luaI_addchar('\\');
+    luaI_addchar(*s);
   }
-  s[i-1] = 0;
-  lua_pushstring(s);
+  luaI_addchar('"');
 }
 
+#define MAX_CONVERTION 2000
+#define MAX_FORMAT 50
+
+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[MAX_CONVERTION];  /* store the formated value */
+      int size = 0;
+      int i = 0;
+      form[i++] = '%';
+      form[i] = *strfrmt++;
+      while (!isalpha(form[i]))
+      {
+        if (isdigit(form[i]))
+        {
+          size = size*10 + form[i]-'0';
+          if (size >= MAX_CONVERTION)
+            lua_error("format size/precision too long in function `format'");
+        }
+        else if (form[i] == '.')
+          size = 0;  /* re-start */
+        if (++i >= MAX_FORMAT)
+            lua_error("bad format in function `format'");
+        form[i] = *strfrmt++;
+      }
+      form[i+1] = 0;  /* ends string */
+      switch (form[i])
+      {
+        case 'q':
+          luaI_addquoted(lua_check_string(arg++, "format"));
+          buff[0] = '\0';  /* addchar already done */
+          break;
+        case 's':
+        {
+          char *s = lua_check_string(arg++, "format");
+          if (strlen(s) >= MAX_CONVERTION)
+            lua_error("string argument too long in function `format'");
+          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'");
+      }
+      for (i=0; buff[i]; i++)  /* move formated value to result */
+        luaI_addchar(buff[i]);
+    }
+  }
+  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[] = {
+{"strfind", str_find},
+{"strlen", str_len},
+{"strsub", str_sub},
+{"strlower", str_lower},
+{"strupper", str_upper},
+{"ascii", str_ascii},
+{"format",    str_format}
+};
+
+
 /*
 ** Open string library
 */
 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);
- lua_register ("ascii", str_ascii);
- lua_register ("int2str", str_int2str);
+  luaI_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
 }

table.c

@@ -3,9 +3,7 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.37 1995/10/26 14:21:56 roberto Exp roberto $";
-
-/*#include <string.h>*/
+char *rcs_table="$Id: table.c,v 2.53 1996/04/29 18:53:53 roberto Exp roberto $";
 
 #include "mem.h"
 #include "opcode.h"
@@ -21,61 +19,66 @@ char *rcs_table="$Id: table.c,v 2.37 1995/10/26 14:21:56 roberto Exp roberto $";
 #define BUFFER_BLOCK 256
 
 Symbol *lua_table = NULL;
-static Word lua_ntable = 0;
+Word lua_ntable = 0;
 static Long lua_maxsymbol = 0;
 
 TaggedString **lua_constant = NULL;
-static Word lua_nconstant = 0;
+Word lua_nconstant = 0;
 static Long lua_maxconstant = 0;
 
 
-#define GARBAGE_BLOCK 1024
-#define MIN_GARBAGE_BLOCK (GARBAGE_BLOCK/2)
+#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},
+  {"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;
+  lua_maxsymbol = BUFFER_BLOCK;
+  lua_table = newvector(lua_maxsymbol, Symbol);
+  for (i=0; i<INTFUNCSIZE; i++)
+  {
+    Word n = luaI_findsymbolbyname(int_funcs[i].name);
+    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
+  }
 }
 
 
 /*
 ** 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);
 }
 
 
@@ -83,22 +86,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++;
  }
@@ -108,7 +104,7 @@ Word luaI_findsymbol (TreeNode *t)
 
 Word luaI_findsymbolbyname (char *name)
 {
-  return luaI_findsymbol(lua_constcreate(name));
+  return luaI_findsymbol(luaI_createfixedstring(name));
 }
 
 
@@ -116,23 +112,15 @@ Word luaI_findsymbolbyname (char *name)
 ** 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;
@@ -141,7 +129,15 @@ Word luaI_findconstant (TreeNode *t)
 
 Word  luaI_findconstantbyname (char *name)
 {
-  return luaI_findconstant(lua_constcreate(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;
 }
 
 
@@ -153,7 +149,7 @@ static char *lua_travsymbol (int (*fn)(Object *))
  Word i;
  for (i=0; i<lua_ntable; i++)
   if (fn(&s_object(i)))
-    return luaI_nodebysymbol(i)->ts.str;
+    return lua_table[i].varname->str;
  return NULL;
 }
 
@@ -162,7 +158,7 @@ static char *lua_travsymbol (int (*fn)(Object *))
 ** Mark an object if it is a string or a unmarked array.
 */
 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)
@@ -173,27 +169,52 @@ int lua_markobject (Object *o)
  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;
+  }
+}
+
 
 /*
 ** 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();
   recovered += luaI_funccollector();
-  nentity = 0;				/* reset counter */
-  block=(16*block-7*recovered)/12;	/* adapt block size */
-  if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
+  return recovered;
+} 
+
+void lua_pack (void)
+{
+  static unsigned long block = GARBAGE_BLOCK;
+  static unsigned long nentity = 0;  /* total of strings, arrays, etc */
+  unsigned long recovered = 0;
+  if (nentity++ < block) return;
+  recovered = luaI_collectgarbage();
+  block = block*2*(1.0 - (float)recovered/nentity);
+  nentity -= recovered;
 } 
 
 
@@ -225,36 +246,12 @@ static void lua_nextvar (void)
  }
  else
  {
-  TreeNode *t = luaI_nodebysymbol(next);
-  Object name;
-  tag(&name) = LUA_T_STRING;
-  tsvalue(&name) = &(t->ts);
-  luaI_pushobject(&name);
+  lua_pushstring(lua_table[next].varname->str);
   luaI_pushobject(&s_object(next));
  }
 }
 
 
-static void setglobal (void)
-{
-  lua_Object name = lua_getparam(1);
-  lua_Object value = lua_getparam(2);
-  if (!lua_isstring(name))
-    lua_error("incorrect argument to function `setglobal'");
-  lua_pushobject(value);
-  lua_storeglobal(lua_getstring(name));
-}
-
-
-static void getglobal (void)
-{
-  lua_Object name = lua_getparam(1);
-  if (!lua_isstring(name))
-    lua_error("incorrect argument to function `getglobal'");
-  lua_pushobject(lua_getglobal(lua_getstring(name)));
-}
-
-
 static Object *functofind;
 static int checkfunc (Object *o)
 {
@@ -270,7 +267,7 @@ static int checkfunc (Object *o)
 }
 
 
-char *getobjname (lua_Object o, char **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)

table.h

@@ -1,7 +1,7 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.12 1995/10/17 11:58:41 roberto Exp roberto $
+** $Id: table.h,v 2.20 1996/03/14 15:57:19 roberto Exp roberto $
 */
 
 #ifndef table_h
@@ -10,19 +10,28 @@
 #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);
+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);
 
 

tree.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: tree.c,v 1.13 1995/01/12 14:19:04 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.13 1995/01/12 14:19:04 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,44 +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;
 }
 
-
-/*
-** Traverse the constant tree looking for a specific symbol number
-*/
-static TreeNode *nodebysymbol (TreeNode *root, Word symbol)
-{
-  TreeNode *t;
-  if (root == NULL) return NULL;
-  if (root->varindex == symbol) return root;
-  t = nodebysymbol(root->left, symbol);
-  if (t) return t;
-  return nodebysymbol(root->right, symbol);
-}
-
-TreeNode *luaI_nodebysymbol (Word symbol)
-{
-  return nodebysymbol(constant_root, symbol); 
-}
-

tree.h

@@ -1,7 +1,7 @@
 /*
 ** tree.h
 ** TecCGraf - PUC-Rio
-** $Id: tree.h,v 1.9 1995/01/12 14:19:04 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 *luaI_nodebysymbol (Word symbol);
 
 #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,326 @@
+/*
+** undump.c
+** load bytecodes from files
+*/
+
+char* rcs_undump="$Id: undump.c,v 1.13 1996/03/12 20:00:40 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;
+		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:
+	{
+		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)
+ {
+  CodeWord c;
+  Byte* p=code+i;
+  get_word(c,p);
+  i=c.w;
+  c.w=v;
+  p[-2]=c.m.c1;
+  p[-1]=c.m.c2;
+ }
+}
+
+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 char* LoadBlock(int size, FILE* D)
+{
+ char* 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 */
+ {
+  CodeCode c;
+  Byte* p;
+  tf->marked=LoadWord(D);
+  tf->fileName=Main->fileName;
+  p=Main->code+tf->marked;
+  c.tf=tf;
+  *p++=c.m.c1; *p++=c.m.c2; *p++=c.m.c3; *p++=c.m.c4;
+  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;
+ LoadSignature(D);
+ getc(D);					/* skip version */
+ 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.1 1996/03/08 21:43:21 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		0x23		/* 2.3 */
+#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 */