list of incompatibilities with version 2.2.

new macro \Version.

fallback.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_fallback="$Id: fallback.c,v 1.10 1994/12/20 21:20:36 roberto Exp $";
+char *rcs_fallback="$Id: fallback.c,v 1.18 1996/01/30 15:25:23 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -11,7 +11,6 @@ char *rcs_fallback="$Id: fallback.c,v 1.10 1994/12/20 21:20:36 roberto Exp $";
 #include "mem.h"
 #include "fallback.h"
 #include "opcode.h"
-#include "inout.h"
 #include "lua.h"
 
 
@@ -29,15 +28,18 @@ static void funcFB (void);
 ** Warning: This list must be in the same order as the #define's
 */
 struct FB  luaI_fallBacks[] = {
-{"error", {LUA_T_CFUNCTION, errorFB}},
+{"error", {LUA_T_CFUNCTION, {errorFB}}, 1, 0},
-{"index", {LUA_T_CFUNCTION, indexFB}},
+{"index", {LUA_T_CFUNCTION, {indexFB}}, 2, 1},
-{"gettable", {LUA_T_CFUNCTION, gettableFB}},
+{"gettable", {LUA_T_CFUNCTION, {gettableFB}}, 2, 1},
-{"arith", {LUA_T_CFUNCTION, arithFB}},
+{"arith", {LUA_T_CFUNCTION, {arithFB}}, 3, 1},
-{"order", {LUA_T_CFUNCTION, orderFB}},
+{"order", {LUA_T_CFUNCTION, {orderFB}}, 3, 1},
-{"concat", {LUA_T_CFUNCTION, concatFB}},
+{"concat", {LUA_T_CFUNCTION, {concatFB}}, 2, 1},
-{"settable", {LUA_T_CFUNCTION, gettableFB}},
+{"settable", {LUA_T_CFUNCTION, {gettableFB}}, 3, 0},
-{"gc", {LUA_T_CFUNCTION, GDFB}},
+{"gc", {LUA_T_CFUNCTION, {GDFB}}, 1, 0},
-{"function", {LUA_T_CFUNCTION, funcFB}}
+{"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))
@@ -48,10 +50,7 @@ void luaI_setfallback (void)
   char *name = lua_getstring(lua_getparam(1));
   lua_Object func = lua_getparam(2);
   if (name == NULL || !(lua_isfunction(func) || lua_iscfunction(func)))
-  {
+    lua_error("incorrect argument to function `setfallback'");
-    lua_pushnil();
-    return;
-  }
   for (i=0; i<N_FB; i++)
   {
     if (strcmp(luaI_fallBacks[i].kind, name) == 0)
@@ -62,7 +61,7 @@ void luaI_setfallback (void)
     }
   }
   /* name not found */
-  lua_pushnil();
+  lua_error("incorrect argument to function `setfallback'");
 }
 
 
@@ -84,31 +83,31 @@ static void indexFB (void)
 
 static void gettableFB (void)
 {
-  lua_reportbug("indexed expression not a table");
+  lua_error("indexed expression not a table");
 }
  
 
 static void arithFB (void)
 {
-  lua_reportbug("unexpected type at conversion to number");
+  lua_error("unexpected type at conversion to number");
 }
 
 static void concatFB (void)
 {
-  lua_reportbug("unexpected type at conversion to string");
+  lua_error("unexpected type at conversion to string");
 }
 
 
 static void orderFB (void)
 {
-  lua_reportbug("unexpected type at comparison");
+  lua_error("unexpected type at comparison");
 }
 
 static void GDFB (void) { }
 
 static void funcFB (void)
 {
-  lua_reportbug("call expression not a function");
+  lua_error("call expression not a function");
 }
 
 
@@ -124,7 +123,7 @@ int luaI_lock (Object *object)
   Word i;
   Word oldSize;
   if (tag(object) == LUA_T_NIL)
-    return -1;
+    return -1;   /* special lock ref for nil */
   for (i=0; i<lockSize; i++)
     if (tag(&lockArray[i]) == LUA_T_NIL)
     {
@@ -152,20 +151,34 @@ int luaI_lock (Object *object)
 
 void lua_unlock (int ref)
 {
-  tag(&lockArray[ref]) = LUA_T_NIL;
+  if (ref >= 0 && ref < lockSize)
+    tag(&lockArray[ref]) = LUA_T_NIL;
 }
 
 
 Object *luaI_getlocked (int ref)
 {
-  return &lockArray[ref];
+  static Object nul = {LUA_T_NIL, {0}};
+  if (ref >= 0 && ref < lockSize)
+    return &lockArray[ref];
+  else
+    return &nul;
 }
 
 
-void luaI_travlock (void (*fn)(Object *))
+void luaI_travlock (int (*fn)(Object *))
 {
   Word i;
   for (i=0; i<lockSize; i++)
     fn(&lockArray[i]);
 }
 
+
+char *luaI_travfallbacks (int (*fn)(Object *))
+{
+  Word i;
+  for (i=0; i<N_FB; i++)
+    if (fn(&luaI_fallBacks[i].function))
+      return luaI_fallBacks[i].kind;
+  return NULL;
+}

fallback.h

@@ -1,5 +1,5 @@
 /*
-** $Id: fallback.h,v 1.6 1994/11/21 13:30:15 roberto Exp roberto $
+** $Id: fallback.h,v 1.10 1995/10/17 11:52:38 roberto Exp roberto $
 */
  
 #ifndef fallback_h
@@ -10,6 +10,8 @@
 extern struct FB {
   char *kind;
   Object function;
+  int nParams;
+  int nResults;
 } luaI_fallBacks[];
 
 #define FB_ERROR  0
@@ -21,11 +23,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);
-void luaI_travlock (void (*fn)(Object *));
+void luaI_travlock (int (*fn)(Object *));
+char *luaI_travfallbacks (int (*fn)(Object *));
 
 #endif
 

func.c

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

func.h

@@ -0,0 +1,38 @@
+#ifndef func_h
+#define func_h
+
+#include "types.h"
+#include "lua.h"
+
+typedef struct LocVar
+{
+  TaggedString *varname;           /* NULL signals end of scope */
+  int       line;
+} LocVar;
+
+
+/*
+** Function Headers
+*/
+typedef struct TFunc
+{
+  struct TFunc	*next;
+  char		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_registerlocalvar (TaggedString *varname, int line);
+void luaI_unregisterlocalvar (int line);
+void luaI_closelocalvars (TFunc *func);
+char *luaI_getlocalname (TFunc *func, int local_number, int line);
+
+#endif

hash.c

@@ -3,18 +3,15 @@
 ** hash manager for lua
 */
 
-char *rcs_hash="$Id: hash.c,v 2.23 1995/01/12 14:19:04 roberto Exp $";
+char *rcs_hash="$Id: hash.c,v 2.28 1996/02/12 18:32:40 roberto Exp roberto $";
 
-#include <string.h>
 
 #include "mem.h"
 #include "opcode.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
 #include "lua.h"
 
-#define streq(s1,s2)	(s1 == s2 || (*(s1) == *(s2) && strcmp(s1,s2)==0))
 
 #define nhash(t)	((t)->nhash)
 #define nuse(t)		((t)->nuse)
@@ -25,19 +22,18 @@ char *rcs_hash="$Id: hash.c,v 2.23 1995/01/12 14:19:04 roberto Exp $";
 #define val(n)		(&(n)->val)
 
 
-#define REHASH_LIMIT	0.70	/* avoid more than this % full */
+#define REHASH_LIMIT    0.70    /* avoid more than this % full */
 
 
 static Hash *listhead = NULL;
 
 
-
 /* hash dimensions values */
 static Word dimensions[] = 
  {3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
   12853, 25717, 51437, 65521, 0};  /* 65521 == last prime < MAX_WORD */
 
-static Word redimension (Word nhash)
+Word luaI_redimension (Word nhash)
 {
  Word i;
  for (i=0; dimensions[i]!=0; i++)
@@ -54,24 +50,14 @@ static Word hashindex (Hash *t, Object *ref)		/* hash function */
  switch (tag(ref))
  {
   case LUA_T_NIL:
-   lua_reportbug ("unexpected type to index table");
+   lua_error ("unexpected type to index table");
    return -1;  /* UNREACHEABLE */
   case LUA_T_NUMBER:
    return (((Word)nvalue(ref))%nhash(t));
   case LUA_T_STRING:
-  {
+   return (Word)((tsvalue(ref)->hash)%nhash(t));  /* make it a valid index */
-   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 */
-  }
   case LUA_T_FUNCTION:
-   return (((IntPoint)bvalue(ref))%nhash(t));
+   return (((IntPoint)ref->value.tf)%nhash(t));
   case LUA_T_CFUNCTION:
    return (((IntPoint)fvalue(ref))%nhash(t));
   case LUA_T_ARRAY:
@@ -81,16 +67,16 @@ 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 bvalue(t1) == bvalue(t2);
+    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
     case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
     default: return uvalue(t1) == uvalue(t2);
   }
@@ -127,7 +113,7 @@ static Node *hashnodecreate (Word nhash)
 static Hash *hashcreate (Word nhash)
 {
  Hash *t = new(Hash);
- nhash = redimension((Word)((float)nhash/REHASH_LIMIT));
+ nhash = luaI_redimension((Word)((float)nhash/REHASH_LIMIT));
  nodevector(t) = hashnodecreate(nhash);
  nhash(t) = nhash;
  nuse(t) = 0;
@@ -238,7 +224,7 @@ static void rehash (Hash *t)
  Word i;
  Word   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++)
  {

hash.h

@@ -2,13 +2,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.9 1996/02/07 14:13:17 roberto Exp roberto $
 */
 
 #ifndef hash_h
 #define hash_h
 
 #include "types.h"
+#include "opcode.h"
 
 typedef struct node
 {
@@ -26,7 +27,8 @@ typedef struct Hash
 } Hash;
 
 
-Bool     lua_equalObj (Object *t1, Object *t2);
+int      lua_equalObj (Object *t1, Object *t2);
+Word     luaI_redimension (Word nhash);
 Hash    *lua_createarray (Word nhash);
 void     lua_hashmark (Hash *h);
 Long     lua_hashcollector (void);

inout.c

@@ -5,41 +5,30 @@
 ** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 2.15 1994/12/16 15:55:04 roberto Exp roberto $";
+char *rcs_inout="$Id: inout.c,v 2.31 1996/02/13 17:30:39 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"
 
-/* Exported variables */
-Word lua_linenumber;
-Bool lua_debug;
-Word lua_debugline = 0;
 
-
-/* Internal variables */
- 
 #ifndef MAXFUNCSTACK
 #define MAXFUNCSTACK 100
 #endif
- 
+
-typedef struct FuncStackNode {
+#define MAXMESSAGE MAXFUNCSTACK*80
-  struct FuncStackNode *next;
+
-  char *file;
+
-  Word function;
+/* Exported variables */
-  Word line;
+Word lua_linenumber;
-} FuncStackNode;
+char *lua_parsedfile;
- 
+
-static FuncStackNode *funcStack = NULL;
-static Word nfuncstack=0;
 
 static FILE *fp;
 static char *st;
@@ -62,20 +51,23 @@ static int stringinput (void)
 
 /*
 ** Function to open a file to be input unit. 
-** Return 0 on success or error message on error.
+** Return 0 on success or 1 error.
 */
-char *lua_openfile (char *fn)
+int lua_openfile (char *fn)
 {
- lua_linenumber = 1;
  lua_setinput (fileinput);
- fp = fopen (fn, "r");
+ if (fn == NULL)
- if (fp == NULL)
  {
-   static char buff[32];
+   fp = stdin;
-   sprintf(buff, "unable to open file %.10s", fn);
+   fn = "(stdin)";
-   return buff;
  }
- return lua_addfile (fn);
+ else
+   fp = fopen (fn, "r");
+ if (fp == NULL)
+   return 1;
+ lua_linenumber = 1;
+ lua_parsedfile = lua_constcreate(fn)->str;
+ return 0;
 }
 
 /*
@@ -83,9 +75,8 @@ char *lua_openfile (char *fn)
 */
 void lua_closefile (void)
 {
- if (fp != NULL)
+ if (fp != NULL && fp != stdin)
  {
-  lua_delfile();
   fclose (fp);
   fp = NULL;
  }
@@ -94,16 +85,12 @@ void lua_closefile (void)
 /*
 ** Function to open a string to be input unit
 */
-char *lua_openstring (char *s)
+void lua_openstring (char *s)
 {
- lua_linenumber = 1;
  lua_setinput (stringinput);
  st = s;
- {
+ lua_linenumber = 1;
-  char sn[64];
+ lua_parsedfile = lua_constcreate("(string)")->str;
-  sprintf (sn, "String: %10.10s...", s);
-  return lua_addfile (sn);
- }
 }
 
 /*
@@ -111,75 +98,6 @@ char *lua_openstring (char *s)
 */
 void lua_closestring (void)
 {
- lua_delfile();
-}
-
-
-/*
-** Called to execute  SETFUNCTION opcode, this function pushs a function into
-** function stack.
-*/
-void lua_pushfunction (char *file, Word function)
-{
- FuncStackNode *newNode;
- if (nfuncstack++ >= MAXFUNCSTACK)
- {
-  lua_reportbug("function stack overflow");
- }
- newNode = new(FuncStackNode);
- newNode->function = function;
- newNode->file = file;
- newNode->line= lua_debugline;
- newNode->next = funcStack;
- funcStack = newNode;
-}
-
-/*
-** Called to execute RESET opcode, this function pops a function from 
-** function stack.
-*/
-void lua_popfunction (void)
-{
- FuncStackNode *temp = funcStack;
- if (temp == NULL) return;
- --nfuncstack;
- lua_debugline = temp->line;
- funcStack = temp->next;
- luaI_free(temp);
-}
-
-/*
-** Report bug building a message and sending it to lua_error function.
-*/
-void lua_reportbug (char *s)
-{
- char msg[MAXFUNCSTACK*80];
- strcpy (msg, s);
- if (lua_debugline != 0)
- {
-  if (funcStack)
-  {
-   FuncStackNode *func = funcStack;
-   int line = lua_debugline;
-   sprintf (strchr(msg,0), "\n\tactive stack:\n");
-   do
-   {
-     sprintf (strchr(msg,0),
-       "\t-> function \"%s\" at file \"%s\":%u\n", 
-              lua_constant[func->function]->str, func->file, line);
-     line = func->line;
-     func = func->next;
-     lua_popfunction();
-   } while (func);
-  }
-  else
-  {
-   sprintf (strchr(msg,0),
-         "\n\tin statement begining at line %u of file \"%s\"", 
-         lua_debugline, lua_filename());
-  }
- }
- lua_error (msg);
 }
 
  
@@ -201,33 +119,52 @@ 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
+static char *tostring (lua_Object obj)
-*/
-void lua_print (void)
 {
- int i=1;
+  static char buff[20];
- lua_Object obj;
+  if (lua_isstring(obj))
- while ((obj=lua_getparam (i++)) != LUA_NOOBJECT)
+    return lua_getstring(obj);
- {
+  if (lua_isnumber(obj))
-  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber(obj));
+    sprintf(buff, "%g", lua_getnumber(obj));
-  else if (lua_isstring(obj))    printf("%s\n",lua_getstring(obj));
+  else if (lua_isfunction(obj))
-  else if (lua_isfunction(obj))  printf("function: %p\n",bvalue(luaI_Address(obj)));
+    sprintf(buff, "function: %p", (luaI_Address(obj))->value.tf);
-  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction(obj)
+  else if (lua_iscfunction(obj))
-);
+    sprintf(buff, "cfunction: %p", lua_getcfunction(obj));
-  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata(obj));
+  else if (lua_isuserdata(obj))
-  else if (lua_istable(obj))     printf("table: %p\n",avalue(luaI_Address(obj)));
+    sprintf(buff, "userdata: %p", lua_getuserdata(obj));
-  else if (lua_isnil(obj))       printf("nil\n");
+  else if (lua_istable(obj))
-  else                           printf("invalid value to print\n");
+    sprintf(buff, "table: %p", avalue(luaI_Address(obj)));
- }
+  else if (lua_isnil(obj))
+    sprintf(buff, "nil");
+  else buff[0] = 0;
+  return buff;
 }
 
+void luaI_tostring (void)
+{
+  lua_pushstring(tostring(lua_getparam(1)));
+}
+
+void luaI_print (void)
+{
+  int i = 1;
+  lua_Object obj;
+  while ((obj = lua_getparam(i++)) != LUA_NOOBJECT)
+    printf("%s\n", tostring(obj));
+}
 
 /*
 ** Internal function: return an object type.
@@ -235,9 +172,11 @@ void lua_print (void)
 void luaI_type (void)
 {
   lua_Object o = lua_getparam(1);
+  int t;
   if (o == LUA_NOOBJECT)
     lua_error("no parameter to function 'type'");
-  switch (lua_type(o))
+  t = lua_type(o);
+  switch (t)
   {
     case LUA_T_NIL :
       lua_pushliteral("nil");
@@ -252,15 +191,14 @@ void luaI_type (void)
       lua_pushliteral("table");
       break;
     case LUA_T_FUNCTION :
-      lua_pushliteral("function");
-      break;
     case LUA_T_CFUNCTION :
-      lua_pushliteral("cfunction");
+      lua_pushliteral("function");
       break;
     default :
       lua_pushliteral("userdata");
       break;
   }
+  lua_pushnumber(t);
 }
  
 /*
@@ -289,6 +227,31 @@ void luaI_error (void)
 {
   char *s = lua_getstring(lua_getparam(1));
   if (s == NULL) s = "(no message)";
-  lua_reportbug(s);
+  lua_error(s);
 }
 
+void luaI_assert (void)
+{
+  lua_Object p = lua_getparam(1);
+  if (p == LUA_NOOBJECT || lua_isnil(p))
+    lua_error("assertion failed!");
+}
+
+void luaI_setglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  lua_Object value = lua_getparam(2);
+  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.6 1994/11/21 21:41:09 roberto Stab roberto $
+** $Id: inout.h,v 1.12 1996/01/26 14:05:28 roberto Exp roberto $
 */
 
 
@@ -8,23 +8,25 @@
 
 #include "types.h"
 
-extern Word lua_linenumber;
-extern Bool lua_debug;
-extern Word lua_debugline;
 
-char *lua_openfile     (char *fn);
+extern Word lua_linenumber;
+extern Word lua_debugline;
+extern char *lua_parsedfile;
+
+int  lua_openfile     (char *fn);
 void lua_closefile    (void);
-char *lua_openstring   (char *s);
+void lua_openstring   (char *s);
 void lua_closestring  (void);
-void lua_pushfunction (char *file, Word function);
-void lua_popfunction  (void);
-void lua_reportbug    (char *s);
 
 void    lua_internaldofile (void);
 void    lua_internaldostring (void);
-void    lua_print      (void);
+void    luaI_tostring   (void);
+void    luaI_print      (void);
 void    luaI_type       (void);
 void    lua_obj2number (void);
 void	luaI_error     (void);
+void    luaI_assert    (void);
+void	luaI_setglobal (void);
+void	luaI_getglobal (void);
 
 #endif

iolib.c

@@ -3,7 +3,7 @@
 ** Input/output library to LUA
 */
 
-char *rcs_iolib="$Id: iolib.c,v 1.20 1995/02/02 18:54:58 roberto Exp roberto $";
+char *rcs_iolib="$Id: iolib.c,v 1.35 1996/02/09 19:35:23 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <ctype.h>
@@ -12,53 +12,71 @@ char *rcs_iolib="$Id: iolib.c,v 1.20 1995/02/02 18:54:58 roberto Exp roberto $";
 #include <string.h>
 #include <time.h>
 #include <stdlib.h>
+#include <errno.h>
 
 #include "lua.h"
+#include "luadebug.h"
 #include "lualib.h"
 
 static FILE *in=stdin, *out=stdout;
 
+
+#ifdef POPEN
+FILE *popen();
+int pclose();
+#else
+#define popen(x,y) NULL  /* that is, popen always fails */
+#define pclose(x)  (-1)
+#endif
+
+
+static void closeread (void)
+{
+  if (in != stdin)
+  {
+    if (pclose(in) == -1)
+      fclose(in);
+    in = stdin;
+  }
+}
+
+static void closewrite (void)
+{
+  if (out != stdout)
+  {
+    if (pclose(out) == -1)
+      fclose(out);
+    out = stdout;
+  }
+}
+
 /*
 ** Open a file to read.
 ** LUA interface:
 **			status = readfrom (filename)
 ** where:
 **			status = 1 -> success
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_readfrom (void)
 {
- lua_Object o = lua_getparam (1);
+ if (lua_getparam (1) == LUA_NOOBJECT)	
- if (o == LUA_NOOBJECT)			/* restore standart input */
+ { /* restore standart input */
- {
+  closeread();
-  if (in != stdin)
-  {
-   fclose (in);
-   in = stdin;
-  }
   lua_pushnumber (1);
  }
  else
  {
-  if (!lua_isstring (o))
+   char *s = lua_check_string(1, "readfrom");
-  {
+   FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
-   lua_error ("incorrect argument to function 'readfrom`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"r");
    if (fp == NULL)
-   {
+    lua_pushnil();
-    lua_pushnumber (0);
-   }
    else
    {
-    if (in != stdin) fclose (in);
+    closeread();
     in = fp;
     lua_pushnumber (1);
    }
-  }
  }
 }
 
@@ -69,41 +87,27 @@ static void io_readfrom (void)
 **			status = writeto (filename)
 ** where:
 **			status = 1 -> success
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_writeto (void)
 {
- lua_Object o = lua_getparam (1);
+ if (lua_getparam (1) == LUA_NOOBJECT)	/* restore standart output */
- if (o == LUA_NOOBJECT)			/* restore standart output */
  {
-  if (out != stdout)
+  closewrite();
-  {
-   fclose (out);
-   out = stdout;
-  }
   lua_pushnumber (1);
  }
  else
  {
-  if (!lua_isstring (o))
+   char *s = lua_check_string(1, "writeto");
-  {
+   FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
-   lua_error ("incorrect argument to function 'writeto`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"w");
    if (fp == NULL)
-   {
+    lua_pushnil();
-    lua_pushnumber (0);
-   }
    else
    {
-    if (out != stdout) fclose (out);
+    closewrite();
     out = fp;
     lua_pushnumber (1);
    }
-  }
  }
 }
 
@@ -115,50 +119,63 @@ static void io_writeto (void)
 ** where:
 **			status = 2 -> success (already exist)
 **			status = 1 -> success (new file)
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_appendto (void)
 {
- lua_Object o = lua_getparam (1);
+ char *s = lua_check_string(1, "appendto");
- if (o == LUA_NOOBJECT)			/* restore standart output */
+ struct stat st;
- {
+ int r = (stat(s, &st) == -1) ? 1 : 2;
-  if (out != stdout)
+ FILE *fp = fopen (s, "a");
-  {
+ if (fp == NULL)
-   fclose (out);
+  lua_pushnil();
-   out = stdout;
-  }
-  lua_pushnumber (1);
- }
  else
  {
-  if (!lua_isstring (o))
+  if (out != stdout) fclose (out);
-  {
+  out = fp;
-   lua_error ("incorrect argument to function 'appendto`");
+  lua_pushnumber (r);
-   lua_pushnumber (0);
-  }
-  else
-  {
-   int r;
-   FILE *fp;
-   struct stat st;
-   if (stat(lua_getstring(o), &st) == -1) r = 1;
-   else                                   r = 2;
-   fp = fopen (lua_getstring(o),"a");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (r);
-   }
-  }
  }
 }
 
 
+static char getformat (char *f, int *just, int *m, int *n)
+{
+  int t;
+  switch (*f++)
+  {
+    case 'q': case 'Q':
+    case 's': case '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;
+    default:
+      t = 0;  /* to avoid compiler warnings */
+      lua_arg_error("read/write (format)");
+  }
+  *just = (*f == '<' || *f == '>' || *f == '|') ? *f++ : '>';
+  if (isdigit(*f))
+  {
+    *m = 0;
+    while (isdigit(*f))
+      *m = *m*10 + (*f++ - '0');
+  }
+  else
+    *m = -1;
+  if (*f == '.')
+  {
+    f++;	/* skip point */
+    *n = 0;
+    while (isdigit(*f))
+      *n = *n*10 + (*f++ - '0');
+  }
+  else
+    *n = -1;
+  return t;
+}
+
 
 /*
 ** Read a variable. On error put nil on stack.
@@ -174,138 +191,112 @@ static void io_appendto (void)
 **	Estes especificadores podem vir seguidos de numero que representa
 **	o numero de campos a serem lidos.
 */
-static void io_read (void)
+
+static int read_until_char (int del)
+{
+  int c;
+  while((c = fgetc(in)) != EOF && c != del)
+    luaI_addchar(c);
+  return c;
+}
+
+static void read_until_blank (void)
+{
+  int c;
+  while((c = fgetc(in)) != EOF && !isspace(c))
+    luaI_addchar(c);
+  if (c != EOF) ungetc(c,in);
+}
+
+static void read_m (int m)
+{
+  int c;
+  while (m-- && (c = fgetc(in)) != EOF)
+    luaI_addchar(c);
+}
+
+
+static void read_free (void)
 {
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT || !lua_isstring(o))	/* free format */
- {
   int c;
-  char s[256];
   while (isspace(c=fgetc(in)))
    ;
-  if (c == '\"')
+  if (c == EOF)
   {
-   int n=0;
-   while((c = fgetc(in)) != '\"')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
-    }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else if (c == '\'')
-  {
-   int n=0;
-   while((c = fgetc(in)) != '\'')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
-    }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else
-  {
-   double d;
-   ungetc (c, in);
-   if (fscanf (in, "%s", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-   if (sscanf(s, "%lf %*c", &d) == 1)
-   {
-    lua_pushnumber (d);
-    return;
-   }
-  }
-  lua_pushstring (s);
-  return;
- }
- else				/* formatted */
- {
-  char *e = lua_getstring(o);
-  char t;
-  int  m=0;
-  while (isspace(*e)) e++;
-  t = *e++;
-  while (isdigit(*e))
-   m = m*10 + (*e++ - '0');
-  
-  if (m > 0)
-  {
-   char f[80];
-   char s[256];
-   sprintf (f, "%%%ds", m);
-   if (fgets (s, m, in) == NULL)
-   {
     lua_pushnil();
     return;
-   }
+  }
-   else
+  if (c == '\"' || c == '\'')
-   {
+  { /* string */
-    if (s[strlen(s)-1] == '\n')
+    c = read_until_char(c);
-     s[strlen(s)-1] = 0;
+    if (c == EOF)
-   }
+      lua_pushnil();
-   switch (tolower(t))
+    else
-   {
+      lua_pushstring(luaI_addchar(0));
-    case 'i':
-    {
-     long int l;
-     sscanf (s, "%ld", &l);
-     lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float fl;
-     sscanf (s, "%f", &fl);
-     lua_pushnumber(fl);
-    }
-    break;
-    default: 
-     lua_pushstring(s); 
-    break;
-   }
   }
   else
   {
-   switch (tolower(t))
+    double d;
-   {
+    char dummy;
-    case 'i':
+    char *s;
-    {
+    luaI_addchar(c);
-     long int l;
+    read_until_blank();
-     if (fscanf (in, "%ld", &l) == EOF)
+    s = luaI_addchar(0);
-       lua_pushnil();
+    if (sscanf(s, "%lf %c", &d, &dummy) == 1)
-       else lua_pushnumber(l);
+      lua_pushnumber(d);
-    }
+    else
-    break;
+     lua_pushstring(s);
-    case 'f': case 'g': case 'e':
+  }
-    {
+}
-     float f;
+
-     if (fscanf (in, "%f", &f) == EOF)
+static void io_read (void)
-       lua_pushnil();
+{
-       else lua_pushnumber(f);
+  lua_Object o = lua_getparam (1);
-    }
+  luaI_addchar(0);  /* initialize buffer */
-    break;
+  if (o == LUA_NOOBJECT) 	/* free format */
-    default: 
+    read_free();
-    {
+  else				/* formatted */
-     char s[256];
+  {
-     if (fscanf (in, "%s", s) == EOF)
+    int m, dummy1, dummy2;
-       lua_pushnil();
+    switch (getformat(lua_check_string(1, "read"), &dummy1, &m, &dummy2))
-       else lua_pushstring(s);
+    {
-    }
+      case 's':
-    break;
+      {
-   }
+        char *s;
+        if (m < 0)
+          read_until_blank();
+        else
+          read_m(m);
+        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':
+      {
+        double d;
+        int result;
+        if (m < 0)
+          result = fscanf(in, "%lf", &d);
+        else
+        {
+          read_m(m);
+          result = sscanf(luaI_addchar(0), "%lf", &d);
+        }
+        if (result == 1)
+          lua_pushnumber(d);
+        else
+          lua_pushnil();
+        break;
+      }
+      default:
+        lua_arg_error("read (format)");
+    }
   }
- }
 }
 
 
@@ -314,33 +305,19 @@ static void io_read (void)
 */
 static void io_readuntil (void)
 {
- int n=255,m=0;
+ int del, c;
- int c,d;
+ lua_Object p = lua_getparam(1);
- char *s;
+ luaI_addchar(0);  /* initialize buffer */
- lua_Object lo = lua_getparam(1);
+ if (p == LUA_NOOBJECT || lua_isnil(p))
- if (!lua_isstring(lo))
+   del = EOF;
-  d = EOF; 
  else
-  d = *lua_getstring(lo);
+  del = *lua_check_string(1, "readuntil");
- 
+ c = read_until_char(del);
- s = (char *)malloc(n+1);
- while((c = fgetc(in)) != EOF && c != d)
- {
-  if (m==n)
-  {
-   n *= 2;
-   s = (char *)realloc(s, n+1);
-  }
-  s[m++] = c;
- }
  if (c != EOF) ungetc(c,in);
- s[m] = 0;
+ lua_pushstring(luaI_addchar(0));
- lua_pushstring(s);
- free(s);
 }
 
 
-
 /*
 ** Write a variable. On error put 0 on stack, otherwise put 1.
 ** LUA interface:
@@ -367,106 +344,127 @@ static void io_readuntil (void)
 **			inteiros -> numero minimo de digitos
 **			string -> nao se aplica
 */
-static char *buildformat (char *e, lua_Object o)
-{
- static char buffer[2048];
- static char f[80];
- char *string = &buffer[255];
- char *fstart=e, *fspace, *send;
- char t, j='r';
- int  m=0, n=-1, l;
- while (isspace(*e)) e++;
- fspace = e;
- t = *e++;
- if (*e == '<' || *e == '|' || *e == '>') j = *e++;
- while (isdigit(*e))
-  m = m*10 + (*e++ - '0');
- if (*e == '.') e++;	/* skip point */
- while (isdigit(*e))
-  if (n < 0) n = (*e++ - '0');
-  else       n = n*10 + (*e++ - '0');
 
- sprintf(f,"%%");
+static int write_fill (int n, int c)
- if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
+{
- if (m >  0)   sprintf(strchr(f,0),"%d", m);
+  while (n--)
- if (n >= 0)   sprintf(strchr(f,0),".%d", n);
+    if (fputc(c, out) == EOF)
- switch (t)
+      return 0;
- {
+  return 1;
-  case 'i': case 'I': t = 'd';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (long int)lua_getnumber(o));
-  break;
-  case 'f': case 'g': case 'e': case 'G': case 'E': 
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 'F': t = 'f';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 's': case 'S': t = 's';
-   sprintf(strchr(f,0), "%c", t);
-   sprintf (string, f, lua_getstring(o));
-  break;
-  default: return "";
- }
- l = strlen(string);
- send = string+l;
- if (m!=0 && l>m)
- {
-  int i;
-  for (i=0; i<m; i++)
-   string[i] = '*';
-  string[i] = 0;
- }
- else if (m!=0 && j=='|')
- {
-  int k;
-  int i=l-1;
-  while (isspace(string[i]) || string[i]==0) i--;
-  string -= (m-i)/2;
-  for(k=0; k<(m-i)/2; k++)
-   string[k] = ' ';
- }
- /* add space characteres */
- while (fspace != fstart)
- {
-  string--;
-  fspace--;
-  *string = *fspace; 
- }
- while (isspace(*e)) *send++ = *e++;
- *send = 0;
- return string;
 }
+
+static int write_string (char *s, int just, int m)
+{
+  int status;
+  int l = strlen(s);
+  int pre;  /* number of blanks before string */
+  if (m < 0) m = l;
+  else if (l > m)
+  {
+    write_fill(m, '*');
+    return 0;
+  }
+  pre = (just == '<') ? 0 : (just == '>') ? m-l : (m-l)/2;
+  status = write_fill(pre, ' ');
+  status = status && fprintf(out, "%s", s) >= 0;
+  status = status && write_fill(m-(l+pre), ' ');
+  return status;
+}
+
+static int write_quoted (int just, int m)
+{
+  char *s = lua_check_string(1, "write");
+  luaI_addchar(0);
+  luaI_addchar('"');
+  while (1)
+  {
+    switch (*s)
+    {
+      case '"':  case '\\':  case '\n':
+        luaI_addchar('\\');
+        luaI_addchar(*s);
+        break;
+      case 0:
+        goto END_WHILE;
+      default:
+        luaI_addchar(*s);
+    }
+    s++;
+  } END_WHILE:
+  luaI_addchar('"');
+  return write_string(luaI_addchar(0), just, m);
+}
+
+static int write_float (int just, int m, int n)
+{
+  char buffer[100];
+  lua_Object p = lua_getparam(1);
+  float number;
+  if (!lua_isnumber(p)) return 0;
+  number = lua_getnumber(p);
+  if (n >= 0)
+    sprintf(buffer, "%.*f", n, number);
+  else
+    sprintf(buffer, "%g", number);
+  return write_string(buffer, just, m);
+}
+
+
+static int write_int (int just, int m, int n)
+{
+  char buffer[100];
+  lua_Object p = lua_getparam(1);
+  int number;
+  if (!lua_isnumber(p)) return 0;
+  number = (int)lua_getnumber(p);
+  if (n >= 0)
+    sprintf(buffer, "%.*d", n, number);
+  else
+    sprintf(buffer, "%d", number);
+  return write_string(buffer, just, m);
+}
+
+
 static void io_write (void)
 {
- lua_Object o1 = lua_getparam (1);
+  int status = 0;
- lua_Object o2 = lua_getparam (2);
+  if (lua_getparam (2) == LUA_NOOBJECT)   /* free format */
- if (o1 == LUA_NOOBJECT)			/* new line */
+  {
- {
+    lua_Object o1 = lua_getparam(1);
-  fprintf (out, "\n");
+    if (lua_isnumber(o1))
-  lua_pushnumber(1);
+      status = fprintf (out, "%g", lua_getnumber(o1)) >= 0;
- }
+    else if (lua_isstring(o1))
- else if (o2 == LUA_NOOBJECT)   		/* free format */
+      status = fprintf (out, "%s", lua_getstring(o1)) >= 0;
- {
-  int status=0;
-  if (lua_isnumber(o1))
-   status = fprintf (out, "%g", lua_getnumber(o1));
-  else if (lua_isstring(o1))
-   status = fprintf (out, "%s", lua_getstring(o1));
-  lua_pushnumber(status);
- }
- else					/* formated */
- {
-  if (!lua_isstring(o2))
-  { 
-   lua_error ("incorrect format to function `write'"); 
-   lua_pushnumber(0);
-   return;
   }
-  lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
+  else					/* formated */
- }
+  {
+    int just, m, n;
+    switch (getformat(lua_check_string(2, "write"), &just, &m, &n))
+    {
+      case 's':
+      {
+        lua_Object p = lua_getparam(1);
+        if (lua_isstring(p))
+          status = write_string(lua_getstring(p), just, m);
+        else
+          status = 0;
+        break;
+      }
+      case 'q':
+        status = write_quoted(just, m);
+        break;
+      case 'f':
+        status = write_float(just, m, n);
+        break;
+      case 'i':
+        status = write_int(just, m, n);
+        break;
+    }
+  }
+  if (status)
+    lua_pushnumber(status);
+  else
+    lua_pushnil();
 }
 
 /*
@@ -475,95 +473,54 @@ static void io_write (void)
 */
 static void io_execute (void)
 {
- lua_Object o = lua_getparam (1);
+  lua_pushnumber(system(lua_check_string(1, "execute")));
- if (o == LUA_NOOBJECT || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  int res = system(lua_getstring(o));
-  lua_pushnumber (res);
- }
- return;
 }
 
 /*
-** Remove a file.
+** Remove a file. On error return nil.
-** On error put 0 on stack, otherwise put 1.
 */
 static void io_remove  (void)
 {
- lua_Object o = lua_getparam (1);
+ if (remove(lua_check_string(1, "remove")) == 0)
- if (o == LUA_NOOBJECT || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  if (remove(lua_getstring(o)) == 0)
    lua_pushnumber (1);
-  else
+ else
-   lua_pushnumber (0);
+   lua_pushnil();
- }
+}
- return;
+
+static void io_errorno (void)
+{
+/*  lua_pushstring(strerror(errno));*/
 }
 
 
 /*
-** To get a environment variables
+** To get a environment variable
 */
 static void io_getenv (void)
 {
- lua_Object s = lua_getparam(1);
+ char *env = getenv(lua_check_string(1, "getenv"));
- if (!lua_isstring(s))
+ if (env == NULL) lua_pushnil();
-  lua_pushnil();
+ else             lua_pushstring(env); 
- else
- {
-  char *env = getenv(lua_getstring(s));
-  if (env == NULL) lua_pushnil();
-  else             lua_pushstring(env); 
- }
 }
 
 /*
-** Return time: hour, min, sec
+** Return user formatted time stamp
-*/
-static void io_time (void)
-{
- time_t t;
- struct tm *s;
- 
- time(&t);
- s = localtime(&t);
- lua_pushnumber(s->tm_hour);
- lua_pushnumber(s->tm_min);
- lua_pushnumber(s->tm_sec);
-}
- 
-/*
-** Return date: dd, mm, yyyy
 */
 static void io_date (void)
 {
  time_t t;
- struct tm *s;
+ struct tm *tm;
- 
+ char *s;
- time(&t);
+ char b[BUFSIZ];
- s = localtime(&t);
+ if (lua_getparam(1) == LUA_NOOBJECT)
- lua_pushnumber(s->tm_mday);
+  s = "%c";
- lua_pushnumber(s->tm_mon+1);
+ else
- lua_pushnumber(s->tm_year+1900);
+  s = lua_check_string(1, "date");
-}
+ time(&t); tm = localtime(&t);
- 
+ if (strftime(b,sizeof(b),s,tm))
-/*
+  lua_pushstring(b);
-** Beep
+ else
-*/
+  lua_error("invalid `date' format");
-static void io_beep (void)
-{
- printf("\a");
 }
  
 /*
@@ -573,7 +530,7 @@ static void io_exit (void)
 {
  lua_Object o = lua_getparam(1);
  if (lua_isstring(o))
-  printf("%s\n", lua_getstring(o));
+  fprintf(stderr, "%s\n", lua_getstring(o));
  exit(1);
 }
 
@@ -593,6 +550,54 @@ static void io_debug (void)
   }
 }
 
+
+void lua_printstack (FILE *f)
+{
+  int level = 0;
+  lua_Object func;
+  fprintf(f, "Active Stack:\n");
+  while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT)
+  {
+    char *name;
+    int currentline;
+    fprintf(f, "\t");
+    switch (*lua_getobjname(func, &name))
+    {
+      case 'g':
+        fprintf(f, "function %s", name);
+        break;
+      case 'f':
+        fprintf(f, "fallback %s", name);
+        break;
+      default:
+      {
+        char *filename;
+        int linedefined;
+        lua_funcinfo(func, &filename, &linedefined);
+        if (linedefined == 0)
+          fprintf(f, "main of %s", filename);
+        else if (linedefined < 0)
+          fprintf(f, "%s", filename);
+        else
+          fprintf(f, "function (%s:%d)", filename, linedefined);
+      }
+    }
+    if ((currentline = lua_currentline(func)) > 0)
+      fprintf(f, "  at line %d", currentline);
+    fprintf(f, "\n");
+  }
+}
+
+
+static void errorfb (void)
+{
+  lua_Object o = lua_getparam(1);
+  char *s = lua_isstring(o) ? lua_getstring(o) : "(no messsage)";
+  fprintf(stderr, "lua: %s\n", s);
+  lua_printstack(stderr);
+}
+
+
 /*
 ** Open io library
 */
@@ -606,10 +611,34 @@ void iolib_open (void)
  lua_register ("write",    io_write);
  lua_register ("execute",  io_execute);
  lua_register ("remove",   io_remove);
+ lua_register ("ioerror",   io_errorno);
  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);
 }
+
+/*
+** Return user formatted time stamp
+*
+static void sys_localtime (void)
+{
+ time_t t;
+ struct tm *tm;
+ lua_Object o = lua_getparam(1);
+
+ time(&t); tm = localtime(&t);
+ if (lua_isstring(o))
+ {
+  char b[BUFSIZ];
+  if (strftime(b,sizeof(b),lua_getstring(o),tm)==0)
+   lua_pushstring(ctime(&t));
+  else
+   lua_pushstring(b);
+ }
+ else
+  lua_pushstring(ctime(&t));
+}
+*/

lex.c

@@ -1,27 +1,28 @@
-char *rcs_lex = "$Id: lex.c,v 2.13 1994/12/20 21:20:36 roberto Exp celes $";
+char *rcs_lex = "$Id: lex.c,v 2.27 1996/02/14 13:35:51 roberto Exp roberto $";
  
 
 #include <ctype.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
 #include <string.h>
+#include <stdio.h>
 
+#include "mem.h"
 #include "tree.h"
 #include "table.h"
-#include "opcode.h"
+#include "lex.h"
 #include "inout.h"
+#include "luadebug.h"
 #include "parser.h"
 #include "ugly.h"
 
-#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
+#define MINBUFF 260
 
 #define next() { current = input(); }
 #define save(x) { *yytextLast++ = (x); }
 #define save_and_next()  { save(current); next(); }
 
 static int current;
-static char yytext[256];
+static char *yytext = NULL;
+static int textsize = 0;
 static char *yytextLast;
 
 static Input input;
@@ -30,6 +31,11 @@ void lua_setinput (Input fn)
 {
   current = ' ';
   input = fn;
+  if (yytext == NULL)
+  {
+    textsize = MINBUFF;
+    yytext = newvector(textsize, char);
+  }
 }
 
 char *lua_lasttext (void)
@@ -39,7 +45,6 @@ char *lua_lasttext (void)
 }
 
 
-/* The reserved words must be listed in lexicographic order */
 static struct
   {
     char *name;
@@ -66,28 +71,75 @@ static struct
 #define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
 
 
-static int findReserved (char *name)
+void luaI_addReserved (void)
 {
-  int l = 0;
+  int i;
-  int h = RESERVEDSIZE - 1;
+  for (i=0; i<RESERVEDSIZE; i++)
-  while (l <= h)
   {
-    int m = (l+h)/2;
+    TaggedString *ts = lua_createstring(reserved[i].name);
-    int comp = lua_strcmp(name, reserved[m].name);
+    ts->marked = reserved[i].token;  /* reserved word  (always > 255) */
-    if (comp < 0)
-      h = m-1;
-    else if (comp == 0)
-      return reserved[m].token;
-    else
-      l = m+1;
   }
-  return 0;
 }
 
 
-int yylex (void)
+static void growtext (void)
+{
+  int size = yytextLast - yytext;
+  textsize *= 2;
+  yytext = growvector(yytext, textsize, char);
+  yytextLast = yytext + size;
+}
+
+
+static int read_long_string (void)
+{
+  int cont = 0;
+  int spaceleft = textsize - (yytextLast - yytext);
+  while (1)
+  {
+    if (spaceleft <= 2)  /* may read more than 1 char in one cicle */
+    {
+      growtext();
+      spaceleft = textsize - (yytextLast - yytext);
+    }
+    switch (current)
+    {
+      case EOF:
+      case 0:
+        return WRONGTOKEN;
+      case '[':
+        save_and_next(); spaceleft--;
+        if (current == '[')
+        {
+          cont++;
+          save_and_next(); spaceleft--;
+        }
+        continue; 
+      case ']':
+        save_and_next(); spaceleft--;
+        if (current == ']')
+        {
+          if (cont == 0) return STRING;
+          cont--;
+          save_and_next(); spaceleft--;
+        }
+        continue; 
+      case '\n':
+        lua_linenumber++;  /* goes through */
+      default:
+        save_and_next(); spaceleft--;
+    }
+  }
+}
+
+
+int luaY_lex (void)
 {
   float a;
+  static int linelasttoken = 0;
+  if (lua_debug)
+    luaI_codedebugline(linelasttoken);
+  linelasttoken = lua_linenumber;
   while (1)
   {
     yytextLast = yytext;
@@ -99,8 +151,9 @@ int yylex (void)
       case EOF:
       case 0:
        return 0;
-      case '\n': lua_linenumber++;
+      case '\n': linelasttoken = ++lua_linenumber;
       case ' ':
+      case '\r':  /* CR: to avoid problems with DOS/Windows */
       case '\t':
         next();
         continue;
@@ -110,24 +163,39 @@ 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 '-';
+        if (current != '-') return '-';  /* else goes through */
+      case '#':
         do { next(); } while (current != '\n' && current != 0);
         continue;
 
+      case '[':
+        save_and_next();
+        if (current != '[') return '[';
+        else
+        {
+          save_and_next();  /* pass the second '[' */
+          if (read_long_string() == WRONGTOKEN)
+            return WRONGTOKEN;
+          save_and_next();  /* pass the second ']' */
+          *(yytextLast-2) = 0;  /* erases ']]' */
+          luaY_lval.vWord = luaI_findconstantbyname(yytext+2);
+          return STRING;
+        }
+
       case '=':
         save_and_next();
         if (current != '=') return '=';
@@ -152,9 +220,16 @@ int yylex (void)
       case '\'':
       {
         int del = current;
+        int spaceleft = textsize - (yytextLast - yytext);
         next();  /* skip the delimiter */
         while (current != del)
         {
+          if (spaceleft <= 2) /* may read more than 1 char in one cicle */
+          {
+            growtext();
+            spaceleft = textsize - (yytextLast - yytext);
+          }
+          spaceleft--;
           switch (current)
           {
             case EOF:
@@ -168,6 +243,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;
@@ -177,7 +253,7 @@ int yylex (void)
         }
         next();  /* skip the delimiter */
         *yytextLast = 0;
-        yylval.vWord = luaI_findconstant(lua_constcreate(yytext));
+        luaY_lval.vWord = luaI_findconstantbyname(yytext);
         return STRING;
       }
 
@@ -195,12 +271,14 @@ int yylex (void)
       case 'Z':
       case '_':
       {
-        Word res;
+        TaggedString *ts;
         do { save_and_next(); } while (isalnum(current) || current == '_');
         *yytextLast = 0;
-        res = findReserved(yytext);
+        ts = lua_createstring(yytext);
-        if (res) return res;
+        if (ts->marked > 2)
-        yylval.pNode = lua_constcreate(yytext);
+          return ts->marked;  /* reserved word */
+        luaY_lval.pTStr = ts;
+        ts->marked = 2;  /* avoid GC */
         return NAME;
       }
 
@@ -241,7 +319,7 @@ fraction:
 	      ea*=ea;
 	    }
           }
-          yylval.vFloat = a;
+          luaY_lval.vFloat = a;
           return NUMBER;
         }
 

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.3 1994/12/14 19:58:20 celes Exp $";
+char *rcs_lua="$Id: lua.c,v 1.6 1995/10/23 13:54:11 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <string.h>
@@ -14,6 +14,12 @@ char *rcs_lua="$Id: lua.c,v 1.3 1994/12/14 19:58:20 celes Exp $";
 static int lua_argc;
 static char **lua_argv;
 
+/*
+** although this function is POSIX, there is no standard header file that
+** defines it
+*/
+int isatty (int fd);
+
 /*
 %F Allow Lua code to access argv strings.
 %i Receive from Lua the argument number (starting with 1).
@@ -33,6 +39,19 @@ static void lua_getargv (void)
 }
 
 
+static void manual_input (void)
+{
+  if (isatty(fileno(stdin)))
+  {
+   char buffer[250];
+   while (gets(buffer) != 0)
+     lua_dostring(buffer);
+  }
+  else
+    lua_dofile(NULL);  /* executes stdin as a file */
+}
+
+
 int main (int argc, char *argv[])
 {
  int i;
@@ -44,26 +63,25 @@ int main (int argc, char *argv[])
  lua_register("argv", lua_getargv);
 
  if (argc < 2)
- {
+   manual_input();
-   char buffer[250];
-   while (gets(buffer) != 0)
-     result = lua_dostring(buffer);
- }
  else
  {
   for (i=1; i<argc; i++)
-  {
    if (strcmp(argv[i], "--") == 0)
    {
     lua_argc = argc-i-1;
     lua_argv = argv+i;
     break;
    }
-  }
   for (i=1; i<argc; i++)
   {
    if (strcmp(argv[i], "--") == 0)
     break;
+   else if (strcmp(argv[i], "-") == 0)
+    manual_input();
+   else if (strcmp(argv[i], "-v") == 0)
+    printf("%s  %s\n(written by %s)\n\n",
+            LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
    else
     result = lua_dofile (argv[i]);
   }

lua.h

@@ -2,13 +2,18 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lua.h,v 3.15 1995/01/18 20:15:05 celes Exp celes $
+** $Id: lua.h,v 3.22 1996/02/12 18:32:09 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+#define LUA_VERSION	"Lua 2.3 (beta)"
+#define LUA_COPYRIGHT	"Copyright (C) 1994, 1995 TeCGraf"
+#define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
+
+
 /* Private Part */
  
 typedef enum
@@ -19,6 +24,9 @@ typedef enum
  LUA_T_ARRAY	= -4,
  LUA_T_FUNCTION	= -5,
  LUA_T_CFUNCTION= -6,
+ LUA_T_MARK	= -7,
+ LUA_T_CMARK	= -8,
+ LUA_T_LINE	= -9,
  LUA_T_USERDATA = 0
 } lua_Type;
  
@@ -52,7 +60,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);
@@ -90,7 +97,9 @@ lua_Object     lua_createtable		(void);
 #define lua_isuserdata(_)       (lua_type(_)>=LUA_T_USERDATA)
 
 
-/* for lua 1.1 compatibility. Avoid using these macros */
+/* for compatibility with old versions. Avoid using these macros */
+
+#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,18 +1,20 @@
 %{
 
-char *rcs_luastx = "$Id: lua.stx,v 3.16 1994/12/27 20:41:11 celes Exp roberto $";
+char *rcs_luastx = "$Id: lua.stx,v 3.31 1996/02/13 17:30:39 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"
 #include "tree.h"
 #include "table.h"
 #include "lua.h"
+#include "func.h"
 
 /* to avoid warnings generated by yacc */
 int yyparse (void);
@@ -36,27 +38,41 @@ static Byte  *basepc;
 static int   maincode;
 static int   pc;
 
+
 #define MAXVAR 32
 static Long    varbuffer[MAXVAR];    /* variables in an assignment list;
 				it's long to store negative Word values */
 static int     nvarbuffer=0;	     /* number of variables at a list */
 
-static Word    localvar[STACKGAP];   /* store local variable names */
+#define MAXLOCALS 32
+static TaggedString *localvar[MAXLOCALS];  /* store local variable names */
 static int     nlocalvar=0;	     /* number of local variables */
 
 #define MAXFIELDS FIELDS_PER_FLUSH*2
 static Word    fields[MAXFIELDS];     /* fieldnames to be flushed */
 static int     nfields=0;
 
+int lua_debug = 0;
 
 /* Internal functions */
 
+static void yyerror (char *s)
+{
+ 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");
+    yyerror("code size overflow");
   maxcurr *= 2;
   if (maxcurr >= MAX_INT)
     maxcurr = MAX_INT;
@@ -83,10 +99,10 @@ static void code_float (float n)
  code_byte(code.m.c4);
 }
 
-static void code_code (Byte *b)
+static void code_code (TFunc *tf)
 {
  CodeCode code;
- code.b = b;
+ code.tf = tf;
  code_byte(code.m.c1);
  code_byte(code.m.c2);
  code_byte(code.m.c3);
@@ -103,10 +119,10 @@ static void code_word_at (Byte *p, Word n)
 
 static void push_field (Word name)
 {
-  if (nfields < STACKGAP-1)
+  if (nfields < MAXFIELDS)
     fields[nfields++] = name;
   else
-   lua_error ("too many fields in a constructor");
+   yyerror ("too many fields in nested constructors");
 }
 
 static void flush_record (int n)
@@ -131,24 +147,32 @@ 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_nlocalvar (int n)
+static void store_localvar (TaggedString *name, int n)
 {
- if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
+ if (nlocalvar+n < MAXLOCALS)
-  nlocalvar += n;
+  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 incr_nvarbuffer (void)
+static void add_localvar (TaggedString *name)
 {
- if (nvarbuffer < MAXVAR-1)
+  store_localvar(name, 0);
-  nvarbuffer++;
+  nlocalvar++;
+}
+
+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)
@@ -178,7 +202,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--)
@@ -225,26 +249,35 @@ static void lua_codeadjust (int n)
  }
 }
 
-static void init_function (TreeNode *func)
+static void change2main (void)
 {
- if (funcCode == NULL)	/* first function */
+  /* (re)store main values */
- {
+  pc=maincode; basepc=*initcode; maxcurr=maxmain;
-  funcCode = newvector(CODE_BLOCK, Byte);
+  nlocalvar=0;
-  maxcode = CODE_BLOCK;
+}
- }
+
- pc=0; basepc=funcCode; maxcurr=maxcode; 
+static void savemain (void)
- nlocalvar=0;
+{
-  if (lua_debug)
+  /* save main values */
+  maincode=pc; *initcode=basepc; maxmain=maxcurr;
+}
+
+static void init_func (void)
+{
+  if (funcCode == NULL)	/* first function */
   {
-    code_byte(SETFUNCTION); 
+   funcCode = newvector(CODE_BLOCK, Byte);
-    code_code((Byte *)luaI_strdup(lua_file[lua_nfile-1]));
+   maxcode = CODE_BLOCK;
-    code_word(luaI_findconstant(func));
   }
+  savemain();  /* save main values */
+  /* set func values */
+  pc=0; basepc=funcCode; maxcurr=maxcode; 
+  nlocalvar = 0;
+  luaI_codedebugline(lua_linenumber);
 }
 
 static void codereturn (void)
 {
-  if (lua_debug) code_byte(RESET); 
   if (nlocalvar == 0)
     code_byte(RETCODE0);
   else
@@ -254,49 +287,71 @@ static void codereturn (void)
   }
 }
 
-static void codedebugline (void)
+void luaI_codedebugline (int line)
 {
-  if (lua_debug)
+  static int lastline = 0;
+  if (lua_debug && line != lastline)
   {
     code_byte(SETLINE);
-    code_word(lua_linenumber);
+    code_word(line);
+    lastline = line;
   }
 }
 
-static void adjust_mult_assign (int vars, int exps, int temps)
+static int adjust_functioncall (Long exp, int i)
 {
-  if (exps < 0) 
+  if (exp <= 0)
+    return -exp; /* exp is -list length */
+  else
   {
-    int r = vars - (-exps-1);
+    int temp = basepc[exp];
-    if (r >= 0)
+    basepc[exp] = i;
-      code_byte(r);
+    return temp+i;
+  }
+}
+
+static void adjust_mult_assign (int vars, Long exps, int temps)
+{
+  if (exps > 0)
+  { /* must correct function call */
+    int diff = vars - basepc[exps];
+    if (diff >= 0)
+      adjust_functioncall(exps, diff);
     else
     {
-      code_byte(0);
+      adjust_functioncall(exps, 0);
       lua_codeadjust(temps);
     }
   }
-  else if (vars != exps)
+  else if (vars != -exps)
     lua_codeadjust(temps);
 }
 
+static void storesinglevar (Long v)
+{
+ if (v > 0)		/* global var */
+ {
+   code_byte(STOREGLOBAL);
+   code_word(v-1);
+ }
+ else if (v < 0)      /* local var */
+ {
+   int number = (-v) - 1;
+   if (number < 10) code_byte(STORELOCAL0 + number);
+   else
+   {
+     code_byte(STORELOCAL);
+     code_byte(number);
+   }
+ }
+ else 
+   code_byte(STOREINDEXED0);
+}
+
 static void lua_codestore (int i)
 {
- if (varbuffer[i] > 0)		/* global var */
+ if (varbuffer[i] != 0)  /* global or local var */
- {
+  storesinglevar(varbuffer[i]);
-  code_byte(STOREGLOBAL);
-  code_word(varbuffer[i]-1);
- }
- else if (varbuffer[i] < 0)      /* local var */
- {
-  int number = (-varbuffer[i]) - 1;
-  if (number < 10) code_byte(STORELOCAL0 + number);
-  else
-  {
-   code_byte(STORELOCAL);
-   code_byte(number);
-  }
- }
  else				  /* indexed var */
  {
   int j;
@@ -332,26 +387,21 @@ static void codeIf (Long thenAdd, Long elseAdd)
   code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
 }
 
-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_filename());
- lua_error (msg);
-}
-
 
 /*
 ** Parse LUA code.
 */
-void lua_parse (Byte **code)
+void lua_parse (TFunc *tf)
 {
- initcode = code;
+ initcode = &(tf->code);
  *initcode = newvector(CODE_BLOCK, Byte);
  maincode = 0; 
  maxmain = CODE_BLOCK;
+ change2main();
  if (yyparse ()) lua_error("parse error");
+ savemain();
  (*initcode)[maincode++] = RETCODE0;
+ tf->size = maincode;
 #if LISTING
 { static void PrintCode (Byte *c, Byte *end);
  PrintCode(*initcode,*initcode+maincode); }
@@ -369,8 +419,8 @@ void lua_parse (Byte **code)
  char *pChar;
  Word  vWord;
  Long  vLong;
- Byte *pByte;
+ TFunc *pFunc;
- TreeNode *pNode;
+ TaggedString *pTStr;
 }
 
 %start functionlist
@@ -383,16 +433,21 @@ void lua_parse (Byte **code)
 %token FUNCTION
 %token <vFloat> NUMBER
 %token <vWord>  STRING
-%token <pNode>  NAME 
+%token <pTStr>  NAME 
 %token <vInt>   DEBUG
 
 %type <vLong> PrepJump
-%type <vInt>  expr, exprlist, exprlist1, varlist1, funcParams, funcvalue
+%type <vLong> exprlist, exprlist1  /* if > 0, points to function return
+	counter (which has list length); if <= 0, -list lenght */
+%type <vLong> functioncall, expr  /* if != 0, points to function return
+					 counter */
+%type <vInt>  varlist1, funcParams, funcvalue
 %type <vInt>  fieldlist, localdeclist, decinit
-%type <vInt>  ffieldlist1
+%type <vInt>  ffieldlist, ffieldlist1, semicolonpart
-%type <vInt>  lfieldlist1
+%type <vInt>  lfieldlist, lfieldlist1
-%type <vLong> var, singlevar
+%type <vInt>  parlist
-%type <pByte> body
+%type <vLong> var, singlevar, funcname
+%type <pFunc> body
 
 %left AND OR
 %left EQ NE '>' '<' LE GE
@@ -407,62 +462,51 @@ void lua_parse (Byte **code)
 
 
 functionlist : /* empty */
-	     | functionlist 
+	     | functionlist globalstat
-	        {
-	  	  pc=maincode; basepc=*initcode; maxcurr=maxmain;
-		  nlocalvar=0;
-	        }
-	       stat sc 
-		{
-		  maincode=pc; *initcode=basepc; maxmain=maxcurr;
-		}
 	     | functionlist function
-	     | functionlist method
-	     | functionlist setdebug
 	     ;
 
-function     : FUNCTION NAME 
+globalstat   : stat sc
-               {
+	     | setdebug
-		init_function($2);
+	     ;
-	       }
+
-               body 	 
+function     : FUNCTION funcname body 	 
 	       { 
-		Word func = luaI_findsymbol($2);
+		code_byte(PUSHFUNCTION);
-	        s_tag(func) = LUA_T_FUNCTION;
+		code_code($3);
-	        s_bvalue(func) = $4;
+		storesinglevar($2);
 	       }
 	       ;
 
-method         : FUNCTION NAME ':' NAME
+funcname	: var { $$ =$1; init_func(); }
-	       {
+		| varexp ':' NAME
-		init_function($4);
+	{
-	        localvar[nlocalvar]=luaI_findsymbolbyname("self");
+	  code_byte(PUSHSTRING);
-	        add_nlocalvar(1);
+	  code_word(luaI_findconstant($3));
-	       }
+	  $$ = 0;  /* indexed variable */
-	       body
+	  init_func();
-	       {
+	  add_localvar(lua_constcreate("self"));
-	        /* assign function to table field */
+	}
-	        pc=maincode; basepc=*initcode; maxcurr=maxmain;
+		;
-	        nlocalvar=0;
-		lua_pushvar(luaI_findsymbol($2)+1);
-                code_byte(PUSHSTRING);
-		code_word(luaI_findconstant($4));
-                code_byte(PUSHFUNCTION);
-                code_code($6);
-                code_byte(STOREINDEXED0);
-		maincode=pc; *initcode=basepc; maxmain=maxcurr;
-	       }
-	       ;
 
 body :  '(' parlist ')' block END
 	{
           codereturn();
-	  $$ = newvector(pc, Byte);
+	  $$ = new(TFunc);
-	  memcpy($$, basepc, pc*sizeof(Byte));
+          luaI_initTFunc($$);
+	  $$->size = pc;
+	  $$->code = newvector(pc, Byte);
+	  $$->fileName = lua_parsedfile;
+	  $$->lineDefined = $2;
+	  memcpy($$->code, basepc, pc*sizeof(Byte));
+          if (lua_debug)
+            luaI_closelocalvars($$);
+	  /* save func values */
 	  funcCode = basepc; maxcode=maxcurr;
 #if LISTING
                 PrintCode(funcCode,funcCode+pc);
 #endif
+	  change2main();  /* change back to main code */
 	}
 		;
 
@@ -472,11 +516,7 @@ statlist : /* empty */
 
 sc	 : /* empty */ | ';' ;
 
-stat  : { codedebugline(); } stat1 ;
+stat   : IF expr1 THEN PrepJump block PrepJump elsepart END
-
-cond  : { codedebugline(); } expr1 ;
-
-stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
 	{ codeIf($4, $6); }
 
        | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
@@ -487,7 +527,7 @@ stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
 	code_word_at(basepc+$7+1, pc - ($<vLong>2));
        }
      
-       | REPEAT {$<vLong>$=pc;} block UNTIL cond PrepJump
+       | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
        {
         basepc[$6] = IFFUPJMP;
 	code_word_at(basepc+$6+1, pc - ($<vLong>2));
@@ -504,16 +544,16 @@ stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
 	  lua_codeadjust (0);
 	}
        } 
-       | functioncall	{ code_byte(0); }
+       | functioncall
        | LOCAL localdeclist decinit
-	{ add_nlocalvar($2);
+	{ nlocalvar += $2;
 	  adjust_mult_assign($2, $3, 0);
-	 }
+	}
        ;
 
 elsepart : /* empty */
 	 | ELSE block
-         | ELSEIF cond THEN PrepJump block PrepJump elsepart
+         | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
 	{ codeIf($4, $6); }
          ;
      
@@ -521,16 +561,20 @@ 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);
 	  }
          }
          ;
 
 ret	: /* empty */
-        | RETURN { codedebugline(); } exprlist sc
+        | RETURN exprlist sc
           {
-           if ($3 < 0) code_byte(MULT_RET);
+	   adjust_functioncall($2, MULT_RET);
            codereturn();
           }
 	;
@@ -542,46 +586,46 @@ PrepJump : /* empty */
 	  code_word (0);
          }
 	   
-expr1	 : expr { if ($1 == 0) code_byte(1); }
+expr1	 : expr { adjust_functioncall($1, 1); }
 	 ;
 				
 expr :  '(' expr ')'  { $$ = $2; }
-     |  expr1 EQ  expr1	{ code_byte(EQOP);   $$ = 1; }
+     |  expr1 EQ  expr1	{ code_byte(EQOP);   $$ = 0; }
-     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 1; }
+     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 0; }
-     |	expr1 '>' expr1	{ code_byte(GTOP);   $$ = 1; }
+     |	expr1 '>' expr1	{ code_byte(GTOP);   $$ = 0; }
-     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 1; }
+     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 0; }
-     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 1; }
+     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 0; }
-     |	expr1 GE  expr1	{ code_byte(GEOP);   $$ = 1; }
+     |	expr1 GE  expr1	{ code_byte(GEOP);   $$ = 0; }
-     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 1; }
+     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 0; }
-     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 1; }
+     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 0; }
-     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; }
+     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 0; }
-     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 1; }
+     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 0; }
-     |	expr1 '^' expr1 { code_byte(POWOP);  $$ = 1; }
+     |	expr1 '^' expr1 { code_byte(POWOP);  $$ = 0; }
-     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 1; }
+     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 0; }
-     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 1;}
+     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 0;}
-     | table { $$ = 1; }
+     | table { $$ = 0; }
-     |  varexp          { $$ = 1;}
+     |  varexp          { $$ = 0;}
-     |  NUMBER          { code_number($1); $$ = 1; }
+     |  NUMBER          { code_number($1); $$ = 0; }
      |  STRING
      {
       code_byte(PUSHSTRING);
       code_word($1);
-      $$ = 1;
+      $$ = 0;
      }
-     |	NIL		{code_byte(PUSHNIL); $$ = 1; }
+     |	NIL		{code_byte(PUSHNIL); $$ = 0; }
-     |  functioncall    { $$ = 0; }
+     |  functioncall    { $$ = $1; }
-     |	NOT expr1	{ code_byte(NOTOP);  $$ = 1;}
+     |	NOT expr1	{ code_byte(NOTOP);  $$ = 0;}
      |	expr1 AND PrepJump {code_byte(POP); } expr1
      { 
       basepc[$3] = ONFJMP;
       code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
-      $$ = 1;
+      $$ = 0;
      }
      |	expr1 OR PrepJump {code_byte(POP); } expr1	
      { 
       basepc[$3] = ONTJMP;
       code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
-      $$ = 1;
+      $$ = 0;
      }
      ;
 
@@ -597,7 +641,12 @@ table :
          ;
 
 functioncall : funcvalue funcParams
-	{ code_byte(CALLFUNC); code_byte($1+$2); }
+	{
+	  code_byte(CALLFUNC);
+	  code_byte($1+$2);
+	  $$ = pc;
+	  code_byte(0);  /* may be modified by other rules */
+	}
 	     ;
 
 funcvalue    : varexp { $$ = 0; }
@@ -610,7 +659,7 @@ funcvalue    : varexp { $$ = 0; }
 	     ;
 
 funcParams :	'(' exprlist ')'
-	{ if ($2<0) { code_byte(1); $$ = -$2; } else $$ = $2; }
+	{ $$ = adjust_functioncall($2, 1); }
 	|	table  { $$ = 1; }
 	;
 
@@ -618,45 +667,48 @@ exprlist  :	/* empty */		{ $$ = 0; }
 	  |	exprlist1		{ $$ = $1; }
 	  ;
 		
-exprlist1 :	expr	{ if ($1 == 0) $$ = -1; else $$ = 1; }
+exprlist1 :  expr	{ if ($1 != 0) $$ = $1; else $$ = -1; }
-	  |	exprlist1 ',' { if ($1 < 0) code_byte(1); } expr 
+	  |  exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr 
 	{
-          int r = $1 < 0 ? -$1 : $1;
+	  if ($4 == 0) $$ = -($<vLong>3 + 1);  /* -length */
-          $$ = ($4 == 0) ? -(r+1) : r+1;
+	  else
+	  {
+	    adjust_functioncall($4, $<vLong>3);
+	    $$ = $4;
+	  }
 	}
 	  ;
 
-parlist  :	/* empty */ { lua_codeadjust(0); }
+parlist  :	/* empty */ { lua_codeadjust(0); $$ = lua_linenumber; }
-	  |	parlist1    { lua_codeadjust(0); }
+	  |	parlist1    { lua_codeadjust(0); $$ = lua_linenumber; }
 	  ;
 		
-parlist1 :	NAME		  
+parlist1 :	NAME		  { add_localvar($1); }
-		{
+	  |	parlist1 ',' NAME { add_localvar($3); }
-		 localvar[nlocalvar]=luaI_findsymbol($1); 
-		 add_nlocalvar(1);
-		}
-	  |	parlist1 ',' NAME 
-		{
-		 localvar[nlocalvar]=luaI_findsymbol($3); 
-		 add_nlocalvar(1);
-		}
 	  ;
 		
-fieldlist  : /* empty */ { $$ =  0; }
+fieldlist  : lfieldlist
-	   | lfieldlist1 lastcomma
+  	     { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
-  	     { $$ = $1; flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+	     semicolonpart
+	     { $$ = $1+$3; }
 	   | ffieldlist1 lastcomma
 	     { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
-	   | lfieldlist1 ';' 
-	     { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
-	    ffieldlist1 lastcomma
-	     { $$ = $1+$4; flush_record($4%FIELDS_PER_FLUSH); }
 	   ;
 
+semicolonpart : /* empty */
+	        { $$ = 0; }
+	      | ';' ffieldlist
+	        { $$ = $2; flush_record($2%FIELDS_PER_FLUSH); }
+	      ;
+
 lastcomma  : /* empty */ 
 	   | ','
 	   ;
 
+ffieldlist  : /* empty */ { $$ = 0; }
+            | ffieldlist1 lastcomma { $$ = $1; }
+            ;   
+
 ffieldlist1 : ffield			{$$=1;}
 	   | ffieldlist1 ',' ffield	
 		{
@@ -671,6 +723,10 @@ ffield      : NAME '=' expr1
 	      }
            ;
 
+lfieldlist  : /* empty */ { $$ = 0; }
+	    | lfieldlist1 lastcomma { $$ = $1; }
+	    ;
+
 lfieldlist1 : expr1  {$$=1;}
 	    | lfieldlist1 ',' expr1
 		{
@@ -683,12 +739,12 @@ lfieldlist1 : expr1  {$$=1;}
 varlist1  :	var			
 	  {
 	   nvarbuffer = 0; 
-           varbuffer[nvarbuffer] = $1; incr_nvarbuffer();
+	   add_varbuffer($1);
 	   $$ = ($1 == 0) ? 1 : 0;
 	  }
 	  |	varlist1 ',' var	
 	  { 
-           varbuffer[nvarbuffer] = $3; incr_nvarbuffer();
+	   add_varbuffer($3);
 	   $$ = ($3 == 0) ? $1 + 1 : $1;
 	  }
 	  ;
@@ -708,10 +764,9 @@ var	  :	singlevar { $$ = $1; }
 		
 singlevar :	NAME
 	  {
-	   Word s = luaI_findsymbol($1);
+	   int local = lua_localname($1);
-	   int local = lua_localname (s);
 	   if (local == -1)	/* global var */
-	    $$ = s + 1;		/* return positive value */
+	    $$ = luaI_findsymbol($1)+1;  /* return positive value */
            else
 	    $$ = -(local+1);		/* return negative value */
 	  }
@@ -720,10 +775,10 @@ singlevar :	NAME
 varexp	: var { lua_pushvar($1); }
 	;
 	  
-localdeclist  : NAME {localvar[nlocalvar]=luaI_findsymbol($1); $$ = 1;}
+localdeclist  : NAME {store_localvar($1, 0); $$ = 1;}
      	  | localdeclist ',' NAME 
 	    {
-	     localvar[nlocalvar+$1]=luaI_findsymbol($3); 
+	     store_localvar($3, $1);
 	     $$ = $1+1;
 	    }
 	  ;
@@ -732,7 +787,8 @@ decinit	  : /* empty */  { $$ = 0; }
 	  | '=' exprlist1 { $$ = $2; }
 	  ;
 	  
-setdebug  : DEBUG {lua_debug = $1;}
+setdebug  : DEBUG  { lua_debug = $1; }
+	  ;
 
 %%
 
@@ -752,8 +808,8 @@ static void PrintCode (Byte *code, Byte *end)
     			p++;
    			break;
    case PUSHBYTE:
-    			printf ("%d    PUSHBYTE   %d\n", p-code, *(++p));
+    			printf ("%d    PUSHBYTE   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
    case PUSHWORD:
                         {
@@ -788,7 +844,7 @@ static void PrintCode (Byte *code, Byte *end)
 			 int n = p-code;
 			 p++;
 			 get_code(c,p);
-			 printf ("%d    PUSHFUNCTION  %p\n", n, c.b);
+			 printf ("%d    PUSHFUNCTION  %p\n", n, c.tf);
 			}
 			break;
 
@@ -798,8 +854,8 @@ static void PrintCode (Byte *code, Byte *end)
     			printf ("%d    PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
     			p++;
    			break;
-   case PUSHLOCAL:	printf ("%d    PUSHLOCAL   %d\n", p-code, *(++p));
+   case PUSHLOCAL:	printf ("%d    PUSHLOCAL   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
    case PUSHGLOBAL:
     			{
@@ -818,8 +874,8 @@ static void PrintCode (Byte *code, Byte *end)
     			p++;
    			break;
    case STORELOCAL:
-    			printf ("%d    STORELOCAL   %d\n", p-code, *(++p));
+    			printf ("%d    STORELOCAL   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
    case STOREGLOBAL:
     			{
@@ -840,25 +896,25 @@ static void PrintCode (Byte *code, Byte *end)
 			}
 			break;
    case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
-   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
+   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
    case STORELIST0:
-	printf("%d      STORELIST0  %d\n", p-code, *(++p));
+	printf("%d      STORELIST0  %d\n", p-code, *(p+1));
-        p++;
+        p+=2+;
         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));
+       printf("%d      STORERECORD  %d\n", p-code, *(p+1));
-       p += *p*sizeof(Word) + 1;
+       p += *p*sizeof(Word) + 2;
        break;
    case ADJUST0: printf ("%d    ADJUST0\n", (p++)-code); break;
    case ADJUST:
-    			printf ("%d    ADJUST   %d\n", p-code, *(++p));
+    			printf ("%d    ADJUST   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
    case CREATEARRAY:	
     {
@@ -941,20 +997,9 @@ static void PrintCode (Byte *code, Byte *end)
 	break;
    case RETCODE0: printf ("%d    RETCODE0\n", (p++)-code); break;
    case RETCODE:
-    			printf ("%d    RETCODE   %d\n", p-code, *(++p));
+    			printf ("%d    RETCODE   %d\n", p-code, *(p+1));
-    			p++;
+    			p+=2;
    			break;
-   case SETFUNCTION:
-                        {
-			 CodeCode c1;
-                         CodeWord c2;
-                         int n = p-code;
-                         p++;
-                         get_code(c1,p);
-                         get_word(c2,p);
-                         printf ("%d    SETFUNCTION  %s  %d\n", n, (char *)c1.b, c2.w);
-                        }
-                        break;
    case SETLINE:
                         {
                          CodeWord c;
@@ -965,8 +1010,9 @@ static void PrintCode (Byte *code, Byte *end)
                         }
                         break;
 
-   case RESET:		printf ("%d    RESET\n", (p++)-code); break;
+   default:		printf ("%d    Cannot happen: code %d\n", p-code, *p));
-   default:		printf ("%d    Cannot happen: code %d\n", (p++)-code, *(p-1)); break;
+                        p+=1;
+                        break;
   }
  }
 }

luadebug.h

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

lualib.h

@@ -2,7 +2,7 @@
 ** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: lualib.h,v 1.2 1994/08/24 15:29:02 celes Stab roberto $
+** $Id: lualib.h,v 1.5 1996/01/22 17:38:57 roberto Exp roberto $
 */
 
 #ifndef lualib_h
@@ -12,5 +12,12 @@ void iolib_open   (void);
 void strlib_open  (void);
 void mathlib_open (void);
 
+
+/* auxiliar functions (private) */
+void lua_arg_error(char *funcname);
+char *lua_check_string (int numArg, char *funcname);
+double lua_check_number (int numArg, char *funcname);
+char *luaI_addchar (int c);
+
 #endif
 

luamem.c

@@ -3,13 +3,27 @@
 ** 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.6 1996/01/22 14:15:13 roberto Exp roberto $";
 
 #include <stdlib.h>
 #include <string.h>
+#include <stdio.h>
 
 #include "mem.h"
 #include "lua.h"
+#include "table.h"
+
+static void mem_error (void)
+{
+  Long recovered = luaI_collectgarbage();  /* try to collect garbage  */
+  if (recovered)
+    lua_error("not enough memory");
+  else
+  { /* if there is no garbage then must exit */
+    fprintf(stderr, "lua error: memory overflow - unable to recover\n");
+    exit(1);
+  }
+}
 
 void luaI_free (void *block)
 {
@@ -22,7 +36,7 @@ void *luaI_malloc (unsigned long size)
 {
   void *block = malloc((size_t)size);
   if (block == NULL)
-    lua_error("not enough memory");
+    mem_error();
   return block;
 }
 
@@ -31,7 +45,7 @@ void *luaI_realloc (void *oldblock, unsigned long size)
 {
   void *block = realloc(oldblock, (size_t)size);
   if (block == NULL)
-    lua_error("not enough memory");
+    mem_error();
   return block;
 }
 

makefile

@@ -1,7 +1,12 @@
-# $Id: makefile,v 1.12 1995/02/02 19:02:03 roberto Exp $
+# $Id: makefile,v 1.19 1996/02/07 18:14:38 roberto Exp roberto $
+
+#configuration
+
+# define (undefine) POPEN if your system (does not) support piped I/O
+CONFIG = -DPOPEN
 # Compilation parameters
 CC = gcc
-CFLAGS = -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
+CFLAGS = $(CONFIG) -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
 
 #CC = acc
 #CFLAGS = -fast -I/usr/5include
@@ -10,30 +15,28 @@ AR = ar
 ARFLAGS	= rvl
 
 # Aplication modules
-LUAMOD =	\
+LUAOBJS = \
-	parser 	\
+	parser.o \
-	lex	\
+	lex.o \
-	opcode	\
+	opcode.o \
-	hash	\
+	hash.o \
-	table	\
+	table.o \
-	inout	\
+	inout.o \
-	tree    \
+	tree.o \
-	fallback\
+	fallback.o \
-	mem
+	mem.o \
+	func.o
 
-LIBMOD = 	\
+LIBOBJS = 	\
-	iolib	\
+	iolib.o \
-	strlib	\
+	mathlib.o \
-	mathlib
+	strlib.o
 
-LUAOBJS	= $(LUAMOD:%=%.o)
-
-LIBOBJS	= $(LIBMOD:%=%.o)
 
 lua : lua.o lua.a lualib.a
-	$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
+	$(CC) $(CFLAGS) -o $@ lua.o lua.a lualib.a -lm
 
-lua.a : parser.c $(LUAOBJS)
+lua.a : parser.o $(LUAOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib lua.a
 
@@ -44,35 +47,40 @@ lualib.a : $(LIBOBJS)
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
-%.o	: %.c
+y.tab.c y.tab.h  : lua.stx
-	$(CC) $(CFLAGS) -c -o $@ $<
+	yacc++ -d lua.stx
 
+parser.c : y.tab.c
+	sed -e 's/yy/luaY_/g' y.tab.c > parser.c
 
-parser.c : lua.stx
+parser.h : y.tab.h
-	yacc++ -d lua.stx ; mv -f y.tab.c parser.c ; mv -f y.tab.h parser.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
+	co lua.h lualib.h luadebug.h
 
 % : RCS/%,v
 	co $@
 
 
-fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h inout.h 
+fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h func.h 
-hash.o : hash.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+func.o : func.c luadebug.h lua.h table.h tree.h types.h opcode.h func.h mem.h 
-inout.o : inout.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+hash.o : hash.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h 
-iolib.o : iolib.c mem.h lua.h lualib.h 
+inout.o : inout.c lex.h opcode.h lua.h types.h tree.h func.h inout.h table.h 
-lex.o : lex.c tree.h types.h table.h opcode.h lua.h inout.h parser.h ugly.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 ugly.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 
+mem.o : mem.c mem.h lua.h table.h tree.h types.h opcode.h func.h 
-opcode.o : opcode.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
+opcode.o : opcode.c luadebug.h lua.h mem.h opcode.h types.h tree.h func.h hash.h \
-  fallback.h 
+  inout.h table.h fallback.h 
-strlib.o : strlib.c mem.h lua.h lualib.h 
+parser.o : parser.c luadebug.h lua.h mem.h lex.h opcode.h types.h tree.h func.h \
-table.o : table.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
+  hash.h inout.h table.h 
-  fallback.h 
+strlib.o : strlib.c lua.h lualib.h 
-tree.o : tree.c mem.h lua.h tree.h types.h table.h opcode.h 
+table.o : table.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h \
-parser.o : parser.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+  inout.h fallback.h luadebug.h 
+tree.o : tree.c mem.h lua.h tree.h types.h hash.h opcode.h func.h table.h 

mathlib.c

@@ -3,27 +3,23 @@
 ** Mathematics library to LUA
 */
 
-char *rcs_mathlib="$Id: mathlib.c,v 1.8 1995/01/04 18:49:54 roberto Exp $";
+char *rcs_mathlib="$Id: mathlib.c,v 1.13 1995/11/10 17:54:31 roberto Exp roberto $";
 
-#include <stdio.h>		/* NULL */
+#include <stdlib.h>
 #include <math.h>
 
 #include "lualib.h"
 #include "lua.h"
 
+#ifndef PI
 #define PI          3.14159265358979323846
+#endif
 #define TODEGREE(a) ((a)*180.0/PI)
 #define TORAD(a)    ((a)*PI/180.0)
 
 static void math_abs (void)
 {
- double d;
+ double d = lua_check_number(1, "abs"); 
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `abs'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `abs'");
- d = lua_getnumber(o);
  if (d < 0) d = -d;
  lua_pushnumber (d);
 }
@@ -31,13 +27,7 @@ static void math_abs (void)
 
 static void math_sin (void)
 {
- double d;
+ double d = lua_check_number(1, "sin");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `sin'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `sin'");
- d = lua_getnumber(o);
  lua_pushnumber (sin(TORAD(d)));
 }
 
@@ -45,13 +35,7 @@ static void math_sin (void)
 
 static void math_cos (void)
 {
- double d;
+ double d = lua_check_number(1, "cos");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `cos'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `cos'");
- d = lua_getnumber(o);
  lua_pushnumber (cos(TORAD(d)));
 }
 
@@ -59,104 +43,64 @@ static void math_cos (void)
 
 static void math_tan (void)
 {
- double d;
+ double d = lua_check_number(1, "tan");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `tan'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `tan'");
- d = lua_getnumber(o);
  lua_pushnumber (tan(TORAD(d)));
 }
 
 
 static void math_asin (void)
 {
- double d;
+ double d = lua_check_number(1, "asin");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `asin'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `asin'");
- d = lua_getnumber(o);
  lua_pushnumber (TODEGREE(asin(d)));
 }
 
 
 static void math_acos (void)
 {
- double d;
+ double d = lua_check_number(1, "acos");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `acos'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `acos'");
- d = lua_getnumber(o);
  lua_pushnumber (TODEGREE(acos(d)));
 }
 
 
-
 static void math_atan (void)
 {
- double d;
+ double d = lua_check_number(1, "atan");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `atan'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `atan'");
- d = lua_getnumber(o);
  lua_pushnumber (TODEGREE(atan(d)));
 }
 
 
+static void math_atan2 (void)
+{
+ double d1 = lua_check_number(1, "atan2");
+ double d2 = lua_check_number(2, "atan2");
+ lua_pushnumber (TODEGREE(atan2(d1, d2)));
+}
+
+
 static void math_ceil (void)
 {
- double d;
+ double d = lua_check_number(1, "ceil");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `ceil'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `ceil'");
- d = lua_getnumber(o);
  lua_pushnumber (ceil(d));
 }
 
 
 static void math_floor (void)
 {
- double d;
+ double d = lua_check_number(1, "floor");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `floor'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `floor'");
- d = lua_getnumber(o);
  lua_pushnumber (floor(d));
 }
 
 static void math_mod (void)
 {
- int d1, d2;
+ int d1 = (int)lua_check_number(1, "mod");
- lua_Object o1 = lua_getparam (1);
+ int d2 = (int)lua_check_number(2, "mod");
- lua_Object o2 = lua_getparam (2);
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
-   lua_error ("incorrect arguments to function `mod'");
- d1 = (int) lua_getnumber(o1);
- d2 = (int) lua_getnumber(o2);
  lua_pushnumber (d1%d2);
 }
 
 
 static void math_sqrt (void)
 {
- double d;
+ double d = lua_check_number(1, "sqrt");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `sqrt'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `sqrt'");
- d = lua_getnumber(o);
  lua_pushnumber (sqrt(d));
 }
 
@@ -187,107 +131,71 @@ static void math_pow (void)
 static void math_min (void)
 {
  int i=1;
- double d, dmin;
+ double dmin = lua_check_number(i, "min");
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `min'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `min'");
- dmin = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
  {
-  if (!lua_isnumber(o))
+  double d = lua_check_number(i, "min");
-    lua_error ("incorrect arguments to function `min'");
-  d = lua_getnumber (o);
   if (d < dmin) dmin = d;
  }
  lua_pushnumber (dmin);
 }
 
-
 static void math_max (void)
 {
  int i=1;
- double d, dmax;
+ double dmax = lua_check_number(i, "max");
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `max'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `max'");
- dmax = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
  {
-  if (!lua_isnumber(o))
+  double d = lua_check_number(i, "max");
-    lua_error ("incorrect arguments to function `max'");
-  d = lua_getnumber (o);
   if (d > dmax) dmax = d;
  }
  lua_pushnumber (dmax);
 }
 
-
 static void math_log (void)
 {
- double d;
+ double d = lua_check_number(1, "log");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `log'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `log'");
- d = lua_getnumber(o);
  lua_pushnumber (log(d));
 }
 
 
 static void math_log10 (void)
 {
- double d;
+ double d = lua_check_number(1, "log10");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `log10'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `log10'");
- d = lua_getnumber(o);
  lua_pushnumber (log10(d));
 }
 
 
 static void math_exp (void)
 {
- double d;
+ double d = lua_check_number(1, "exp");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `exp'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `exp'");
- d = lua_getnumber(o);
  lua_pushnumber (exp(d));
 }
 
 static void math_deg (void)
 {
- float d;
+ float d = lua_check_number(1, "deg");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `deg'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `deg'");
- d = lua_getnumber(o);
  lua_pushnumber (d*180./PI);
 }
 
 static void math_rad (void)
 {
- float d;
+ float d = lua_check_number(1, "rad");
- lua_Object o = lua_getparam (1);
- if (o == LUA_NOOBJECT)
-   lua_error ("too few arguments to function `rad'");
- if (!lua_isnumber(o))
-   lua_error ("incorrect arguments to function `rad'");
- d = lua_getnumber(o);
  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"));
+}
+
+
+
 /*
 ** Open math library
 */
@@ -300,6 +208,7 @@ void mathlib_open (void)
  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);
@@ -311,5 +220,8 @@ void mathlib_open (void)
  lua_register ("exp",   math_exp);
  lua_register ("deg",   math_deg);
  lua_register ("rad",   math_rad);
+ lua_register ("random",     math_random);
+ lua_register ("randomseed", math_randomseed);
+
  old_pow = lua_lockobject(lua_setfallback("arith", math_pow));
 }

opcode.c

@@ -3,14 +3,14 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 3.33 1995/02/02 20:05:37 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 3.56 1996/02/08 17:03:20 roberto Exp roberto $";
 
 #include <setjmp.h>
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
-#include <math.h>
 
+#include "luadebug.h"
 #include "mem.h"
 #include "opcode.h"
 #include "hash.h"
@@ -23,13 +23,15 @@ char *rcs_opcode="$Id: opcode.c,v 3.33 1995/02/02 20:05:37 roberto Exp roberto $
 #define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
 
 
-#define STACK_BUFFER (STACKGAP+128)
+#define STACK_SIZE 	128
 
 typedef int StkId;  /* index to stack elements */
 
-static Long    maxstack = 0L;
+static Object initial_stack;
-static Object *stack = NULL;
+
-static Object *top = NULL;
+static Object *stackLimit = &initial_stack+1;
+static Object *stack = &initial_stack;
+static Object *top = &initial_stack;
 
 
 /* macros to convert from lua_Object to (Object *) and back */
@@ -38,6 +40,11 @@ static Object *top = NULL;
 #define Ref(st)         ((st)-stack+1)
  
 
+/* macro to increment stack top. There must be always an empty slot in
+*  the stack
+*/
+#define incr_top	if (++top >= stackLimit) growstack()
+
 static StkId CBase = 0;  /* when Lua calls C or C calls Lua, points to */
                           /* the first slot after the last parameter. */
 static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
@@ -46,8 +53,13 @@ static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
 static  jmp_buf *errorJmp = NULL; /* current error recover point */
 
 
+/* Hooks */
+static lua_LHFunction line_hook = NULL;
+static lua_CHFunction call_hook = NULL;
+
+
 static StkId lua_execute (Byte *pc, StkId base);
-static void do_call (Object *func, StkId base, int nResults, StkId whereRes);
+static void do_call (StkId base, int nResults);
 
 
 
@@ -58,28 +70,20 @@ Object *luaI_Address (lua_Object o)
 
 
 /*
-** Error messages
+** Functions to change hook functions.
 */
-
+lua_LHFunction lua_setlinehook (lua_LHFunction hook)
-static void lua_message (char *s)
 {
-  lua_pushstring(s);
+  lua_LHFunction temp = line_hook;
-  do_call(&luaI_fallBacks[FB_ERROR].function, (top-stack)-1, 0, (top-stack)-1);
+  line_hook = hook;
+  return temp;
 }
 
-/*
+lua_CHFunction lua_setcallhook (lua_CHFunction hook)
-** Reports an error, and jumps up to the available recover label
-*/
-void lua_error (char *s)
 {
-  if (s) lua_message(s);
+  lua_CHFunction temp = call_hook;
-  if (errorJmp)
+  call_hook = hook;
-    longjmp(*errorJmp, 1);
+  return temp;
-  else
-  {
-    fprintf (stderr, "lua: exit(1). Unable to recover\n");
-    exit(1);
-  }
 }
 
 
@@ -88,30 +92,34 @@ void lua_error (char *s)
 */
 static void lua_initstack (void)
 {
- maxstack = STACK_BUFFER;
+ Long maxstack = STACK_SIZE;
  stack = newvector(maxstack, Object);
+ stackLimit = stack+maxstack;
  top = stack;
+ *(top++) = initial_stack;
 }
 
 
 /*
 ** Check stack overflow and, if necessary, realloc vector
 */
-#define lua_checkstack(n)  if ((Long)(n) > maxstack) checkstack(n)
+#define lua_checkstack(nt)  if ((nt) >= stackLimit) growstack()
 
-static void checkstack (StkId n)
+static void growstack (void)
 {
- StkId t;
+ if (stack == &initial_stack)
- if (stack == NULL)
    lua_initstack();
- if (maxstack >= MAX_INT)
+ else
-   lua_error("stack size overflow");
+ {
- t = top-stack;
+  StkId t = top-stack;
- maxstack *= 2;
+  Long maxstack = stackLimit - stack;
- if (maxstack >= MAX_INT)
+  maxstack *= 2;
-   maxstack = MAX_INT;
+  stack = growvector(stack, maxstack, Object);
- stack = growvector(stack, maxstack, Object);
+  stackLimit = stack+maxstack;
- top = stack + t;
+  top = stack + t;
+  if (maxstack >= MAX_WORD/2)
+    lua_error("stack size overflow");
+ }
 }
 
 
@@ -184,15 +192,67 @@ static int lua_tostring (Object *obj)
 */
 static void adjust_top (StkId newtop)
 {
-  Object *nt = stack+newtop;
+  Object *nt;
+  lua_checkstack(stack+newtop);
+  nt = stack+newtop;  /* warning: previous call may change stack */
   while (top < nt) tag(top++) = LUA_T_NIL;
   top = nt;  /* top could be bigger than newtop */
 }
 
+#define adjustC(nParams)	adjust_top(CBase+nParams)
 
-static void adjustC (int nParams)
+
+/*
+** Open a hole below "nelems" from the top.
+*/
+static void open_stack (int nelems)
 {
-  adjust_top(CBase+nParams);
+  int i;
+  for (i=0; i<nelems; i++)
+    *(top-i) = *(top-i-1);
+  incr_top;
+}
+
+
+/*
+** call Line hook
+*/
+static void lineHook (int line)
+{
+  StkId oldBase = CBase;
+  int oldCnResults = CnResults;
+  StkId old_top = CBase = top-stack;
+  CnResults = 0;
+  (*line_hook)(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)
+    (*call_hook)(LUA_NOOBJECT, "(return)", 0);
+  else
+  {
+    Object *f = stack+base-1;
+    if (type == LUA_T_MARK)
+      (*call_hook)(Ref(f), f->value.tf->fileName, f->value.tf->lineDefined);
+    else
+      (*call_hook)(Ref(f), "(C)", -1);
+  }
+  top = stack+old_top;
+  CnResults = oldCnResults;
+  CBase = oldBase;
 }
 
 
@@ -208,8 +268,15 @@ 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 */
-  (*func)();
+  if (call_hook)
+  {
+    callHook (base, LUA_T_CMARK, 0);
+    (*func)();
+    callHook (base, LUA_T_CMARK, 1);
+  }
+  else
+    (*func)();
   firstResult = CBase;
   CBase = oldBase;
   CnResults = oldCnResults;
@@ -217,50 +284,55 @@ static StkId callC (lua_CFunction func, StkId base)
 }
 
 /*
-** Call the fallback for invalid functions (see do_call)
+** Call the specified fallback, putting it on the stack below its arguments
 */
-static void call_funcFB (Object *func, StkId base, int nResults, StkId whereRes)
+static void callFB (int fb)
 {
-  StkId i;
+  int nParams = luaI_fallBacks[fb].nParams;
-  /* open space for first parameter (func) */
+  open_stack(nParams);
-  for (i=top-stack; i>base; i--)
+  *(top-nParams-1) = luaI_fallBacks[fb].function;
-    stack[i] = stack[i-1];
+  do_call((top-stack)-nParams, luaI_fallBacks[fb].nResults);
-  top++;
-  stack[base] = *func;
-  do_call(&luaI_fallBacks[FB_FUNCTION].function, base, nResults, whereRes);
 }
 
 
 /*
 ** Call a function (C or Lua). The parameters must be on the stack,
-** between [stack+base,top). When returns, the results are on the stack,
+** between [stack+base,top). The function to be called is at stack+base-1.
-** between [stack+whereRes,top). The number of results is nResults, unless
+** When returns, the results are on the stack, between [stack+base-1,top).
-** nResults=MULT_RET.
+** The number of results is nResults, unless nResults=MULT_RET.
 */
-static void do_call (Object *func, StkId base, int nResults, StkId whereRes)
+static void do_call (StkId base, int nResults)
 {
   StkId firstResult;
+  Object *func = stack+base-1;
+  int i;
   if (tag(func) == LUA_T_CFUNCTION)
+  {
+    tag(func) = LUA_T_CMARK;
     firstResult = callC(fvalue(func), base);
+  }
   else if (tag(func) == LUA_T_FUNCTION)
-    firstResult = lua_execute(bvalue(func), base);
+  {
+    tag(func) = LUA_T_MARK;
+    firstResult = lua_execute(func->value.tf->code, base);
+  }
   else
   { /* func is not a function */
-    call_funcFB(func, base, nResults, whereRes);
+    /* Call the fallback for invalid functions */
+    open_stack((top-stack)-(base-1));
+    stack[base-1] = luaI_fallBacks[FB_FUNCTION].function;
+    do_call(base, nResults);
     return;
   }
   /* adjust the number of results */
   if (nResults != MULT_RET && top - (stack+firstResult) != nResults)
     adjust_top(firstResult+nResults);
-  /* move results to the given position */
+  /* move results to base-1 (to erase parameters and function) */
-  if (firstResult != whereRes)
+  base--;
-  {
+  nResults = top - (stack+firstResult);  /* actual number of results */
-    int i;
+  for (i=0; i<nResults; i++)
-    nResults = top - (stack+firstResult);  /* actual number of results */
+    *(stack+base+i) = *(stack+firstResult+i);
-    for (i=0; i<nResults; i++)
+  top -= firstResult-base;
-      *(stack+whereRes+i) = *(stack+firstResult+i);
-    top -= firstResult-whereRes;
-  }
 }
 
 
@@ -271,12 +343,12 @@ static void do_call (Object *func, StkId base, int nResults, StkId whereRes)
 static void pushsubscript (void)
 {
   if (tag(top-2) != LUA_T_ARRAY)
-    do_call(&luaI_fallBacks[FB_GETTABLE].function, (top-stack)-2, 1, (top-stack)-2);
+    callFB(FB_GETTABLE);
   else 
   {
     Object *h = lua_hashget(avalue(top-2), top-1);
     if (h == NULL || tag(h) == LUA_T_NIL)
-      do_call(&luaI_fallBacks[FB_INDEX].function, (top-stack)-2, 1, (top-stack)-2);
+      callFB(FB_INDEX);
     else
     {
       --top;
@@ -292,7 +364,7 @@ static void pushsubscript (void)
 static void storesubscript (void)
 {
  if (tag(top-3) != LUA_T_ARRAY)
-   do_call(&luaI_fallBacks[FB_SETTABLE].function, (top-stack)-3, 0, (top-stack)-3);
+   callFB(FB_SETTABLE);
  else
  {
   Object *h = lua_hashdefine (avalue(top-3), top-2);
@@ -302,22 +374,110 @@ 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
 */
-void lua_travstack (void (*fn)(Object *))
+void lua_travstack (int (*fn)(Object *))
 {
  Object *o;
  for (o = top-1; o >= stack; o--)
-  fn (o);
+   fn (o);
 }
 
 
 /*
-** Execute a protected call. If function is null compiles the pre-set input.
+** Error messages and debug functions
-** Leave nResults on the stack.
 */
-static int do_protectedrun (Object *function, int nResults)
+
+static void lua_message (char *s)
+{
+  lua_pushstring(s);
+  callFB(FB_ERROR);
+}
+
+/*
+** Reports an error, and jumps up to the available recover label
+*/
+void lua_error (char *s)
+{
+  if (s) lua_message(s);
+  if (errorJmp)
+    longjmp(*errorJmp, 1);
+  else
+  {
+    fprintf (stderr, "lua: exit(1). Unable to recover\n");
+    exit(1);
+  }
+}
+
+
+lua_Function lua_stackedfunction (int level)
+{
+  Object *p = top;
+  while (--p >= stack)
+    if (p->tag == LUA_T_MARK || p->tag == LUA_T_CMARK)
+      if (level-- == 0)
+        return Ref(p);
+  return LUA_NOOBJECT;
+}
+
+
+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. 
+*/
+static int do_protectedrun (int nResults)
 {
   jmp_buf myErrorJmp;
   int status;
@@ -326,13 +486,13 @@ static int do_protectedrun (Object *function, int nResults)
   errorJmp = &myErrorJmp;
   if (setjmp(myErrorJmp) == 0)
   {
-    do_call(function, CBase, nResults, CBase);
+    do_call(CBase+1, nResults);
     CnResults = (top-stack) - CBase;  /* number of results */
     CBase += CnResults;  /* incorporate results on the stack */
     status = 0;
   }
   else
-  {
+  { /* an error occurred: restore CBase and top */
     CBase = oldCBase;
     top = stack+CBase;
     status = 1;
@@ -344,27 +504,29 @@ static int do_protectedrun (Object *function, int nResults)
 
 static int do_protectedmain (void)
 {
-  Byte *code = NULL;
+  TFunc tf;
   int status;
-  StkId oldCBase = CBase;
   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;
+  luaI_initTFunc(&tf);
+  tf.fileName = lua_parsedfile;
   if (setjmp(myErrorJmp) == 0)
   {
-    Object f;
+    lua_parse(&tf);
-    lua_parse(&code);
+    status = do_protectedrun(0);
-    tag(&f) = LUA_T_FUNCTION; bvalue(&f) = code;
-    do_call(&f, CBase, 0, CBase);
-    status = 0;
   }
   else
+  {
     status = 1;
-  if (code)
+    adjustC(0);  /* erase extra slot */
-    luaI_free(code);
+  }
   errorJmp = oldErr;
-  CBase = oldCBase;
+  if (tf.code)
-  top = stack+CBase;
+    luaI_free(tf.code);
   return status;
 }
 
@@ -377,14 +539,20 @@ int lua_callfunction (lua_Object function)
   if (function == LUA_NOOBJECT)
     return 1;
   else
-    return do_protectedrun (Address(function), MULT_RET);
+  {
+    open_stack((top-stack)-CBase);
+    stack[CBase] = *Address(function);
+    return do_protectedrun (MULT_RET);
+  }
 }
 
 
 int lua_call (char *funcname)
 {
  Word n = luaI_findsymbolbyname(funcname);
- return do_protectedrun(&s_object(n), MULT_RET);
+ open_stack((top-stack)-CBase);
+ stack[CBase] = s_object(n);
+ return do_protectedrun(MULT_RET);
 }
 
 
@@ -395,12 +563,8 @@ int lua_call (char *funcname)
 int lua_dofile (char *filename)
 {
   int status;
-  char *message = lua_openfile (filename);
+  if (lua_openfile(filename))
-  if (message)
-  {
-    lua_message(message);
     return 1;
-  }
   status = do_protectedmain();
   lua_closefile();
   return status;
@@ -413,12 +577,7 @@ int lua_dofile (char *filename)
 int lua_dostring (char *string)
 {
   int status;
-  char *message = lua_openstring(string);
+  lua_openstring(string);
-  if (message)
-  {
-    lua_message(message);
-    return 1;
-  }
   status = do_protectedmain();
   lua_closestring();
   return status;
@@ -430,12 +589,15 @@ int lua_dostring (char *string)
 */
 lua_Object lua_setfallback (char *name, lua_CFunction fallback)
 {
-  static Object func = {LUA_T_CFUNCTION, luaI_setfallback};
+  adjustC(1);  /* one slot for the pseudo-function */
-  adjustC(0);
+  stack[CBase].tag = LUA_T_CFUNCTION;
+  stack[CBase].value.f = luaI_setfallback;
   lua_pushstring(name);
   lua_pushcfunction(fallback);
-  do_protectedrun(&func, 1);
+  if (do_protectedrun(1) == 0)
-  return (Ref(top-1));
+    return (Ref(top-1));
+  else
+    return LUA_NOOBJECT;
 }
 
 
@@ -497,7 +659,7 @@ lua_Object lua_createtable (void)
   adjustC(0);
   avalue(top) = lua_createarray(0);
   tag(top) = LUA_T_ARRAY;
-  top++;
+  incr_top;
   CBase++;  /* incorporate object in the stack */
   return Ref(top-1);
 }
@@ -519,9 +681,9 @@ lua_Object lua_getparam (int number)
 */
 real lua_getnumber (lua_Object object)
 {
- if (object == LUA_NOOBJECT || tag(Address(object)) == LUA_T_NIL) return 0.0;
+ if (object == LUA_NOOBJECT) return 0.0;
  if (tonumber (Address(object))) return 0.0;
- else                   return (nvalue(Address(object)));
+ else return (nvalue(Address(object)));
 }
 
 /*
@@ -529,7 +691,7 @@ real lua_getnumber (lua_Object object)
 */
 char *lua_getstring (lua_Object object)
 {
- if (object == LUA_NOOBJECT || tag(Address(object)) == LUA_T_NIL) return NULL;
+ if (object == LUA_NOOBJECT) return NULL;
  if (tostring (Address(object))) return NULL;
  else return (svalue(Address(object)));
 }
@@ -559,7 +721,7 @@ lua_Object lua_getlocked (int ref)
 {
  adjustC(0);
  *top = *luaI_getlocked(ref);
- top++;
+ incr_top;
  CBase++;  /* incorporate object in the stack */
  return Ref(top-1);
 }
@@ -567,9 +729,8 @@ lua_Object lua_getlocked (int ref)
 
 void lua_pushlocked (int ref)
 {
- lua_checkstack(top-stack+1);
  *top = *luaI_getlocked(ref);
- top++;
+ incr_top;
 }
 
 
@@ -580,15 +741,14 @@ int lua_lock (void)
 }
 
 
+
 /*
-** Get a global object. Return the object handle or NULL on error.
+** Get a global object.
 */
 lua_Object lua_getglobal (char *name)
 {
- Word n = luaI_findsymbolbyname(name);
  adjustC(0);
- *top = s_object(n);
+ getglobal(luaI_findsymbolbyname(name));
- top++;
  CBase++;  /* incorporate object in the stack */
  return Ref(top-1);
 }
@@ -608,8 +768,8 @@ void lua_storeglobal (char *name)
 */
 void lua_pushnil (void)
 {
- lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_NIL;
- tag(top++) = LUA_T_NIL;
+ incr_top;
 }
 
 /*
@@ -617,8 +777,8 @@ void lua_pushnil (void)
 */
 void lua_pushnumber (real n)
 {
- lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_NUMBER; nvalue(top) = n;
- tag(top) = LUA_T_NUMBER; nvalue(top++) = n;
+ incr_top;
 }
 
 /*
@@ -626,21 +786,9 @@ void lua_pushnumber (real n)
 */
 void lua_pushstring (char *s)
 {
- lua_checkstack(top-stack+1);
  tsvalue(top) = lua_createstring(s);
  tag(top) = LUA_T_STRING;
- top++;
+ incr_top;
-}
-
-/*
-** Push an object (tag=string) on stack and register it on the constant table.
-*/
-void lua_pushliteral (char *s)
-{
- lua_checkstack(top-stack+1);
- tsvalue(top) = lua_constant[luaI_findconstant(lua_constcreate(s))];
- tag(top) = LUA_T_STRING;
- top++;
 }
 
 /*
@@ -648,8 +796,8 @@ void lua_pushliteral (char *s)
 */
 void lua_pushcfunction (lua_CFunction fn)
 {
- lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_CFUNCTION; fvalue(top) = fn;
- tag(top) = LUA_T_CFUNCTION; fvalue(top++) = fn;
+ incr_top;
 }
 
 /*
@@ -658,8 +806,8 @@ void lua_pushcfunction (lua_CFunction fn)
 void lua_pushusertag (void *u, int tag)
 {
  if (tag < LUA_T_USERDATA) return;
- lua_checkstack(top-stack+1);
+ tag(top) = tag; uvalue(top) = u;
- tag(top) = tag; uvalue(top++) = u;
+ incr_top;
 }
 
 /*
@@ -667,8 +815,8 @@ void lua_pushusertag (void *u, int tag)
 */
 void lua_pushobject (lua_Object o)
 {
- lua_checkstack(top-stack+1);
+ *top = *Address(o);
- *top++ = *Address(o);
+ incr_top;
 }
 
 /*
@@ -676,8 +824,8 @@ void lua_pushobject (lua_Object o)
 */
 void luaI_pushobject (Object *o)
 {
- lua_checkstack(top-stack+1);
+ *top = *o;
- *top++ = *o;
+ incr_top;
 }
 
 int lua_type (lua_Object o)
@@ -691,15 +839,16 @@ int lua_type (lua_Object o)
 
 void luaI_gcFB (Object *o)
 {
-  *(top++) = *o;
+  *top = *o;
-  do_call(&luaI_fallBacks[FB_GC].function, (top-stack)-1, 0, (top-stack)-1);
+  incr_top;
+  callFB(FB_GC);
 }
 
 
 static void call_arith (char *op)
 {
   lua_pushstring(op);
-  do_call(&luaI_fallBacks[FB_ARITH].function, (top-stack)-3, 1, (top-stack)-3);
+  callFB(FB_ARITH);
 }
 
 static void comparison (lua_Type tag_less, lua_Type tag_equal, 
@@ -713,7 +862,7 @@ static void comparison (lua_Type tag_less, lua_Type tag_equal,
   else if (tostring(l) || tostring(r))
   {
     lua_pushstring(op);
-    do_call(&luaI_fallBacks[FB_ORDER].function, (top-stack)-3, 1, (top-stack)-3);
+    callFB(FB_ORDER);
     return;
   }
   else
@@ -732,26 +881,30 @@ static void comparison (lua_Type tag_less, lua_Type tag_equal,
 */
 static StkId lua_execute (Byte *pc, StkId base)
 {
- lua_checkstack(STACKGAP+MAX_TEMPS+base);
+  if (call_hook)
+    callHook (base, LUA_T_MARK, 0);
  while (1)
  {
   OpCode opcode;
   switch (opcode = (OpCode)*pc++)
   {
-   case PUSHNIL: tag(top++) = LUA_T_NIL; break;
+   case PUSHNIL: tag(top) = LUA_T_NIL; incr_top; break;
 
    case PUSH0: case PUSH1: case PUSH2:
      tag(top) = LUA_T_NUMBER;
-     nvalue(top++) = opcode-PUSH0;
+     nvalue(top) = opcode-PUSH0;
+     incr_top;
      break;
 
-   case PUSHBYTE: tag(top) = LUA_T_NUMBER; nvalue(top++) = *pc++; break;
+   case PUSHBYTE: 
+     tag(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break;
 
    case PUSHWORD:
    {
     CodeWord code;
     get_word(code,pc);
-    tag(top) = LUA_T_NUMBER; nvalue(top++) = code.w;
+    tag(top) = LUA_T_NUMBER; nvalue(top) = code.w;
+    incr_top;
    }
    break;
 
@@ -759,7 +912,8 @@ static StkId lua_execute (Byte *pc, StkId base)
    {
     CodeFloat code;
     get_float(code,pc);
-    tag(top) = LUA_T_NUMBER; nvalue(top++) = code.f;
+    tag(top) = LUA_T_NUMBER; nvalue(top) = code.f;
+    incr_top;
    }
    break;
 
@@ -767,7 +921,8 @@ static StkId lua_execute (Byte *pc, StkId base)
    {
     CodeWord code;
     get_word(code,pc);
-    tag(top) = LUA_T_STRING; tsvalue(top++) = lua_constant[code.w];
+    tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
+    incr_top;
    }
    break;
 
@@ -775,22 +930,26 @@ static StkId lua_execute (Byte *pc, StkId base)
    {
     CodeCode code;
     get_code(code,pc);
-    tag(top) = LUA_T_FUNCTION; bvalue(top++) = code.b;
+    luaI_insertfunction(code.tf);  /* may take part in GC */
+    top->tag = LUA_T_FUNCTION;
+    top->value.tf = code.tf;
+    incr_top;
    }
    break;
 
    case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
    case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
    case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
-   case PUSHLOCAL9: *top++ = *((stack+base) + (int)(opcode-PUSHLOCAL0)); break;
+   case PUSHLOCAL9: 
+     *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break;
 
-   case PUSHLOCAL: *top++ = *((stack+base) + (*pc++)); break;
+   case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break;
 
    case PUSHGLOBAL:
    {
     CodeWord code;
     get_word(code,pc);
-    *top++ = s_object(code.w);
+    getglobal(code.w);
    }
    break;
 
@@ -803,9 +962,11 @@ static StkId lua_execute (Byte *pc, StkId base)
      Object receiver = *(top-1);
      CodeWord code;
      get_word(code,pc);
-     tag(top) = LUA_T_STRING; tsvalue(top++) = lua_constant[code.w];
+     tag(top) = LUA_T_STRING; tsvalue(top) = lua_constant[code.w];
+     incr_top;
      pushsubscript();
-     *(top++) = receiver;
+     *top = receiver;
+     incr_top;
      break;
    }
 
@@ -835,11 +996,12 @@ static StkId lua_execute (Byte *pc, StkId base)
     int n = *pc++;
     if (tag(top-3-n) != LUA_T_ARRAY)
     {
+      lua_checkstack(top+2);
       *(top+1) = *(top-1);
       *(top) = *(top-2-n);
       *(top-1) = *(top-3-n);
       top += 2;
-      do_call(&luaI_fallBacks[FB_SETTABLE].function, (top-stack)-3, 0, (top-stack)-3);
+      callFB(FB_SETTABLE);
     }
     else
     {
@@ -899,7 +1061,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     get_word(size,pc);
     avalue(top) = lua_createarray(size.w);
     tag(top) = LUA_T_ARRAY;
-    top++;
+    incr_top;
    }
    break;
 
@@ -993,7 +1155,7 @@ static StkId lua_execute (Byte *pc, StkId base)
     Object *l = top-2;
     Object *r = top-1;
     if (tostring(r) || tostring(l))
-      do_call(&luaI_fallBacks[FB_CONCAT].function, (top-stack)-2, 1, (top-stack)-2);
+      callFB(FB_CONCAT);
     else
     {
       tsvalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
@@ -1005,7 +1167,8 @@ static StkId lua_execute (Byte *pc, StkId base)
    case MINUSOP:
     if (tonumber(top-1))
     {
-      tag(top++) = LUA_T_NIL;
+      tag(top) = LUA_T_NIL;
+      incr_top;
       call_arith("unm");
     }
     else
@@ -1073,39 +1236,33 @@ static StkId lua_execute (Byte *pc, StkId base)
    {
      int nParams = *(pc++);
      int nResults = *(pc++);
-     Object *func = top-1-nParams; /* function is below parameters */
      StkId newBase = (top-stack)-nParams;
-     do_call(func, newBase, nResults, newBase-1);
+     do_call(newBase, nResults);
    }
    break;
 
    case RETCODE0:
-     return base;
-
    case RETCODE:
-     return base+*pc;
+     if (call_hook)
-
+       callHook (base, LUA_T_MARK, 1);
-   case SETFUNCTION:
+     return (base + ((opcode==RETCODE0) ? 0 : *pc));
-   {
-    CodeCode file;
-    CodeWord func;
-    get_code(file,pc);
-    get_word(func,pc);
-    lua_pushfunction ((char *)file.b, func.w);
-   }
-   break;
 
    case SETLINE:
    {
     CodeWord code;
     get_word(code,pc);
-    lua_debugline = code.w;
+    if ((stack+base-1)->tag != LUA_T_LINE)
+    {
+      /* open space for LINE value */
+      open_stack((top-stack)-base);
+      base++;
+      (stack+base-1)->tag = LUA_T_LINE;
+    }
+    (stack+base-1)->value.i = code.w;
+    if (line_hook)
+      lineHook (code.w);
+    break;
    }
-   break;
-
-   case RESET:
-    lua_popfunction ();
-   break;
 
    default:
     lua_error ("internal error - opcode doesn't match");
@@ -1113,4 +1270,3 @@ static StkId lua_execute (Byte *pc, StkId base)
  }
 }
 
-

opcode.h

@@ -1,6 +1,6 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 3.9 1994/11/23 14:31:11 roberto Stab $
+** $Id: opcode.h,v 3.16 1996/01/26 18:03:19 roberto Exp roberto $
 */
 
 #ifndef opcode_h
@@ -9,19 +9,11 @@
 #include "lua.h"
 #include "types.h"
 #include "tree.h"
+#include "func.h"
 
-#ifndef STACKGAP
-#define STACKGAP	128
-#endif 
-
-#ifndef real
-#define real float
-#endif
 
 #define FIELDS_PER_FLUSH 40
 
-#define MAX_TEMPS	20
-
 
 typedef enum 
 { 
@@ -73,25 +65,21 @@ typedef enum
  CALLFUNC,
  RETCODE0,
  RETCODE,
- SETFUNCTION,
+ SETLINE
- SETLINE,
- RESET
 } OpCode;
 
 #define MULT_RET	255
 
 
-typedef void (*Cfunction) (void);
-typedef int  (*Input) (void);
-
 typedef union
 {
- Cfunction     f;
+ lua_CFunction f;
  real          n;
  TaggedString *ts;
- Byte         *b;
+ TFunc         *tf;
  struct Hash    *a;
  void           *u;
+ int	       i;
 } Value;
 
 typedef struct Object
@@ -100,17 +88,12 @@ typedef struct Object
  Value value;
 } Object;
 
-typedef struct
-{
- Object  object;
-} Symbol;
 
 /* Macros to access structure members */
 #define tag(o)		((o)->tag)
 #define nvalue(o)	((o)->value.n)
 #define svalue(o)	((o)->value.ts->str)
 #define tsvalue(o)	((o)->value.ts)
-#define bvalue(o)	((o)->value.b)
 #define avalue(o)	((o)->value.a)
 #define fvalue(o)	((o)->value.f)
 #define uvalue(o)	((o)->value.u)
@@ -120,7 +103,6 @@ typedef struct
 #define s_tag(i)	(tag(&s_object(i)))
 #define s_nvalue(i)	(nvalue(&s_object(i)))
 #define s_svalue(i)	(svalue(&s_object(i)))
-#define s_bvalue(i)	(bvalue(&s_object(i)))
 #define s_avalue(i)	(avalue(&s_object(i)))
 #define s_fvalue(i)	(fvalue(&s_object(i)))
 #define s_uvalue(i)	(uvalue(&s_object(i)))
@@ -143,7 +125,7 @@ typedef union
 typedef union
 {
  struct {char c1; char c2; char c3; char c4;} m;
- Byte *b;
+ TFunc *tf;
 } CodeCode;
 #define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
                               code.m.c3 = *pc++; code.m.c4 = *pc++;}
@@ -152,11 +134,9 @@ typedef union
 /* Exported functions */
 char   *lua_strdup (char *l);
 
-void    lua_setinput   (Input fn);	/* from "lex.c" module */
+void    lua_parse      (TFunc *tf);	/* from "lua.stx" module */
-char   *lua_lasttext   (void);		/* from "lex.c" module */
+void	luaI_codedebugline (int line);  /* from "lua.stx" module */
-int     yylex (void);		        /* from "lex.c" module */
+void    lua_travstack (int (*fn)(Object *));
-void    lua_parse      (Byte **code);	/* from "lua.stx" module */
-void    lua_travstack (void (*fn)(Object *));
 Object *luaI_Address (lua_Object o);
 void	luaI_pushobject (Object *o);
 void    luaI_gcFB       (Object *o);

strlib.c

@@ -3,9 +3,10 @@
 ** String library to LUA
 */
 
-char *rcs_strlib="$Id: strlib.c,v 1.11 1995/02/02 20:05:37 roberto Exp roberto $";
+char *rcs_strlib="$Id: strlib.c,v 1.18 1996/02/12 18:32:40 roberto Exp $";
 
 #include <string.h>
+#include <stdio.h>
 #include <stdlib.h>
 #include <ctype.h>
 
@@ -13,14 +14,61 @@ char *rcs_strlib="$Id: strlib.c,v 1.11 1995/02/02 20:05:37 roberto Exp roberto $
 #include "lualib.h"
 
 
-static char *newstring (lua_Object o)
+void lua_arg_error(char *funcname)
 {
-  char *s = lua_getstring(o);
+  char buff[100];
-  char *ns = (char *)malloc(strlen(s)+1);
+  sprintf(buff, "incorrect arguments to function `%s'", funcname);
-  if (ns == 0)
+  lua_error(buff);
-    lua_error("not enough memory for new string");
+}
-  strcpy(ns, s);
+
-  return ns;
+char *lua_check_string (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  if (!(lua_isstring(o) || lua_isnumber(o)))
+    lua_arg_error(funcname);
+  return lua_getstring(o);
+}
+
+double lua_check_number (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  if (lua_isnumber(o))
+    return lua_getnumber(o);
+  else if (lua_isstring(o))
+  {
+    float t;
+    char c;
+    if (sscanf(lua_getstring(o), "%f %c",&t, &c) == 1)
+      return t;
+  }
+  lua_arg_error(funcname);
+  return 0;  /* to avoid warnings */
+}
+
+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;
 }
 
 
@@ -31,34 +79,17 @@ static char *newstring (lua_Object o)
 */
 static void str_find (void)
 {
- char *s1, *s2, *f;
+ char *s1 = lua_check_string(1, "strfind");
- int init; 
+ char *s2 = lua_check_string(2, "strfind");
- lua_Object o1 = lua_getparam (1);
+ int init = (lua_getparam(3) == LUA_NOOBJECT) ? 0 :
- lua_Object o2 = lua_getparam (2);
+                                 (int)lua_check_number(3, "strfind")-1;
- lua_Object o3 = lua_getparam (3);
+ char *f = strstr(s1+init,s2);
- lua_Object o4 = lua_getparam (4);
- if (!lua_isstring(o1) || !lua_isstring(o2))
-   lua_error ("incorrect arguments to function `strfind'");
- if (o3 == LUA_NOOBJECT)
-  init = 0;
- else if (lua_isnumber(o3))
-  init = lua_getnumber(o3)-1;
- else
- {
-   lua_error ("incorrect arguments to function `strfind'");
-   return;  /* to avoid warnings */
- }
- s1 = lua_getstring(o1);
- s2 = lua_getstring(o2);
- f = strstr(s1+init,s2);
  if (f != NULL)
  {
   int pos = f-s1+1;
-  if (o4 == LUA_NOOBJECT)
+  if (lua_getparam (4) == LUA_NOOBJECT)
    lua_pushnumber (pos);
-  else if (!lua_isnumber(o4))
+  else if ((int)lua_check_number(4, "strfind") >= pos+strlen(s2)-1)
-   lua_error ("incorrect arguments to function `strfind'");
-  else if ((int)lua_getnumber(o4) >= pos+strlen(s2)-1)
    lua_pushnumber (pos);
   else
    lua_pushnil();
@@ -74,10 +105,8 @@ static void str_find (void)
 */
 static void str_len (void)
 {
- lua_Object o = lua_getparam (1);
+ char *s = lua_check_string(1, "strlen");
- if (!lua_isstring(o))
+ lua_pushnumber(strlen(s));
-   lua_error ("incorrect arguments to function `strlen'");
- lua_pushnumber(strlen(lua_getstring(o)));
 }
 
 
@@ -88,26 +117,19 @@ static void str_len (void)
 */
 static void str_sub (void)
 {
- int start, end;
+ char *s = lua_check_string(1, "strsub");
- char *s;
+ int start = (int)lua_check_number(2, "strsub");
- lua_Object o1 = lua_getparam (1);
+ int end = (lua_getparam(3) == LUA_NOOBJECT) ? strlen(s) :
- lua_Object o2 = lua_getparam (2);
+                                    (int)lua_check_number(3, "strsub");
- lua_Object o3 = lua_getparam (3);
- if (!lua_isstring(o1) || !lua_isnumber(o2))
-   lua_error ("incorrect arguments to function `strsub'");
- if (o3 != LUA_NOOBJECT && !lua_isnumber(o3))
-   lua_error ("incorrect third argument to function `strsub'");
- s = newstring(o1);
- start = lua_getnumber (o2);
- end = o3 == LUA_NOOBJECT ? strlen(s) : lua_getnumber (o3);
  if (end < start || start < 1 || end > strlen(s))
   lua_pushliteral("");
  else
  {
-  s[end] = 0;
+   luaI_addchar(0);
-  lua_pushstring (&s[start-1]);
+   while (start <= end) 
+     luaI_addchar(s[start++ - 1]);
+   lua_pushstring (luaI_addchar(0));
  }
- free(s);
 }
 
 /*
@@ -117,19 +139,12 @@ static void str_sub (void)
 */
 static void str_lower (void)
 {
- char *s, *c;
+  char *s = lua_check_string(1, "strlower");
- lua_Object o = lua_getparam (1);
+  luaI_addchar(0);
- if (!lua_isstring(o))
+  while (*s)
-   lua_error ("incorrect arguments to function `strlower'");
+    luaI_addchar(tolower(*s++));
- c = s = newstring(o);
+  lua_pushstring(luaI_addchar(0));
- while (*c != 0)
+}
- {
-  *c = tolower(*c);
-  c++;
- }
- lua_pushstring(s);
- free(s);
-} 
 
 
 /*
@@ -139,19 +154,91 @@ static void str_lower (void)
 */
 static void str_upper (void)
 {
- char *s, *c;
+  char *s = lua_check_string(1, "strupper");
- lua_Object o = lua_getparam (1);
+  luaI_addchar(0);
- if (!lua_isstring(o))
+  while (*s)
-   lua_error ("incorrect arguments to function `strlower'");
+    luaI_addchar(toupper(*s++));
- c = s = newstring(o);
+  lua_pushstring(luaI_addchar(0));
- while (*c != 0)
+}
- {
+
-  *c = toupper(*c);
+/*
-  c++;
+** get ascii value of a character in a string
- }
+*/
- lua_pushstring(s);
+static void str_ascii (void)
- free(s);
+{
-} 
+  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;
+  if (pos<0 || pos>=strlen(s))
+    lua_arg_error("ascii");
+  lua_pushnumber(s[pos]);
+}
+
+
+#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 '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 */
+}
 
 
 /*
@@ -164,4 +251,6 @@ void strlib_open (void)
  lua_register ("strsub", str_sub);
  lua_register ("strlower", str_lower);
  lua_register ("strupper", str_upper);
+ lua_register ("ascii", str_ascii);
+ lua_register ("format",    str_format);
 }

table.c

@@ -3,80 +3,76 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.27 1995/01/13 22:11:12 roberto Exp celes $";
+char *rcs_table="$Id: table.c,v 2.46 1996/02/14 13:35:51 roberto Exp roberto $";
-
-#include <string.h>
 
 #include "mem.h"
 #include "opcode.h"
 #include "tree.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
+#include "inout.h"
 #include "lua.h"
 #include "fallback.h"
+#include "luadebug.h"
 
 
 #define BUFFER_BLOCK 256
 
-Symbol *lua_table;
+Symbol *lua_table = NULL;
 static Word lua_ntable = 0;
 static Long lua_maxsymbol = 0;
 
-TaggedString **lua_constant;
+TaggedString **lua_constant = NULL;
 static Word lua_nconstant = 0;
 static Long lua_maxconstant = 0;
 
 
-
+#define GARBAGE_BLOCK 1024
-#define MAXFILE 	20
+#define MIN_GARBAGE_BLOCK (GARBAGE_BLOCK/2)
-char  		       *lua_file[MAXFILE];
-int      		lua_nfile;
-
-#define GARBAGE_BLOCK 256
-#define MIN_GARBAGE_BLOCK 10
 
 static void lua_nextvar (void);
-static void setglobal (void);
-static void getglobal (void);
 
 /*
 ** Initialise symbol table with internal functions
 */
-static void lua_initsymbol (void)
+static struct {
+  char *name;
+  lua_CFunction func;
+} int_funcs[] = {
+  {"nextvar", lua_nextvar},
+  {"error", luaI_error},
+  {"tonumber", lua_obj2number},
+  {"setfallback", luaI_setfallback},
+  {"next", lua_next},
+  {"dofile", lua_internaldofile},
+  {"setglobal", luaI_setglobal},
+  {"getglobal", luaI_getglobal},
+  {"type", luaI_type},
+  {"tostring", luaI_tostring},
+  {"print", luaI_print},
+  {"dostring", lua_internaldostring},
+  {"assert", luaI_assert}
+};
+
+#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+
+void luaI_initsymbol (void)
 {
- Word n;
+  int i;
- lua_maxsymbol = BUFFER_BLOCK;
+  lua_maxsymbol = BUFFER_BLOCK;
- lua_table = newvector(lua_maxsymbol, Symbol);
+  lua_table = newvector(lua_maxsymbol, Symbol);
- n = luaI_findsymbolbyname("next");
+  for (i=0; i<INTFUNCSIZE; i++)
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
+  {
- n = luaI_findsymbolbyname("dofile");
+    Word n = luaI_findsymbolbyname(int_funcs[i].name);
- s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
+    s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = int_funcs[i].func;
- 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;
 }
 
 
 /*
 ** 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 *);
@@ -87,10 +83,8 @@ 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)
@@ -103,8 +97,11 @@ Word luaI_findsymbol (TreeNode *t)
    lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
   }
   t->varindex = lua_ntable;
+  lua_table[lua_ntable].varname = t;
   s_tag(lua_ntable) = LUA_T_NIL;
   lua_ntable++;
+  if (!t->marked)
+    t->marked = 2;  /* avoid GC */
  }
  return t->varindex;
 }
@@ -112,19 +109,16 @@ Word luaI_findsymbol (TreeNode *t)
 
 Word luaI_findsymbolbyname (char *name)
 {
-  return luaI_findsymbol(lua_constcreate(name));
+  return luaI_findsymbol(lua_createstring(name));
 }
 
 
 /*
-** Given a name, search it at constant table and return its index. If not
+** Given a tree node, check it is has a correspondent constant index. If not,
-** found, allocate it.
+** allocate it.
-** On error, return -1.
 */
-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)
@@ -137,33 +131,53 @@ Word luaI_findconstant (TreeNode *t)
    lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
   }
   t->constindex = lua_nconstant;
-  lua_constant[lua_nconstant] = &(t->ts);
+  lua_constant[lua_nconstant] = t;
   lua_nconstant++;
+  if (!t->marked)
+    t->marked = 2;  /* avoid GC */
  }
  return t->constindex;
 }
 
 
+Word  luaI_findconstantbyname (char *name)
+{
+  return luaI_findconstant(lua_createstring(name));
+}
+
+TaggedString *lua_constcreate(char *name)
+{
+  int i = luaI_findconstantbyname(name);
+  return lua_constant[i];
+}
+
+
 /*
 ** Traverse symbol table objects
 */
-void lua_travsymbol (void (*fn)(Object *))
+static char *lua_travsymbol (int (*fn)(Object *))
 {
  Word i;
  for (i=0; i<lua_ntable; i++)
-  fn(&s_object(i));
+  if (fn(&s_object(i)))
+    return lua_table[i].varname->str;
+ return NULL;
 }
 
 
 /*
 ** Mark an object if it is a string or a unmarked array.
 */
-void lua_markobject (Object *o)
+int lua_markobject (Object *o)
-{
+{/* if already marked, does not change mark value */
  if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
    tsvalue(o)->marked = 1;
  else if (tag(o) == LUA_T_ARRAY)
    lua_hashmark (avalue(o));
+ else if ((o->tag == LUA_T_FUNCTION || o->tag == LUA_T_MARK)
+           && !o->value.tf->marked)
+   o->value.tf->marked = 1;
+ return 0;
 }
 
 
@@ -171,107 +185,92 @@ void lua_markobject (Object *o)
 ** Garbage collection. 
 ** Delete all unused strings and arrays.
 */
+Long luaI_collectgarbage (void)
+{
+  Long recovered = 0;
+  lua_travstack(lua_markobject); /* mark stack objects */
+  lua_travsymbol(lua_markobject); /* mark symbol table objects */
+  luaI_travlock(lua_markobject); /* mark locked objects */
+  luaI_travfallbacks(lua_markobject);  /* mark fallbacks */
+  recovered += lua_strcollector();
+  recovered += lua_hashcollector();
+  recovered += luaI_funccollector();
+  return recovered;
+} 
+
 void lua_pack (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 */
+  recovered = luaI_collectgarbage();
-  lua_travsymbol(lua_markobject); /* mark symbol table objects */
-  luaI_travlock(lua_markobject); /* mark locked objects */
-  recovered += lua_strcollector();
-  recovered += lua_hashcollector();
   nentity = 0;				/* reset counter */
   block=(16*block-7*recovered)/12;	/* adapt block size */
   if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
 } 
 
 
-/*
-** Add a file name at file table, checking overflow. This function also set
-** the external variable "lua_filename" with the function filename set.
-** Return 0 on success or error message on error.
-*/
-char *lua_addfile (char *fn)
-{
- if (lua_nfile >= MAXFILE)
-   return "too many files";
- if ((lua_file[lua_nfile++] = luaI_strdup (fn)) == NULL)
-   return "not enough memory";
- return NULL;
-}
-
-/*
-** Delete a file from file stack
-*/
-int lua_delfile (void)
-{
- luaI_free(lua_file[--lua_nfile]); 
- return 1;
-}
-
-/*
-** Return the last file name set.
-*/
-char *lua_filename (void)
-{
- return lua_file[lua_nfile-1];
-}
-
 /*
 ** Internal function: return next global variable
 */
 static void lua_nextvar (void)
 {
- char *varname;
+ Word next;
- TreeNode *next;
  lua_Object o = lua_getparam(1);
  if (o == LUA_NOOBJECT)
-   lua_reportbug("too few arguments to function `nextvar'");
+   lua_error("too few arguments to function `nextvar'");
  if (lua_getparam(2) != LUA_NOOBJECT)
-   lua_reportbug("too many arguments to function `nextvar'");
+   lua_error("too many arguments to function `nextvar'");
  if (lua_isnil(o))
-   varname = NULL;
+   next = 0;
  else if (!lua_isstring(o))
  {
-   lua_reportbug("incorrect argument to function `nextvar'"); 
+   lua_error("incorrect argument to function `nextvar'"); 
    return;  /* to avoid warnings */
  }
  else
-   varname = lua_getstring(o);
+   next = luaI_findsymbolbyname(lua_getstring(o)) + 1;
- next = lua_varnext(varname);
+ while (next < lua_ntable && s_tag(next) == LUA_T_NIL) next++;
- if (next == NULL)
+ if (next >= lua_ntable)
  {
   lua_pushnil();
   lua_pushnil();
  }
  else
  {
+  TaggedString *t = lua_table[next].varname;
   Object name;
   tag(&name) = LUA_T_STRING;
-  tsvalue(&name) = &(next->ts);
+  tsvalue(&name) = t;
   luaI_pushobject(&name);
-  luaI_pushobject(&s_object(next->varindex));
+  luaI_pushobject(&s_object(next));
  }
 }
 
 
-static void setglobal (void)
+static Object *functofind;
+static int checkfunc (Object *o)
 {
-  lua_Object name = lua_getparam(1);
+  if (o->tag == LUA_T_FUNCTION)
-  lua_Object value = lua_getparam(2);
+    return
-  if (!lua_isstring(name))
+       ((functofind->tag == LUA_T_FUNCTION || functofind->tag == LUA_T_MARK)
-    lua_reportbug("incorrect argument to function `setglobal'");
+            && (functofind->value.tf == o->value.tf));
-  lua_pushobject(value);
+  if (o->tag == LUA_T_CFUNCTION)
-  lua_storeglobal(lua_getstring(name));
+    return
+       ((functofind->tag == LUA_T_CFUNCTION || functofind->tag == LUA_T_CMARK)
+            && (functofind->value.f == o->value.f));
+  return 0;
 }
 
 
-static void getglobal (void)
+char *lua_getobjname (lua_Object o, char **name)
-{
+{ /* try to find a name for given function */
-  lua_Object name = lua_getparam(1);
+  functofind = luaI_Address(o);
-  if (!lua_isstring(name))
+  if ((*name = luaI_travfallbacks(checkfunc)) != NULL)
-    lua_reportbug("incorrect argument to function `getglobal'");
+    return "fallback";
-  lua_pushobject(lua_getglobal(lua_getstring(name)));
+  else if ((*name = lua_travsymbol(checkfunc)) != NULL)
+    return "global";
+  else return "";
 }
+

table.h

@@ -1,7 +1,7 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.9 1994/11/23 14:31:11 roberto Stab roberto $
+** $Id: table.h,v 2.17 1996/02/12 18:32:40 roberto Exp roberto $
 */
 
 #ifndef table_h
@@ -10,22 +10,26 @@
 #include "tree.h"
 #include "opcode.h"
 
+typedef struct
+{
+ Object  object;
+ TaggedString *varname;
+} Symbol;
+
+
 extern Symbol *lua_table;
 extern TaggedString **lua_constant;
 
-extern char   *lua_file[];
+void luaI_initsymbol (void);
-extern int     lua_nfile;
+void  luaI_initconstant (void);
-
-
-void  lua_initconstant (void);
 Word  luaI_findsymbolbyname (char *name);
-Word  luaI_findsymbol      (TreeNode *t);
+Word  luaI_findsymbol      (TaggedString *t);
-Word  luaI_findconstant    (TreeNode *t);
+Word  luaI_findconstant    (TaggedString *t);
-void  lua_travsymbol      (void (*fn)(Object *));
+Word  luaI_findconstantbyname (char *name);
-void  lua_markobject      (Object *o);
+TaggedString *lua_constcreate  (char *str);
+int   lua_markobject      (Object *o);
+Long luaI_collectgarbage (void);
 void  lua_pack            (void);
-char *lua_addfile         (char *fn);
+
-int   lua_delfile 	  (void);
-char *lua_filename        (void);
 
 #endif

tree.c

@@ -3,7 +3,7 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: tree.c,v 1.12 1994/12/20 21:20:36 roberto Exp roberto $";
+char *rcs_tree="$Id: tree.c,v 1.17 1996/02/14 13:35:51 roberto Exp roberto $";
 
 
 #include <string.h>
@@ -11,66 +11,105 @@ char *rcs_tree="$Id: tree.c,v 1.12 1994/12/20 21:20:36 roberto Exp roberto $";
 #include "mem.h"
 #include "lua.h"
 #include "tree.h"
+#include "lex.h"
+#include "hash.h"
 #include "table.h"
 
 
-#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b))) 
+#define NUM_HASHS  64
+
+typedef struct {
+  int size;
+  int nuse;  /* number of elements (including EMPTYs) */
+  TaggedString **hash;
+} stringtable;
+
+static int initialized = 0;
+
+static stringtable string_root[NUM_HASHS];
+
+static TaggedString EMPTY = {NOT_USED, NOT_USED, 0, 2, {0}};
 
 
-typedef struct StringNode {
+static unsigned long hash (char *str)
-  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)
 {
- if (*node == NULL)
+  unsigned long h = 0;
- {
+  while (*str)
-  *node = (TreeNode *) luaI_malloc(sizeof(TreeNode)+strlen(str));
+    h = ((h<<5)-h)^(unsigned char)*(str++);
-  (*node)->left = (*node)->right = NULL;
+  return h;
-  strcpy((*node)->ts.str, str);
+}
-  (*node)->ts.marked = 0;
+
-  (*node)->ts.hash = 0;
+static void initialize (void)
-  (*node)->varindex = (*node)->constindex = NOT_USED;
+{
-  return *node;
+  initialized = 1;
- }
+  luaI_addReserved();
- else
+  luaI_initsymbol();
- {
+  luaI_initconstant();
-  int c = lua_strcmp(str, (*node)->ts.str);
+}
-  if (c < 0) 
+
-   return tree_create(&(*node)->left, str);
+
-  else if (c > 0)
+static void grow (stringtable *tb)
-   return tree_create(&(*node)->right, str);
+{
+  int newsize = luaI_redimension(tb->size);
+  TaggedString **newhash = newvector(newsize, TaggedString *);
+  int i;
+  for (i=0; i<newsize; i++)
+    newhash[i] = NULL;
+  if (tb->size > 0)
+  { /* 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 */
+  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;
+  return insert(str, &string_root[(unsigned)str[0]%NUM_HASHS]);
-  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);
 }
 
 
@@ -80,62 +119,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;
+    stringtable *tb = &string_root[i];
-    if (!curr->ts.marked)
+    int j;
+    for (j=0; j<tb->size; j++)
     {
-      if (prev == NULL) string_root = next;
+      TaggedString *t = tb->hash[j];
-      else prev->next = next;
+      if (t != NULL && t->marked <= 1)
-      luaI_free(curr);
+      {
-      ++counter;
+        if (t->marked)
+          t->marked = 0;
+        else
+        {
+          luaI_free(t);
+          tb->hash[j] = &EMPTY;
+          counter++;
+        }
+      }
     }
-    else
-    {
-      curr->ts.marked = 0;
-      prev = curr;
-    }
-    curr = next;
   }
   return counter;
 }
 
-/*
-** Return next variable.
-*/
-static TreeNode *tree_next (TreeNode *node, char *str)
-{
- if (node == NULL) return NULL;
- else if (str == NULL) return node;
- else
- {
-  int c = lua_strcmp(str, node->ts.str);
-  if (c == 0)
-   return node->left != NULL ? node->left : node->right;
-  else if (c < 0)
-  {
-   TreeNode *result = tree_next(node->left, str);
-   return result != NULL ? result : node->right;
-  }
-  else
-   return tree_next(node->right, str);
- }
-}
-
-TreeNode *lua_varnext (char *n)
-{
-  TreeNode *result;
-  char *name = n;
-  while (1)
-  { /* repeat until a valid (non nil) variable */
-    result = tree_next(constant_root, name);
-    if (result == NULL) return NULL;
-    if (result->varindex != NOT_USED &&
-        s_tag(result->varindex) != LUA_T_NIL)
-      return result;
-    name = result->ts.str;
-  }
-}
-

tree.h

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

types.h

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