inclui arquivo "tree".

de tabelas (pilhas, hashtable, globais, codigo, etc.)

exscript

@@ -0,0 +1,3 @@
+1d
+x
+

hash.c

@@ -2,13 +2,15 @@
 ** hash.c
 ** hash manager for lua
 ** Luiz Henrique de Figueiredo - 17 Aug 90
-** Modified by Waldemar Celes Filho
-** 12 May 93
 */
 
+char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
+
 #include <string.h>
 #include <stdlib.h>
 
+#include "mm.h"
+
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
@@ -24,10 +26,20 @@
 #define nhash(t)	((t)->nhash)
 #define nodelist(t)	((t)->list)
 #define list(t,i)	((t)->list[i])
+#define markarray(t)    ((t)->mark)
 #define ref_tag(n)	(tag(&(n)->ref))
 #define ref_nvalue(n)	(nvalue(&(n)->ref))
 #define ref_svalue(n)	(svalue(&(n)->ref))
 
+
+typedef struct ArrayList
+{
+ Hash *array;
+ struct ArrayList *next;
+} ArrayList;
+
+static ArrayList *listhead = NULL;
+
 static int head (Hash *t, Object *ref)		/* hash function */
 {
  if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
@@ -89,7 +101,7 @@ static void freelist (Node *n)
 /*
 ** Create a new hash. Return the hash pointer or NULL on error.
 */
-Hash *lua_hashcreate (unsigned int nhash)
+static Hash *hashcreate (unsigned int nhash)
 {
  Hash *t = new (Hash);
  if (t == NULL)
@@ -111,7 +123,7 @@ Hash *lua_hashcreate (unsigned int nhash)
 /*
 ** Delete a hash
 */
-void lua_hashdelete (Hash *h)
+static void hashdelete (Hash *h)
 {
  int i;
  for (i=0; i<nhash(h); i++)
@@ -120,6 +132,86 @@ void lua_hashdelete (Hash *h)
  free(h);
 }
 
+
+/*
+** Mark a hash and check its elements 
+*/
+void lua_hashmark (Hash *h)
+{
+ if (markarray(h) == 0)
+ {
+  int i;
+  markarray(h) = 1;
+  for (i=0; i<nhash(h); i++)
+  {
+   Node *n;
+   for (n = list(h,i); n != NULL; n = n->next)
+   {
+    lua_markobject(&n->ref);
+    lua_markobject(&n->val);
+   }
+  }
+ } 
+}
+ 
+/*
+** Garbage collection to arrays
+** Delete all unmarked arrays.
+*/
+void lua_hashcollector (void)
+{
+ ArrayList *curr = listhead, *prev = NULL;
+ while (curr != NULL)
+ {
+  ArrayList *next = curr->next;
+  if (markarray(curr->array) != 1)
+  {
+   if (prev == NULL) listhead = next;
+   else              prev->next = next;
+   hashdelete(curr->array);
+   free(curr);
+  }
+  else
+  {
+   markarray(curr->array) = 0;
+   prev = curr;
+  }
+  curr = next;
+ }
+}
+
+
+/*
+** Create a new array
+** This function insert the new array at array list. It also
+** execute garbage collection if the number of array created
+** exceed a pre-defined range.
+*/
+Hash *lua_createarray (int nhash)
+{
+ ArrayList *new = new(ArrayList);
+ if (new == NULL)
+ {
+  lua_error ("not enough memory");
+  return NULL;
+ }
+ new->array = hashcreate(nhash);
+ if (new->array == NULL)
+ {
+  lua_error ("not enough memory");
+  return NULL;
+ }
+
+ if (lua_nentity == lua_block)
+  lua_pack(); 
+
+ lua_nentity++;
+ new->next = listhead;
+ listhead = new;
+ return new->array;
+}
+
+
 /*
 ** If the hash node is present, return its pointer, otherwise create a new
 ** node for the given reference and also return its pointer.
@@ -149,26 +241,6 @@ Object *lua_hashdefine (Hash *t, Object *ref)
  return (&n->val);
 }
 
-/*
-** Mark a hash and check its elements 
-*/
-void lua_hashmark (Hash *h)
-{
- int i;
- 
- markarray(h) = 1;
- 
- for (i=0; i<nhash(h); i++)
- {
-  Node *n;
-  for (n = list(h,i); n != NULL; n = n->next)
-  {
-   lua_markobject (&n->ref);
-   lua_markobject (&n->val);
-  }
- }
-}
-
 
 /*
 ** Internal function to manipulate arrays. 
@@ -176,7 +248,6 @@ void lua_hashmark (Hash *h)
 ** in the hash.
 ** This function pushs the element value and its reference to the stack.
 */
-#include "lua.h"
 static void firstnode (Hash *a, int h)
 {
  if (h < nhash(a))
@@ -184,11 +255,25 @@ static void firstnode (Hash *a, int h)
   int i;
   for (i=h; i<nhash(a); i++)
   {
-   if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
+   if (list(a,i) != NULL)
    {
-    lua_pushobject (&list(a,i)->ref);
-    lua_pushobject (&list(a,i)->val);
-    return;
+    if (tag(&list(a,i)->val) != T_NIL)
+    {
+     lua_pushobject (&list(a,i)->ref);
+     lua_pushobject (&list(a,i)->val);
+     return;
+    }
+    else
+    {
+     Node *next = list(a,i)->next;
+     while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
+     if (next != NULL)
+     {
+      lua_pushobject (&next->ref);
+      lua_pushobject (&next->val);
+      return;
+     }
+    }
    }
   }
  }
@@ -257,3 +342,4 @@ void lua_next (void)
   }
  }
 }
+

hash.h

@@ -2,8 +2,7 @@
 ** hash.h
 ** hash manager for lua
 ** Luiz Henrique de Figueiredo - 17 Aug 90
-** Modified by Waldemar Celes Filho
-** 26 Apr 93
+** $Id: hash.h,v 1.1 1993/12/17 18:41:19 celes Exp celes $
 */
 
 #ifndef hash_h
@@ -23,13 +22,11 @@ typedef struct Hash
  Node         **list;
 } Hash;
 
-#define markarray(t)		((t)->mark)
 
-Hash 	*lua_hashcreate (unsigned int nhash);
-void 	 lua_hashdelete (Hash *h);
+Hash    *lua_createarray (int nhash);
+void     lua_hashmark (Hash *h);
+void     lua_hashcollector (void);
 Object 	*lua_hashdefine (Hash *t, Object *ref);
-void 	 lua_hashmark   (Hash *h);
-
 void     lua_next (void);
 
 #endif

inout.c

@@ -2,12 +2,10 @@
 ** inout.c
 ** Provide function to realise the input/output function and debugger 
 ** facilities.
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
+char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
+
 #include <stdio.h>
 #include <string.h>
 
@@ -15,6 +13,7 @@
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
+#include "tree.h"
 
 /* Exported variables */
 int lua_linenumber;
@@ -49,14 +48,6 @@ static int fileinput (void)
  return (c == EOF ? 0 : c);
 }
 
-/*
-** Function to unget the next character from to input file
-*/
-static void fileunput (int c)
-{
- ungetc (c, fp);
-}
-
 /*
 ** Function to get the next character from the input string
 */
@@ -66,14 +57,6 @@ static int stringinput (void)
  return (*(st-1));
 }
 
-/*
-** Function to unget the next character from to input string
-*/
-static void stringunput (int c)
-{
- st--;
-}
-
 /*
 ** Function to open a file to be input unit. 
 ** Return 0 on success or 1 on error.
@@ -82,7 +65,6 @@ int lua_openfile (char *fn)
 {
  lua_linenumber = 1;
  lua_setinput (fileinput);
- lua_setunput (fileunput);
  fp = fopen (fn, "r");
  if (fp == NULL) return 1;
  if (lua_addfile (fn)) return 1;
@@ -96,6 +78,7 @@ void lua_closefile (void)
 {
  if (fp != NULL)
  {
+  lua_delfile();
   fclose (fp);
   fp = NULL;
  }
@@ -108,7 +91,6 @@ int lua_openstring (char *s)
 {
  lua_linenumber = 1;
  lua_setinput (stringinput);
- lua_setunput (stringunput);
  st = s;
  {
   char sn[64];
@@ -118,6 +100,14 @@ int lua_openstring (char *s)
  return 0;
 }
 
+/*
+** Function to close an opened string
+*/
+void lua_closestring (void)
+{
+ lua_delfile();
+}
+
 /*
 ** Call user function to handle error messages, if registred. Or report error
 ** using standard function (fprintf).
@@ -168,12 +158,12 @@ void lua_reportbug (char *s)
   {
    sprintf (strchr(msg,0), 
          "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
-         lua_debugline, s_name(funcstack[nfuncstack-1].function),
+         lua_debugline, lua_varname(funcstack[nfuncstack-1].function),
   	 lua_file[funcstack[nfuncstack-1].file]);
    sprintf (strchr(msg,0), "\n\tactive stack\n");
    for (i=nfuncstack-1; i>=0; i--)
     sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n", 
-                            s_name(funcstack[i].function),
+                            lua_varname(funcstack[i].function),
 			    lua_file[funcstack[i].file]);
   }
   else

inout.h

@@ -1,9 +1,5 @@
 /*
-** inout.h
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
+** $Id: $
 */
 
 
@@ -17,6 +13,7 @@ extern int lua_debugline;
 int  lua_openfile     (char *fn);
 void lua_closefile    (void);
 int  lua_openstring   (char *s);
+void lua_closestring  (void);
 int  lua_pushfunction (int file, int function);
 void lua_popfunction  (void);
 void lua_reportbug    (char *s);

iolib.c

@@ -1,20 +1,21 @@
 /*
 ** iolib.c
 ** Input/output library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
+char *rcs_iolib="$Id: iolib.c,v 1.3 1994/03/28 15:14:02 celes Exp celes $";
+
 #include <stdlib.h>
 #include <string.h>
 #include <stdio.h>
 #include <ctype.h>
+#include <sys/stat.h>
 #ifdef __GNUC__
 #include <floatingpoint.h>
 #endif
 
+#include "mm.h"
+
 #include "lua.h"
 
 static FILE *in=stdin, *out=stdout;
@@ -109,6 +110,58 @@ static void io_writeto (void)
 }
 
 
+/*
+** Open a file to write appended.
+** LUA interface:
+**			status = appendto (filename)
+** where:
+**			status = 2 -> success (already exist)
+**			status = 1 -> success (new file)
+**			status = 0 -> error
+*/
+static void io_appendto (void)
+{
+ lua_Object o = lua_getparam (1);
+ if (o == NULL)			/* restore standart output */
+ {
+  if (out != stdout)
+  {
+   fclose (out);
+   out = stdout;
+  }
+  lua_pushnumber (1);
+ }
+ else
+ {
+  if (!lua_isstring (o))
+  {
+   lua_error ("incorrect argument to function 'appendto`");
+   lua_pushnumber (0);
+  }
+  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);
+   }
+  }
+ }
+}
+
+
+
 /*
 ** Read a variable. On error put nil on stack.
 ** LUA interface:
@@ -126,7 +179,7 @@ static void io_writeto (void)
 static void io_read (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL)			/* free format */
+ if (o == NULL || !lua_isstring(o))	/* free format */
  {
   int c;
   char s[256];
@@ -134,19 +187,31 @@ static void io_read (void)
    ;
   if (c == '\"')
   {
-   if (fscanf (in, "%[^\"]\"", s) != 1)
+   int c, n=0;
+   while((c = fgetc(in)) != '\"')
    {
-    lua_pushnil ();
-    return;
+    if (c == EOF)
+    {
+     lua_pushnil ();
+     return;
+    }
+    s[n++] = c;
    }
+   s[n] = 0;
   }
   else if (c == '\'')
   {
-   if (fscanf (in, "%[^\']\'", s) != 1)
+   int c, n=0;
+   while((c = fgetc(in)) != '\'')
    {
-    lua_pushnil ();
-    return;
+    if (c == EOF)
+    {
+     lua_pushnil ();
+     return;
+    }
+    s[n++] = c;
    }
+   s[n] = 0;
   }
   else
   {
@@ -183,7 +248,16 @@ static void io_read (void)
    char f[80];
    char s[256];
    sprintf (f, "%%%ds", m);
-   fscanf (in, f, s);
+   if (fgets (s, m, in) == NULL)
+   {
+    lua_pushnil();
+    return;
+   }
+   else
+   {
+    if (s[strlen(s)-1] == '\n')
+     s[strlen(s)-1] = 0;
+   }
    switch (tolower(t))
    {
     case 'i':
@@ -212,22 +286,25 @@ static void io_read (void)
     case 'i':
     {
      long int l;
-     fscanf (in, "%ld", &l);
-     lua_pushnumber(l);
+     if (fscanf (in, "%ld", &l) == EOF)
+       lua_pushnil();
+       else lua_pushnumber(l);
     }
     break;
     case 'f': case 'g': case 'e':
     {
      float f;
-     fscanf (in, "%f", &f);
-     lua_pushnumber(f);
+     if (fscanf (in, "%f", &f) == EOF)
+       lua_pushnil();
+       else lua_pushnumber(f);
     }
     break;
     default: 
     {
      char s[256];
-     fscanf (in, "%s", s);
-     lua_pushstring(s);
+     if (fscanf (in, "%s", s) == EOF)
+       lua_pushnil();
+       else lua_pushstring(s);
     }
     break;
    }
@@ -346,8 +423,8 @@ static void io_write (void)
 }
 
 /*
-** Execute a executable program using "sustem".
-** On error put 0 on stack, otherwise put 1.
+** Execute a executable program using "system".
+** Return the result of execution.
 */
 void io_execute (void)
 {
@@ -359,8 +436,8 @@ void io_execute (void)
  }
  else
  {
-  system(lua_getstring(o));
-  lua_pushnumber (1);
+  int res = system(lua_getstring(o));
+  lua_pushnumber (res);
  }
  return;
 }
@@ -394,6 +471,7 @@ void iolib_open (void)
 {
  lua_register ("readfrom", io_readfrom);
  lua_register ("writeto",  io_writeto);
+ lua_register ("appendto", io_appendto);
  lua_register ("read",     io_read);
  lua_register ("write",    io_write);
  lua_register ("execute",  io_execute);

lex.c

@@ -0,0 +1,233 @@
+char *rcs_lex = "$Id: lex.c,v 1.3 1993/12/28 16:42:29 roberto Exp celes $";
+/*$Log: lex.c,v $
+ * Revision 1.3  1993/12/28  16:42:29  roberto
+ * "include"s de string.h e stdlib.h para evitar warnings
+ *
+ * Revision 1.2  1993/12/22  21:39:15  celes
+ * Tratamento do token $debug e $nodebug
+ *
+ * Revision 1.1  1993/12/22  21:15:16  roberto
+ * Initial revision
+ **/
+
+#include <ctype.h>
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "y.tab.h"
+
+#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 *yytextLast;
+
+static Input input;
+
+void lua_setinput (Input fn)
+{
+  current = ' ';
+  input = fn;
+}
+
+char *lua_lasttext (void)
+{
+  *yytextLast = 0;
+  return yytext;
+}
+
+
+static struct 
+  {
+    char *name;
+    int token;
+  } reserved [] = {
+      {"and", AND},
+      {"do", DO},
+      {"else", ELSE},
+      {"elseif", ELSEIF},
+      {"end", END},
+      {"function", FUNCTION},
+      {"if", IF},
+      {"local", LOCAL},
+      {"nil", NIL},
+      {"not", NOT},
+      {"or", OR},
+      {"repeat", REPEAT},
+      {"return", RETURN},
+      {"then", THEN},
+      {"until", UNTIL},
+      {"while", WHILE} };
+
+#define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
+
+
+int findReserved (char *name)
+{
+  int l = 0;
+  int h = RESERVEDSIZE - 1;
+  while (l <= h)
+  {
+    int m = (l+h)/2;
+    int comp = strcmp(name, reserved[m].name);
+    if (comp < 0)
+      h = m-1;
+    else if (comp == 0)
+      return reserved[m].token;
+    else
+      l = m+1;
+  }
+  return 0;
+}
+
+
+int yylex ()
+{
+  while (1)
+  {
+    yytextLast = yytext;
+    switch (current)
+    {
+      case '\n': lua_linenumber++;
+      case ' ':
+      case '\t':
+        next();
+        continue;
+
+      case '$':
+	next();
+	while (isalnum(current) || current == '_')
+          save_and_next();
+        *yytextLast = 0;
+	if (strcmp(yytext, "debug") == 0)
+	{
+	  yylval.vInt = 1;
+	  return DEBUG;
+        }
+	else if (strcmp(yytext, "nodebug") == 0)
+	{
+	  yylval.vInt = 0;
+	  return DEBUG;
+        }
+	return WRONGTOKEN;
+  
+      case '-':
+        save_and_next();
+        if (current != '-') return '-';
+        do { next(); } while (current != '\n' && current != 0);
+        continue;
+  
+      case '<':
+        save_and_next();
+        if (current != '=') return '<';
+        else { save_and_next(); return LE; }
+  
+      case '>':
+        save_and_next();
+        if (current != '=') return '>';
+        else { save_and_next(); return GE; }
+  
+      case '~':
+        save_and_next();
+        if (current != '=') return '~';
+        else { save_and_next(); return NE; }
+
+      case '"':
+      case '\'':
+      {
+        int del = current;
+        next();  /* skip the delimiter */
+        while (current != del) 
+        {
+          switch (current)
+          {
+            case 0: 
+            case '\n': 
+              return WRONGTOKEN;
+            case '\\':
+              next();  /* do not save the '\' */
+              switch (current)
+              {
+                case 'n': save('\n'); next(); break;
+                case 't': save('\t'); next(); break;
+                case 'r': save('\r'); next(); break;
+                default : save('\\'); break;
+              }
+              break;
+            default: 
+              save_and_next();
+          }
+        }
+        next();  /* skip the delimiter */
+        *yytextLast = 0;
+        yylval.vWord = lua_findconstant (yytext);
+        return STRING;
+      }
+
+      case 'a': case 'b': case 'c': case 'd': case 'e':
+      case 'f': case 'g': case 'h': case 'i': case 'j':
+      case 'k': case 'l': case 'm': case 'n': case 'o':
+      case 'p': case 'q': case 'r': case 's': case 't':
+      case 'u': case 'v': case 'w': case 'x': case 'y':
+      case 'z':
+      case 'A': case 'B': case 'C': case 'D': case 'E':
+      case 'F': case 'G': case 'H': case 'I': case 'J':
+      case 'K': case 'L': case 'M': case 'N': case 'O':
+      case 'P': case 'Q': case 'R': case 'S': case 'T':
+      case 'U': case 'V': case 'W': case 'X': case 'Y':
+      case 'Z':
+      case '_':
+      {
+        int res;
+        do { save_and_next(); } while (isalnum(current) || current == '_');
+        *yytextLast = 0;
+        res = findReserved(yytext);
+        if (res) return res;
+        yylval.pChar = yytext;
+        return NAME;
+      }
+   
+      case '.':
+        save_and_next();
+        if (current == '.') 
+        { 
+          save_and_next(); 
+          return CONC;
+        }
+        else if (!isdigit(current)) return '.';
+        /* current is a digit: goes through to number */
+        goto fraction;
+
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+      
+        do { save_and_next(); } while (isdigit(current));
+        if (current == '.') save_and_next();
+fraction: while (isdigit(current)) save_and_next();
+        if (current == 'e' || current == 'E')
+        {
+          save_and_next();
+          if (current == '+' || current == '-') save_and_next();
+          if (!isdigit(current)) return WRONGTOKEN;
+          do { save_and_next(); } while (isdigit(current));
+        }
+        *yytextLast = 0;
+        yylval.vFloat = atof(yytext);
+        return NUMBER;
+
+      default: 		/* also end of file */
+      {
+        save_and_next();
+        return *yytext;      
+      }
+    }
+  }
+}
+        

lex_yy.c

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

lua.c

@@ -1,54 +1,31 @@
 /*
 ** lua.c
 ** Linguagem para Usuarios de Aplicacao
-** TeCGraf - PUC-Rio
-** 28 Apr 93
 */
 
+char *rcs_lua="$Id: $";
+
 #include <stdio.h>
 
 #include "lua.h"
 #include "lualib.h"
 
 
-void test (void)
-{
-  lua_pushobject(lua_getparam(1));
-  lua_call ("c", 1);
-}
-
-
-static void callfunc (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj)) lua_call(lua_getstring(obj),0);
-}
-
-static void execstr (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj)) lua_dostring(lua_getstring(obj));
-}
-
 void main (int argc, char *argv[])
 {
  int i;
- if (argc < 2)
- {
-  puts ("usage: lua filename [functionnames]");
-  return;
- }
- lua_register ("callfunc", callfunc);
- lua_register ("execstr", execstr);
- lua_register ("test", test);
  iolib_open ();
  strlib_open ();
  mathlib_open ();
- lua_dofile (argv[1]);
- for (i=2; i<argc; i++)
+ if (argc < 2)
  {
-  lua_call (argv[i],0);
+   char buffer[250];
+   while (gets(buffer) != 0)
+     lua_dostring(buffer);
  }
+ else
+   for (i=1; i<argc; i++)
+    lua_dofile (argv[i]);
 }
 
 

lua.h

@@ -2,7 +2,7 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** 19 May 93
+** $Id: $
 */
 
 

lua.lex

@@ -0,0 +1,85 @@
+%{
+
+char *rcs_lualex = "$Id: $";
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "y.tab.h"
+
+#undef input
+#undef unput
+
+static Input input;
+static Unput unput;
+
+void lua_setinput (Input fn)
+{
+ input = fn;
+}
+
+void lua_setunput (Unput fn)
+{
+ unput = fn;
+}
+
+char *lua_lasttext (void)
+{
+ return yytext;
+}
+
+%}
+
+
+%%
+[ \t]*					;
+^"$debug"				{yylval.vInt = 1; return DEBUG;}
+^"$nodebug"				{yylval.vInt = 0; return DEBUG;}
+\n					lua_linenumber++;
+"--".*					;
+"local"					return LOCAL;
+"if"					return IF;
+"then"					return THEN;
+"else"					return ELSE;
+"elseif"				return ELSEIF;
+"while"					return WHILE;
+"do"					return DO;
+"repeat"				return REPEAT;
+"until"					return UNTIL;
+"function"				{
+                                         yylval.vWord = lua_nfile-1;
+                                         return FUNCTION;
+					}
+"end"					return END;
+"return" 				return RETURN;
+"local" 				return LOCAL;
+"nil"					return NIL;
+"and"					return AND;
+"or"					return OR;
+"not"					return NOT;
+"~="					return NE;
+"<="					return LE;
+">="					return GE;
+".."					return CONC;
+\"[^\"]*\" 			| 
+\'[^\']*\'			      {
+				       yylval.vWord = lua_findenclosedconstant (yytext);
+				       return STRING;
+				      }
+[0-9]+("."[0-9]*)?	|
+([0-9]+)?"."[0-9]+	|
+[0-9]+("."[0-9]*)?[dDeEgG][+-]?[0-9]+ |
+([0-9]+)?"."[0-9]+[dDeEgG][+-]?[0-9]+ {
+				        yylval.vFloat = atof(yytext);
+				        return NUMBER;
+				       }
+[a-zA-Z_][a-zA-Z0-9_]*  	       {
+					yylval.vWord = lua_findsymbol (yytext);
+					return NAME;
+				       }
+.					return  *yytext;
+

lua.stx

@@ -0,0 +1,954 @@
+%{
+
+char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp celes $";
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "mm.h"
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "lua.h"
+
+#define LISTING 0
+
+#ifndef CODE_BLOCK
+#define CODE_BLOCK 256
+#endif
+static Long   maxcode;
+static Long   maxmain;
+static Long   maxcurr ;
+static Byte  *code = NULL;
+static Byte  *initcode;
+static Byte  *basepc;
+static Long   maincode;
+static Long   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 */
+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;
+static int     ntemp;		     /* number of temporary var into stack */
+static int     err;		     /* flag to indicate error */
+
+/* Internal functions */
+
+static void code_byte (Byte c)
+{
+ if (pc>maxcurr-2)  /* 1 byte free to code HALT of main code */
+ {
+  maxcurr *= 2;
+  basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte));
+  if (basepc == NULL)
+  {
+   lua_error ("not enough memory");
+   err = 1;
+  }
+ }
+ basepc[pc++] = c;
+}
+
+static void code_word (Word n)
+{
+ CodeWord code;
+ code.w = n;
+ code_byte(code.m.c1);
+ code_byte(code.m.c2);
+}
+
+static void code_float (float n)
+{
+ CodeFloat code;
+ code.f = n;
+ code_byte(code.m.c1);
+ code_byte(code.m.c2);
+ code_byte(code.m.c3);
+ code_byte(code.m.c4);
+}
+
+static void code_word_at (Byte *p, Word n)
+{
+ CodeWord code;
+ code.w = n;
+ *p++ = code.m.c1;
+ *p++ = code.m.c2;
+}
+
+static void push_field (Word name)
+{
+  if (nfields < STACKGAP-1)
+    fields[nfields++] = name;
+  else
+  {
+   lua_error ("too many fields in a constructor");
+   err = 1;
+  }
+}
+
+static void flush_record (int n)
+{
+  int i;
+  if (n == 0) return;
+  code_byte(STORERECORD);
+  code_byte(n);
+  for (i=0; i<n; i++)
+    code_word(fields[--nfields]);
+  ntemp -= n;
+}
+
+static void flush_list (int m, int n)
+{
+  if (n == 0) return;
+  if (m == 0)
+    code_byte(STORELIST0); 
+  else
+  {
+    code_byte(STORELIST);
+    code_byte(m);
+  }
+  code_byte(n);
+  ntemp-=n;
+}
+
+static void incr_ntemp (void)
+{
+ if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
+  ntemp++;
+ else
+ {
+  lua_error ("stack overflow");
+  err = 1;
+ }
+}
+
+static void add_nlocalvar (int n)
+{
+ if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
+  nlocalvar += n;
+ else
+ {
+  lua_error ("too many local variables or expression too complicate");
+  err = 1;
+ }
+}
+
+static void incr_nvarbuffer (void)
+{
+ if (nvarbuffer < MAXVAR-1)
+  nvarbuffer++;
+ else
+ {
+  lua_error ("variable buffer overflow");
+  err = 1;
+ }
+}
+
+static void code_number (float f)
+{ 
+  Word i = (Word)f;
+  if (f == (float)i)  /* f has an (short) integer value */
+  {
+   if (i <= 2) code_byte(PUSH0 + i);
+   else if (i <= 255)
+   {
+    code_byte(PUSHBYTE);
+    code_byte(i);
+   }
+   else
+   {
+    code_byte(PUSHWORD);
+    code_word(i);
+   }
+  }
+  else
+  {
+   code_byte(PUSHFLOAT);
+   code_float(f);
+  }
+  incr_ntemp();
+}
+
+%}
+
+
+%union 
+{
+ int   vInt;
+ float vFloat;
+ char *pChar;
+ Word  vWord;
+ Long  vLong;
+ Byte *pByte;
+}
+
+%start functionlist
+
+%token WRONGTOKEN
+%token NIL
+%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
+%token RETURN
+%token LOCAL
+%token <vFloat> NUMBER
+%token <vWord>  FUNCTION STRING
+%token <pChar>   NAME 
+%token <vInt>   DEBUG
+
+%type <vLong> PrepJump
+%type <vInt>  expr, exprlist, exprlist1, varlist1, typeconstructor
+%type <vInt>  fieldlist, localdeclist
+%type <vInt>  ffieldlist, ffieldlist1
+%type <vInt>  lfieldlist, lfieldlist1
+%type <vLong> var, objectname
+
+
+%left AND OR
+%left '=' NE '>' '<' LE GE
+%left CONC
+%left '+' '-'
+%left '*' '/'
+%left UNARY NOT
+
+
+%% /* beginning of rules section */
+
+
+functionlist : /* empty */
+	     | functionlist 
+	        {
+	  	  pc=maincode; basepc=initcode; maxcurr=maxmain;
+		  nlocalvar=0;
+	        }
+	       stat sc 
+		{
+		  maincode=pc; initcode=basepc; maxmain=maxcurr;
+		}
+	     | functionlist function
+	     | functionlist setdebug
+	     ;
+	     
+function     : FUNCTION NAME 
+	       {
+		if (code == NULL)	/* first function */
+		{
+		 code = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
+		 if (code == NULL)
+		 {
+		  lua_error("not enough memory");
+		  err = 1;
+		 }
+		 maxcode = CODE_BLOCK;
+		}
+		pc=0; basepc=code; maxcurr=maxcode; 
+		nlocalvar=0;
+		$<vWord>$ = lua_findsymbol($2); 
+	       }
+	       '(' parlist ')' 
+	       {
+	        if (lua_debug)
+		{
+	         code_byte(SETFUNCTION); 
+                 code_word(lua_nfile-1);
+		 code_word($<vWord>3);
+		}
+	        lua_codeadjust (0);
+	       }
+               block
+               END 	 
+	       { 
+                if (lua_debug) code_byte(RESET); 
+	        code_byte(RETCODE); code_byte(nlocalvar);
+	        s_tag($<vWord>3) = T_FUNCTION;
+	        s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte));
+		if (s_bvalue($<vWord>3) == NULL)
+		{
+		 lua_error("not enough memory");
+		 err = 1;
+		}
+	        memcpy (s_bvalue($<vWord>3), basepc, pc*sizeof(Byte));
+		code = basepc; maxcode=maxcurr;
+#if LISTING
+PrintCode(code,code+pc);
+#endif
+	       }
+	       ;
+
+statlist : /* empty */
+	 | statlist stat sc
+	 ;
+
+stat	 : {
+            ntemp = 0; 
+            if (lua_debug)
+            {
+             code_byte(SETLINE); code_word(lua_linenumber);
+            }
+	   }
+	   stat1
+		
+sc	 : /* empty */ | ';' ;
+
+
+stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
+       {
+        {
+	 Long elseinit = $6+sizeof(Word)+1;
+	 if (pc - elseinit == 0)		/* no else */
+	 {
+	  pc -= sizeof(Word)+1;
+	  elseinit = pc;
+	 }
+	 else
+	 {
+	  basepc[$6] = JMP;
+	  code_word_at(basepc+$6+1, pc - elseinit);
+	 }
+	 basepc[$4] = IFFJMP;
+	 code_word_at(basepc+$4+1,elseinit-($4+sizeof(Word)+1));
+	}
+       }
+     
+       | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
+     	
+       {
+        basepc[$5] = IFFJMP;
+	code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
+        
+        basepc[$7] = UPJMP;
+	code_word_at(basepc+$7+1, pc - ($<vLong>2));
+       }
+     
+       | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump
+     	
+       {
+        basepc[$6] = IFFUPJMP;
+	code_word_at(basepc+$6+1, pc - ($<vLong>2));
+       }
+
+
+       | varlist1 '=' exprlist1
+       {
+        {
+         int i;
+         if ($3 == 0 || nvarbuffer != ntemp - $1 * 2)
+	  lua_codeadjust ($1 * 2 + nvarbuffer);
+	 for (i=nvarbuffer-1; i>=0; i--)
+	  lua_codestore (i);
+	 if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
+	  lua_codeadjust (0);
+	}
+       } 
+       | functioncall			{ lua_codeadjust (0); }
+       | typeconstructor                { lua_codeadjust (0); }
+       | LOCAL localdeclist decinit   { add_nlocalvar($2); lua_codeadjust (0); }
+       ;
+
+elsepart : /* empty */
+	 | ELSE block
+         | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
+         {
+          {
+  	   Long elseinit = $6+sizeof(Word)+1;
+  	   if (pc - elseinit == 0)		/* no else */
+  	   {
+  	    pc -= sizeof(Word)+1;
+	    elseinit = pc;
+	   }
+	   else
+	   {
+	    basepc[$6] = JMP;
+	    code_word_at(basepc+$6+1, pc - elseinit);
+	   }
+	   basepc[$4] = IFFJMP;
+	   code_word_at(basepc+$4+1, elseinit - ($4 + sizeof(Word)+1));
+	  }  
+         }   
+         ;
+     
+block    : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret 
+         {
+	  if (nlocalvar != $<vInt>1)
+	  {
+           nlocalvar = $<vInt>1;
+	   lua_codeadjust (0);
+	  }
+         }
+         ;
+
+ret	: /* empty */
+        | { if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}}
+          RETURN  exprlist sc 	
+          { 
+           if (lua_debug) code_byte(RESET); 
+           code_byte(RETCODE); code_byte(nlocalvar);
+          }
+	;
+
+PrepJump : /* empty */
+	 { 
+	  $$ = pc;
+	  code_byte(0);		/* open space */
+	  code_word (0);
+         }
+	   
+expr1	 : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}}
+	 ;
+				
+expr :	'(' expr ')'    { $$ = $2; }
+     |	expr1 '=' expr1	{ code_byte(EQOP);   $$ = 1; ntemp--;}
+     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 1; ntemp--;}
+     |	expr1 '>' expr1	{ code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 1; ntemp--;}
+     |	expr1 GE  expr1	{ code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;}
+     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 1; ntemp--;}
+     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 1; ntemp--;}
+     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;}
+     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 1; ntemp--;}
+     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 1; ntemp--;}
+     |	'+' expr1 %prec UNARY	{ $$ = 1; }
+     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 1;}
+     | typeconstructor { $$ = $1; }
+     |  '@' '(' dimension ')'
+     { 
+      code_byte(CREATEARRAY);
+      $$ = 1;
+     }
+     |	var             { lua_pushvar ($1); $$ = 1;}
+     |	NUMBER          { code_number($1); $$ = 1; }
+     |	STRING
+     {
+      code_byte(PUSHSTRING);
+      code_word($1);
+      $$ = 1;
+      incr_ntemp();
+     }
+     |	NIL		{code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
+     |	functioncall
+     {
+      $$ = 0;
+      if (lua_debug)
+      {
+       code_byte(SETLINE); code_word(lua_linenumber);
+      }
+     }
+     |	NOT expr1	{ code_byte(NOTOP);  $$ = 1;}
+     |	expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1
+     { 
+      basepc[$3] = ONFJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 1;
+     }
+     |	expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1	
+     { 
+      basepc[$3] = ONTJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 1;
+     }
+     ;
+
+typeconstructor: '@'  
+     {
+      code_byte(PUSHBYTE);
+      $<vLong>$ = pc; code_byte(0);
+      incr_ntemp();
+      code_byte(CREATEARRAY);
+     }
+      objectname fieldlist 
+     {
+      basepc[$<vLong>2] = $4; 
+      if ($3 < 0)	/* there is no function to be called */
+      {
+       $$ = 1;
+      }
+      else
+      {
+       lua_pushvar ($3+1);
+       code_byte(PUSHMARK);
+       incr_ntemp();
+       code_byte(PUSHOBJECT);
+       incr_ntemp();
+       code_byte(CALLFUNC); 
+       ntemp -= 4;
+       $$ = 0;
+       if (lua_debug)
+       {
+        code_byte(SETLINE); code_word(lua_linenumber);
+       }
+      }
+     }
+         ;
+
+dimension    : /* empty */	{ code_byte(PUSHNIL); incr_ntemp();}
+	     | expr1
+	     ;
+	     
+functioncall : functionvalue  {code_byte(PUSHMARK); $<vInt>$ = ntemp; incr_ntemp();}
+                '(' exprlist ')' { code_byte(CALLFUNC); ntemp = $<vInt>2-1;}
+
+functionvalue : var {lua_pushvar ($1); } 
+	      ;
+		
+exprlist  :	/* empty */		{ $$ = 1; }
+	  |	exprlist1		{ $$ = $1; }
+	  ;
+		
+exprlist1 :	expr			{ $$ = $1; }
+	  |	exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}} 
+                 expr {$$ = $4;}
+	  ;
+
+parlist  :	/* empty */
+	  |	parlist1
+	  ;
+		
+parlist1 :	NAME		  
+		{
+		 localvar[nlocalvar]=lua_findsymbol($1); 
+		 add_nlocalvar(1);
+		}
+	  |	parlist1 ',' NAME 
+		{
+		 localvar[nlocalvar]=lua_findsymbol($3); 
+		 add_nlocalvar(1);
+		}
+	  ;
+		
+objectname :	/* empty */ 	{$$=-1;}
+	   |	NAME		{$$=lua_findsymbol($1);}
+	   ;
+	   
+fieldlist  : '{' ffieldlist '}'  
+	      { 
+	       flush_record($2%FIELDS_PER_FLUSH); 
+	       $$ = $2;
+	      }
+           | '[' lfieldlist ']'  
+	      { 
+	       flush_list($2/FIELDS_PER_FLUSH, $2%FIELDS_PER_FLUSH);
+	       $$ = $2;
+     	      }
+	   ;
+
+ffieldlist : /* empty */   { $$ = 0; }
+           | ffieldlist1   { $$ = $1; }
+           ;
+
+ffieldlist1 : ffield			{$$=1;}
+	   | ffieldlist1 ',' ffield	
+		{
+		  $$=$1+1;
+		  if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
+		}
+	   ; 
+
+ffield      : NAME {$<vWord>$ = lua_findconstant($1);} '=' expr1 
+	      { 
+	       push_field($<vWord>2);
+	      }
+           ;
+
+lfieldlist : /* empty */   { $$ = 0; }
+           | lfieldlist1   { $$ = $1; }
+           ;
+
+lfieldlist1 : expr1  {$$=1;}
+	    | lfieldlist1 ',' expr1
+		{
+		  $$=$1+1;
+		  if ($$%FIELDS_PER_FLUSH == 0) 
+		    flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH);
+		}
+            ;
+
+varlist1  :	var			
+	  {
+	   nvarbuffer = 0; 
+           varbuffer[nvarbuffer] = $1; incr_nvarbuffer();
+	   $$ = ($1 == 0) ? 1 : 0;
+	  }
+	  |	varlist1 ',' var	
+	  { 
+           varbuffer[nvarbuffer] = $3; incr_nvarbuffer();
+	   $$ = ($3 == 0) ? $1 + 1 : $1;
+	  }
+	  ;
+		
+var	  :	NAME
+	  {
+	   Word s = lua_findsymbol($1);
+	   int local = lua_localname (s);
+	   if (local == -1)	/* global var */
+	    $$ = s + 1;		/* return positive value */
+           else
+	    $$ = -(local+1);		/* return negative value */
+	  }
+	  
+	  |	var {lua_pushvar ($1);} '[' expr1 ']' 
+	  {
+	   $$ = 0;		/* indexed variable */
+	  }
+	  |	var {lua_pushvar ($1);} '.' NAME
+	  {
+	   code_byte(PUSHSTRING);
+	   code_word(lua_findconstant($4)); incr_ntemp();
+	   $$ = 0;		/* indexed variable */
+	  }
+	  ;
+		
+localdeclist  : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;}
+     	  | localdeclist ',' NAME 
+	    {
+	     localvar[nlocalvar+$1]=lua_findsymbol($3); 
+	     $$ = $1+1;
+	    }
+	  ;
+		
+decinit	  : /* empty */
+	  | '=' exprlist1
+	  ;
+	  
+setdebug  : DEBUG {lua_debug = $1;}
+
+%%
+
+/*
+** Search a local name and if find return its index. If do not find return -1
+*/
+static int lua_localname (Word n)
+{
+ int i;
+ for (i=nlocalvar-1; i >= 0; i--)
+  if (n == localvar[i]) return i;	/* local var */
+ return -1;		        /* global var */
+}
+
+/*
+** Push a variable given a number. If number is positive, push global variable
+** indexed by (number -1). If negative, push local indexed by ABS(number)-1.
+** Otherwise, if zero, push indexed variable (record).
+*/
+static void lua_pushvar (long number)
+{ 
+ if (number > 0)	/* global var */
+ {
+  code_byte(PUSHGLOBAL);
+  code_word(number-1);
+  incr_ntemp();
+ }
+ else if (number < 0)	/* local var */
+ {
+  number = (-number) - 1;
+  if (number < 10) code_byte(PUSHLOCAL0 + number);
+  else
+  {
+   code_byte(PUSHLOCAL);
+   code_byte(number);
+  }
+  incr_ntemp();
+ }
+ else
+ {
+  code_byte(PUSHINDEXED);
+  ntemp--;
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ code_byte(ADJUST);
+ code_byte(n + nlocalvar);
+}
+
+static void lua_codestore (int i)
+{
+ if (varbuffer[i] > 0)		/* global var */
+ {
+  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;
+  int upper=0;     	/* number of indexed variables upper */
+  int param;		/* number of itens until indexed expression */
+  for (j=i+1; j <nvarbuffer; j++)
+   if (varbuffer[j] == 0) upper++;
+  param = upper*2 + i;
+  if (param == 0)
+   code_byte(STOREINDEXED0);
+  else
+  {
+   code_byte(STOREINDEXED);
+   code_byte(param);
+  }
+ }
+}
+
+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);
+ err = 1;
+}
+
+int yywrap (void)
+{
+ return 1;
+}
+
+
+/*
+** Parse LUA code and execute global statement.
+** Return 0 on success or 1 on error.
+*/
+int lua_parse (void)
+{
+ Byte *init = initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
+ maincode = 0; 
+ maxmain = CODE_BLOCK;
+ if (init == NULL)
+ {
+  lua_error("not enough memory");
+  return 1;
+ }
+ err = 0;
+ if (yyparse () || (err==1)) return 1;
+ initcode[maincode++] = HALT;
+ init = initcode;
+#if LISTING
+ PrintCode(init,init+maincode);
+#endif
+ if (lua_execute (init)) return 1;
+ free(init);
+ return 0;
+}
+
+
+#if LISTING
+
+static void PrintCode (Byte *code, Byte *end)
+{
+ Byte *p = code;
+ printf ("\n\nCODE\n");
+ while (p != end)
+ {
+  switch ((OpCode)*p)
+  {
+   case PUSHNIL:	printf ("%d    PUSHNIL\n", (p++)-code); break;
+   case PUSH0: case PUSH1: case PUSH2:
+    			printf ("%d    PUSH%c\n", p-code, *p-PUSH0+'0');
+    			p++;
+   			break;
+   case PUSHBYTE:
+    			printf ("%d    PUSHBYTE   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case PUSHWORD:
+                        {
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHWORD   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHFLOAT:
+			{
+			 CodeFloat c;
+			 int n = p-code;
+			 p++;
+			 get_float(c,p);
+    			 printf ("%d    PUSHFLOAT  %f\n", n, c.f);
+			}
+   			break;
+   case PUSHSTRING:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHSTRING   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
+   case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
+   case PUSHLOCAL8: case PUSHLOCAL9:
+    			printf ("%d    PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
+    			p++;
+   			break;
+   case PUSHLOCAL:	printf ("%d    PUSHLOCAL   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case PUSHGLOBAL:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHGLOBAL   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHINDEXED:    printf ("%d    PUSHINDEXED\n", (p++)-code); break;
+   case PUSHMARK:       printf ("%d    PUSHMARK\n", (p++)-code); break;
+   case PUSHOBJECT:     printf ("%d    PUSHOBJECT\n", (p++)-code); break;
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
+   case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
+   case STORELOCAL8: case STORELOCAL9:
+    			printf ("%d    STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
+    			p++;
+   			break;
+   case STORELOCAL:
+    			printf ("%d    STORELOCAL   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STOREGLOBAL:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    STOREGLOBAL   %d\n", n, c.w);
+			}
+   			break;
+   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
+   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STORELIST0:
+	printf("%d      STORELIST0  %d\n", p-code, *(++p));
+        p++;
+        break;
+   case STORELIST:
+	printf("%d      STORELIST  %d %d\n", p-code, *(p+1), *(p+2));
+        p+=3;
+        break;
+   case STORERECORD:
+       printf("%d      STORERECORD  %d\n", p-code, *(++p));
+       p += *p*sizeof(Word) + 1;
+       break;
+   case ADJUST:
+    			printf ("%d    ADJUST   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case CREATEARRAY:	printf ("%d    CREATEARRAY\n", (p++)-code); break;
+   case EQOP:       	printf ("%d    EQOP\n", (p++)-code); break;
+   case LTOP:       	printf ("%d    LTOP\n", (p++)-code); break;
+   case LEOP:       	printf ("%d    LEOP\n", (p++)-code); break;
+   case ADDOP:       	printf ("%d    ADDOP\n", (p++)-code); break;
+   case SUBOP:       	printf ("%d    SUBOP\n", (p++)-code); break;
+   case MULTOP:      	printf ("%d    MULTOP\n", (p++)-code); break;
+   case DIVOP:       	printf ("%d    DIVOP\n", (p++)-code); break;
+   case CONCOP:       	printf ("%d    CONCOP\n", (p++)-code); break;
+   case MINUSOP:       	printf ("%d    MINUSOP\n", (p++)-code); break;
+   case NOTOP:       	printf ("%d    NOTOP\n", (p++)-code); break;
+   case ONTJMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    ONTJMP  %d\n", n, c.w);
+			}
+   			break;
+   case ONFJMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    ONFJMP  %d\n", n, c.w);
+			}
+   			break;
+   case JMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    JMP  %d\n", n, c.w);
+			}
+   			break;
+   case UPJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    UPJMP  %d\n", n, c.w);
+			}
+   			break;
+   case IFFJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    IFFJMP  %d\n", n, c.w);
+			}
+   			break;
+   case IFFUPJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    IFFUPJMP  %d\n", n, c.w);
+			}
+   			break;
+   case POP:       	printf ("%d    POP\n", (p++)-code); break;
+   case CALLFUNC:	printf ("%d    CALLFUNC\n", (p++)-code); break;
+   case RETCODE:
+    			printf ("%d    RETCODE   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case HALT:		printf ("%d    HALT\n", (p++)-code); break;
+   case SETFUNCTION:
+                        {
+                         CodeWord c1, c2;
+                         int n = p-code;
+                         p++;
+                         get_word(c1,p);
+                         get_word(c2,p);
+                         printf ("%d    SETFUNCTION  %d  %d\n", n, c1.w, c2.w);
+                        }
+                        break;
+   case SETLINE:
+                        {
+                         CodeWord c;
+                         int n = p-code;
+                         p++;
+                         get_word(c,p);
+                         printf ("%d    SETLINE  %d\n", n, c.w);
+                        }
+                        break;
+
+   case RESET:		printf ("%d    RESET\n", (p++)-code); break;
+   default:		printf ("%d    Cannot happen: code %d\n", (p++)-code, *(p-1)); break;
+  }
+ }
+}
+#endif
+

lualib.h

@@ -1,8 +1,8 @@
 /*
-** Libraries to use in LUA programs
+** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** 19 May 93
+** $Id: $
 */
 
 #ifndef lualib_h
@@ -13,3 +13,4 @@ void strlib_open  (void);
 void mathlib_open (void);
 
 #endif
+

makefile

@@ -0,0 +1,53 @@
+# $Id: makefile,v 1.5 1994/01/10 19:49:56 roberto Exp celes $
+# Compilation parameters
+CC = gcc
+CFLAGS = -I/usr/5include -Wall -O2
+
+AR = ar
+ARFLAGS	= rvl
+
+# Aplication modules
+LUAMOD =	\
+	y.tab 	\
+	lex	\
+	opcode	\
+	hash	\
+	table	\
+	inout	\
+	tree
+
+LIBMOD = 	\
+	iolib	\
+	strlib	\
+	mathlib
+
+LUAOBJS	= $(LUAMOD:%=%.o)
+
+LIBOBJS	= $(LIBMOD:%=%.o)
+
+lua : lua.o lua.a lualib.a
+	$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
+
+lua.a : y.tab.c $(LUAOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib lua.a
+
+lualib.a : $(LIBOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib $@
+
+.KEEP_STATE:
+
+liblua.so.1.0 : lua.o
+	ld -o liblua.so.1.0 $(LUAOBJS)
+
+%.o	: %.c
+	$(CC) $(CFLAGS) -c -o $@ $<
+
+
+y.tab.c : lua.stx exscript
+	yacc -d lua.stx ; ex y.tab.c <exscript
+
+% : RCS/%,v
+	co $@
+

mathlib.c

@@ -1,17 +1,18 @@
 /*
 ** mathlib.c
-** Mathematica library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
+** Mathematics library to LUA
 */
 
+char *rcs_mathlib="$Id: $";
+
 #include <stdio.h>		/* NULL */
 #include <math.h>
 
 #include "lua.h"
 
+#define TODEGREE(a) ((a)*180.0/3.14159)
+#define TORAD(a)    ((a)*3.14159/180.0)
+
 static void math_abs (void)
 {
  double d;
@@ -35,7 +36,7 @@ static void math_sin (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `sin'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (sin(d));
+ lua_pushnumber (sin(TORAD(d)));
 }
 
 
@@ -49,7 +50,7 @@ static void math_cos (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `cos'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (cos(d));
+ lua_pushnumber (cos(TORAD(d)));
 }
 
 
@@ -63,7 +64,7 @@ static void math_tan (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `tan'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (tan(d));
+ lua_pushnumber (tan(TORAD(d)));
 }
 
 
@@ -76,7 +77,7 @@ static void math_asin (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `asin'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (asin(d));
+ lua_pushnumber (TODEGREE(asin(d)));
 }
 
 
@@ -89,7 +90,7 @@ static void math_acos (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `acos'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (acos(d));
+ lua_pushnumber (TODEGREE(acos(d)));
 }
 
 
@@ -103,7 +104,7 @@ static void math_atan (void)
  if (!lua_isnumber(o))
  { lua_error ("incorrect arguments to function `atan'"); return; }
  d = lua_getnumber(o);
- lua_pushnumber (atan(d));
+ lua_pushnumber (TODEGREE(atan(d)));
 }
 
 

mathlib.h

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

mm.h

@@ -0,0 +1,39 @@
+/*
+** mm.h
+** Waldemar Celes Filho
+** Sep 16, 1992
+*/
+
+
+#ifndef mm_h
+#define mm_h
+
+#include <stdlib.h>
+
+#ifdef _MM_
+
+/* switch off the debugger functions */
+#define malloc(s)	MmMalloc(s,__FILE__,__LINE__)
+#define calloc(n,s)	MmCalloc(n,s,__FILE__,__LINE__)
+#define realloc(a,s)	MmRealloc(a,s,__FILE__,__LINE__,#a)
+#define free(a)		MmFree(a,__FILE__,__LINE__,#a)
+#define strdup(s)	MmStrdup(s,__FILE__,__LINE__)
+#endif
+
+typedef void (*Ferror) (char *);
+
+/* Exported functions */
+void  MmInit (Ferror f, Ferror w);
+void *MmMalloc (unsigned size, char *file, int line);
+void *MmCalloc (unsigned n, unsigned size, char *file, int line);
+void  MmFree (void *a, char *file, int line, char *var);
+void *MmRealloc (void *old, unsigned size, char *file, int line, char *var);
+char *MmStrdup (char *s, char *file, int line);
+unsigned MmGetBytes (void);
+void MmListAllocated (void);
+void MmCheck (void);
+void MmStatistics (void);
+
+
+#endif
+

opcode.c

@@ -1,9 +1,10 @@
 /*
 ** opcode.c
 ** TecCGraf - PUC-Rio
-** 26 Apr 93
 */
 
+char *rcs_opcode="$Id: opcode.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
+
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -11,6 +12,8 @@
 #include <floatingpoint.h>
 #endif
 
+#include "mm.h"
+
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
@@ -20,11 +23,55 @@
 #define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
 #define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
 
-#ifndef MAXSTACK
-#define MAXSTACK 256
-#endif
-static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
-static Object *top=stack+1, *base=stack+1;
+
+#define STACK_BUFFER (STACKGAP+128)
+
+static Word    maxstack;
+static Object *stack=NULL;
+static Object *top, *base;
+
+
+/*
+** Init stack
+*/
+static int lua_initstack (void)
+{
+ maxstack = STACK_BUFFER;
+ stack = (Object *)calloc(maxstack, sizeof(Object));
+ if (stack == NULL)
+ {
+  lua_error("stack - not enough memory");
+  return 1;
+ }
+ tag(stack) = T_MARK;
+ top = base = stack+1;
+ return 0;
+}
+
+
+/*
+** Check stack overflow and, if necessary, realloc vector
+*/
+static int lua_checkstack (Word n)
+{
+ if (stack == NULL)
+  return lua_initstack();
+ if (n > maxstack)
+ {
+  Word t = top-stack;
+  Word b = base-stack;
+  maxstack *= 2;
+  stack = (Object *)realloc(stack, maxstack*sizeof(Object));
+  if (stack == NULL)
+  {
+   lua_error("stack - not enough memory");
+   return 1;
+  }
+  top = stack + t;
+  base = stack + b;
+ }
+ return 0;
+}
 
 
 /*
@@ -33,30 +80,14 @@ static Object *top=stack+1, *base=stack+1;
 */
 static char *lua_strconc (char *l, char *r)
 {
- char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
- if (s == NULL)
+ static char buffer[1024];
+ int n = strlen(l)+strlen(r)+1;
+ if (n > 1024)
  {
-  lua_error ("not enough memory");
+  lua_error ("string too large");
   return NULL;
  }
- *s++ = 0; 			/* create mark space */
- return strcat(strcpy(s,l),r);
-}
-
-/*
-** Duplicate a string,  creating a mark space at the beginning.
-** Return the new string pointer.
-*/
-char *lua_strdup (char *l)
-{
- char *s = calloc (strlen(l)+2, sizeof(char));
- if (s == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
- *s++ = 0; 			/* create mark space */
- return strcpy(s,l);
+ return strcat(strcpy(buffer,l),r);
 }
 
 /*
@@ -124,7 +155,7 @@ static int lua_tostring (Object *obj)
   sprintf (s, "%d", (int) nvalue(obj));
  else
   sprintf (s, "%g", nvalue(obj));
- svalue(obj) = lua_createstring(lua_strdup(s));
+ svalue(obj) = lua_createstring(s);
  if (svalue(obj) == NULL)
   return 1;
  tag(obj) = T_STRING;
@@ -137,12 +168,18 @@ static int lua_tostring (Object *obj)
 */
 int lua_execute (Byte *pc)
 {
+ Word oldbase;
+
+ if (stack == NULL)
+  lua_initstack();
+
+ oldbase = base-stack;
+ base = top;
  while (1)
  {
-  switch ((OpCode)*pc++)
+  OpCode opcode;
+  switch (opcode = (OpCode)*pc++)
   {
-   case NOP: break;
-   
    case PUSHNIL: tag(top++) = T_NIL; break;
    
    case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
@@ -152,35 +189,42 @@ int lua_execute (Byte *pc)
    case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
    
    case PUSHWORD: 
-    tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
-   break;
-   
-   case PUSHFLOAT:
-    tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
-   break;
-   case PUSHSTRING:
    {
-    int w = *((Word *)(pc));
-    pc += sizeof(Word);
-    tag(top) = T_STRING; svalue(top++) = lua_constant[w];
+    CodeWord code;
+    get_word(code,pc);
+    tag(top) = T_NUMBER; nvalue(top++) = code.w;
    }
    break;
    
-   case PUSHLOCAL0: *top++ = *(base + 0); break;
-   case PUSHLOCAL1: *top++ = *(base + 1); break;
-   case PUSHLOCAL2: *top++ = *(base + 2); break;
-   case PUSHLOCAL3: *top++ = *(base + 3); break;
-   case PUSHLOCAL4: *top++ = *(base + 4); break;
-   case PUSHLOCAL5: *top++ = *(base + 5); break;
-   case PUSHLOCAL6: *top++ = *(base + 6); break;
-   case PUSHLOCAL7: *top++ = *(base + 7); break;
-   case PUSHLOCAL8: *top++ = *(base + 8); break;
-   case PUSHLOCAL9: *top++ = *(base + 9); break;
+   case PUSHFLOAT:
+   {
+    CodeFloat code;
+    get_float(code,pc);
+    tag(top) = T_NUMBER; nvalue(top++) = code.f;
+   }
+   break;
+
+   case PUSHSTRING:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
+   }
+   break;
+   
+   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
+   case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
+   case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
+   case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); break;
    
    case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
    
    case PUSHGLOBAL: 
-    *top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
+   {
+    CodeWord code;
+    get_word(code,pc);
+    *top++ = s_object(code.w);
+   }
    break;
    
    case PUSHINDEXED:
@@ -201,21 +245,19 @@ int lua_execute (Byte *pc)
    
    case PUSHOBJECT: *top = *(top-3); top++; break;
    
-   case STORELOCAL0: *(base + 0) = *(--top); break;
-   case STORELOCAL1: *(base + 1) = *(--top); break;
-   case STORELOCAL2: *(base + 2) = *(--top); break;
-   case STORELOCAL3: *(base + 3) = *(--top); break;
-   case STORELOCAL4: *(base + 4) = *(--top); break;
-   case STORELOCAL5: *(base + 5) = *(--top); break;
-   case STORELOCAL6: *(base + 6) = *(--top); break;
-   case STORELOCAL7: *(base + 7) = *(--top); break;
-   case STORELOCAL8: *(base + 8) = *(--top); break;
-   case STORELOCAL9: *(base + 9) = *(--top); break;
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
+   case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
+   case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
+   case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--top); break;
     
    case STORELOCAL: *(base + (*pc++)) = *(--top); break;
    
    case STOREGLOBAL:
-    s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
+   {
+    CodeWord code;
+    get_word(code,pc);
+    s_object(code.w) = *(--top);
+   }
    break;
 
    case STOREINDEXED0:
@@ -245,28 +287,60 @@ int lua_execute (Byte *pc)
      if (h == NULL) return 1;
      *h = *(top-1);
     }
-    --top;
+    top--;
    }
    break;
    
-   case STOREFIELD:
-    if (tag(top-3) != T_ARRAY)
+   case STORELIST0:
+   case STORELIST:
+   {
+    int m, n;
+    Object *arr;
+    if (opcode == STORELIST0) m = 0;
+    else m = *(pc++) * FIELDS_PER_FLUSH;
+    n = *(pc++);
+    arr = top-n-1;
+    if (tag(arr) != T_ARRAY)
     {
-     lua_error ("internal error - table expected");
+     lua_reportbug ("internal error - table expected");
      return 1;
     }
-    *(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
-    top -= 2;
+    while (n)
+    {
+     tag(top) = T_NUMBER; nvalue(top) = n+m;
+     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
+     top--;
+     n--;
+    }
+   }
+   break;
+   
+   case STORERECORD:
+   {
+    int n = *(pc++);
+    Object *arr = top-n-1;
+    if (tag(arr) != T_ARRAY)
+    {
+     lua_reportbug ("internal error - table expected");
+     return 1;
+    }
+    while (n)
+    {
+     CodeWord code;
+     get_word(code,pc);
+     tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
+     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
+     top--;
+     n--;
+    }
+   }
    break;
    
    case ADJUST:
    {
     Object *newtop = base + *(pc++);
-    if (top != newtop)
-    {
-     while (top < newtop) tag(top++) = T_NIL;
-     top = newtop;
-    }
+    while (top < newtop) tag(top++) = T_NIL;
+    top = newtop;  /* top could be bigger than newtop */
    }
    break;
    
@@ -278,7 +352,7 @@ int lua_execute (Byte *pc)
      if (tonumber(top-1)) return 1;
      if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
     }
-    avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
+    avalue(top-1) = lua_createarray(nvalue(top-1));
     if (avalue(top-1) == NULL)
      return 1;
     tag(top-1) = T_ARRAY;
@@ -412,39 +486,51 @@ int lua_execute (Byte *pc)
    
    case ONTJMP:
    {
-    int n = *((Word *)(pc));
-    pc += sizeof(Word);
-    if (tag(top-1) != T_NIL) pc += n;
+    CodeWord code;
+    get_word(code,pc);
+    if (tag(top-1) != T_NIL) pc += code.w;
    }
    break;
    
    case ONFJMP:	   
    {
-    int n = *((Word *)(pc));
-    pc += sizeof(Word);
-    if (tag(top-1) == T_NIL) pc += n;
+    CodeWord code;
+    get_word(code,pc);
+    if (tag(top-1) == T_NIL) pc += code.w;
    }
    break;
    
-   case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
+   case JMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    pc += code.w;
+   }
+   break;
     
-   case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break; 
+   case UPJMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    pc -= code.w;
+   }
+   break;
    
    case IFFJMP:
    {
-    int n = *((Word *)(pc));
-    pc += sizeof(Word);
+    CodeWord code;
+    get_word(code,pc);
     top--;
-    if (tag(top) == T_NIL) pc += n;
+    if (tag(top) == T_NIL) pc += code.w;
    }
    break;
 
    case IFFUPJMP:
    {
-    int n = *((Word *)(pc));
-    pc += sizeof(Word);
+    CodeWord code;
+    get_word(code,pc);
     top--;
-    if (tag(top) == T_NIL) pc -= n;
+    if (tag(top) == T_NIL) pc -= code.w;
    }
    break;
 
@@ -463,11 +549,8 @@ int lua_execute (Byte *pc)
      nvalue(b) = (base-stack);		/* store base value */
      base = b+1;
      pc = newpc;
-     if (MAXSTACK-(base-stack) < STACKGAP)
-     {
-      lua_error ("stack overflow");
+     if (lua_checkstack(STACKGAP+(base-stack)))
       return 1;
-     }
     }
     else if (tag(b-1) == T_CFUNCTION)
     {
@@ -516,23 +599,25 @@ int lua_execute (Byte *pc)
    break;
    
    case HALT:
+    base = stack+oldbase;
    return 0;		/* success */
    
    case SETFUNCTION:
    {
-    int file, func;
-    file = *((Word *)(pc));
-    pc += sizeof(Word);
-    func = *((Word *)(pc));
-    pc += sizeof(Word);
-    if (lua_pushfunction (file, func))
+    CodeWord file, func;
+    get_word(file,pc);
+    get_word(func,pc);
+    if (lua_pushfunction (file.w, func.w))
      return 1;
    }
    break;
    
    case SETLINE:
-    lua_debugline = *((Word *)(pc));
-    pc += sizeof(Word);
+   {
+    CodeWord code;
+    get_word(code,pc);
+    lua_debugline = code.w;
+   }
    break;
    
    case RESET:
@@ -548,13 +633,13 @@ int lua_execute (Byte *pc)
 
 
 /*
-** Mark all strings and arrays used by any object stored at stack.
+** Traverse all objects on stack
 */
-void lua_markstack (void)
+void lua_travstack (void (*fn)(Object *))
 {
  Object *o;
  for (o = top-1; o >= stack; o--)
-  lua_markobject (o);
+  fn (o);
 }
 
 /*
@@ -577,6 +662,7 @@ int lua_dostring (char *string)
 {
  if (lua_openstring (string)) return 1;
  if (lua_parse ()) return 1;
+ lua_closestring();
  return 0;
 }
 
@@ -612,6 +698,7 @@ Object *lua_getparam (int number)
 */
 real lua_getnumber (Object *object)
 {
+ if (object == NULL || tag(object) == T_NIL) return 0.0;
  if (tonumber (object)) return 0.0;
  else                   return (nvalue(object));
 }
@@ -621,6 +708,7 @@ real lua_getnumber (Object *object)
 */
 char *lua_getstring (Object *object)
 {
+ if (object == NULL || tag(object) == T_NIL) return NULL;
  if (tostring (object)) return NULL;
  else                   return (svalue(object));
 }
@@ -630,6 +718,7 @@ char *lua_getstring (Object *object)
 */
 char *lua_copystring (Object *object)
 {
+ if (object == NULL || tag(object) == T_NIL) return NULL;
  if (tostring (object)) return NULL;
  else                   return (strdup(svalue(object)));
 }
@@ -639,6 +728,7 @@ char *lua_copystring (Object *object)
 */
 lua_CFunction lua_getcfunction (Object *object)
 {
+ if (object == NULL) return NULL;
  if (tag(object) != T_CFUNCTION) return NULL;
  else                            return (fvalue(object));
 }
@@ -648,6 +738,7 @@ lua_CFunction lua_getcfunction (Object *object)
 */
 void *lua_getuserdata (Object *object)
 {
+ if (object == NULL) return NULL;
  if (tag(object) != T_USERDATA) return NULL;
  else                           return (uvalue(object));
 }
@@ -658,13 +749,14 @@ void *lua_getuserdata (Object *object)
 */
 Object *lua_getfield (Object *object, char *field)
 {
+ if (object == NULL) return NULL;
  if (tag(object) != T_ARRAY)
   return NULL;
  else
  {
   Object ref;
   tag(&ref) = T_STRING;
-  svalue(&ref) = lua_createstring(lua_strdup(field));
+  svalue(&ref) = lua_createstring(field);
   return (lua_hashdefine(avalue(object), &ref));
  }
 }
@@ -675,6 +767,7 @@ Object *lua_getfield (Object *object, char *field)
 */
 Object *lua_getindexed (Object *object, float index)
 {
+ if (object == NULL) return NULL;
  if (tag(object) != T_ARRAY)
   return NULL;
  else
@@ -711,12 +804,9 @@ Object *lua_pop (void)
 */
 int lua_pushnil (void)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
- tag(top) = T_NIL;
+ tag(top++) = T_NIL;
  return 0;
 }
 
@@ -725,11 +815,8 @@ int lua_pushnil (void)
 */
 int lua_pushnumber (real n)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
  tag(top) = T_NUMBER; nvalue(top++) = n;
  return 0;
 }
@@ -739,13 +826,10 @@ int lua_pushnumber (real n)
 */
 int lua_pushstring (char *s)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
  tag(top) = T_STRING; 
- svalue(top++) = lua_createstring(lua_strdup(s));
+ svalue(top++) = lua_createstring(s);
  return 0;
 }
 
@@ -754,11 +838,8 @@ int lua_pushstring (char *s)
 */
 int lua_pushcfunction (lua_CFunction fn)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
  tag(top) = T_CFUNCTION; fvalue(top++) = fn;
  return 0;
 }
@@ -768,11 +849,8 @@ int lua_pushcfunction (lua_CFunction fn)
 */
 int lua_pushuserdata (void *u)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
  tag(top) = T_USERDATA; uvalue(top++) = u;
  return 0;
 }
@@ -782,11 +860,8 @@ int lua_pushuserdata (void *u)
 */
 int lua_pushobject (Object *o)
 {
- if ((top-stack) >= MAXSTACK-1)
- {
-  lua_error ("stack overflow");
+ if (lua_checkstack(top-stack+1) == 1)
   return 1;
- }
  *top++ = *o;
  return 0;
 }
@@ -815,7 +890,7 @@ int lua_storefield (lua_Object object, char *field)
  {
   Object ref, *h;
   tag(&ref) = T_STRING;
-  svalue(&ref) = lua_createstring(lua_strdup(field));
+  svalue(&ref) = lua_createstring(field);
   h = lua_hashdefine(avalue(object), &ref);
   if (h == NULL) return 1;
   if (tag(top-1) == T_MARK) return 1;
@@ -900,6 +975,9 @@ int lua_isuserdata (Object *object)
 void lua_type (void)
 {
  Object *o = lua_getparam(1);
+
+ if (lua_constant == NULL)
+  lua_initconstant();
  lua_pushstring (lua_constant[tag(o)]);
 }
 
@@ -918,7 +996,7 @@ void lua_obj2number (void)
 void lua_print (void)
 {
  int i=1;
- void *obj;
+ Object *obj;
  while ((obj=lua_getparam (i++)) != NULL)
  {
   if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber (obj));
@@ -931,3 +1009,28 @@ void lua_print (void)
  }
 }
 
+/*
+** Internal function: do a file
+*/
+void lua_internaldofile (void)
+{
+ lua_Object obj = lua_getparam (1);
+ if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
+  lua_pushnumber(1);
+ else
+  lua_pushnil();
+}
+
+/*
+** Internal function: do a string
+*/
+void lua_internaldostring (void)
+{
+ lua_Object obj = lua_getparam (1);
+ if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
+  lua_pushnumber(1);
+ else
+  lua_pushnil();
+}
+
+

opcode.h

@@ -1,7 +1,6 @@
 /*
-** opcode.h
 ** TeCGraf - PUC-Rio
-** 16 Apr 92
+** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
 */
 
 #ifndef opcode_h
@@ -15,13 +14,28 @@
 #define real float
 #endif
 
+#define FIELDS_PER_FLUSH 40
+
 typedef unsigned char  Byte;
 
 typedef unsigned short Word;
 
+typedef signed long  Long;
+
+typedef union
+{
+ struct {char c1; char c2;} m;
+ Word w;
+} CodeWord;
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ float f;
+} CodeFloat;
+
 typedef enum 
 { 
- NOP,
  PUSHNIL,
  PUSH0, PUSH1, PUSH2,
  PUSHBYTE,
@@ -41,7 +55,9 @@ typedef enum
  STOREGLOBAL,
  STOREINDEXED0,
  STOREINDEXED,
- STOREFIELD,
+ STORELIST0,
+ STORELIST,
+ STORERECORD,
  ADJUST,
  CREATEARRAY,
  EQOP,
@@ -83,7 +99,6 @@ typedef enum
 
 typedef void (*Cfunction) (void);
 typedef int  (*Input) (void);
-typedef void (*Unput) (int );
 
 typedef union
 {
@@ -103,7 +118,6 @@ typedef struct Object
 
 typedef struct
 {
- char   *name;
  Object  object;
 } Symbol;
 
@@ -117,7 +131,6 @@ typedef struct
 #define uvalue(o)	((o)->value.u)
 
 /* Macros to access symbol table */
-#define s_name(i)	(lua_table[i].name)
 #define s_object(i)	(lua_table[i].object)
 #define s_tag(i)	(tag(&s_object(i)))
 #define s_nvalue(i)	(nvalue(&s_object(i)))
@@ -127,18 +140,25 @@ typedef struct
 #define s_fvalue(i)	(fvalue(&s_object(i)))
 #define s_uvalue(i)	(uvalue(&s_object(i)))
 
+#define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
+#define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
+                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
+ 
+
 
 /* Exported functions */
 int     lua_execute   (Byte *pc);
 void    lua_markstack (void);
 char   *lua_strdup (char *l);
 
-void    lua_setinput   (Input fn);	/* from "lua.lex" module */
-void    lua_setunput   (Unput fn);	/* from "lua.lex" module */
-char   *lua_lasttext   (void);		/* from "lua.lex" module */
+void    lua_setinput   (Input fn);	/* from "lex.c" module */
+char   *lua_lasttext   (void);		/* from "lex.c" module */
 int     lua_parse      (void); 		/* from "lua.stx" module */
 void    lua_type       (void);
 void 	lua_obj2number (void);
 void 	lua_print      (void);
+void 	lua_internaldofile (void);
+void 	lua_internaldostring (void);
+void    lua_travstack (void (*fn)(Object *));
 
 #endif

strlib.c

@@ -1,16 +1,16 @@
 /*
 ** strlib.c
 ** String library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
+char *rcs_strlib="$Id: strlib.c,v 1.1 1993/12/17 18:41:19 celes Exp celes $";
+
 #include <stdlib.h>
 #include <string.h>
 #include <ctype.h>
 
+#include "mm.h"
+
 
 #include "lua.h"
 
@@ -21,16 +21,18 @@
 */
 static void str_find (void)
 {
- int n;
- char *s1, *s2;
+ char *s1, *s2, *f;
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
  if (!lua_isstring(o1) || !lua_isstring(o2))
  { lua_error ("incorrect arguments to function `strfind'"); return; }
  s1 = lua_getstring(o1);
  s2 = lua_getstring(o2);
- n = strstr(s1,s2) - s1 + 1;
- lua_pushnumber (n);
+ f = strstr(s1,s2);
+ if (f != NULL)
+  lua_pushnumber (f-s1+1);
+ else
+  lua_pushnil();
 }
 
 /*
@@ -59,13 +61,15 @@ static void str_sub (void)
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
  lua_Object o3 = lua_getparam (3);
- if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
+ if (!lua_isstring(o1) || !lua_isnumber(o2))
  { lua_error ("incorrect arguments to function `strsub'"); return; }
- s = strdup (lua_getstring(o1));
+ if (o3 != NULL && !lua_isnumber(o3))
+ { lua_error ("incorrect third argument to function `strsub'"); return; }
+ s = lua_copystring(o1);
  start = lua_getnumber (o2);
- end = lua_getnumber (o3);
+ end = o3 == NULL ? strlen(s) : lua_getnumber (o3);
  if (end < start || start < 1 || end > strlen(s))
-  lua_pushstring ("");
+  lua_pushstring("");
  else
  {
   s[end] = 0;

strlib.h

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

table.c

@@ -1,169 +1,188 @@
 /*
 ** table.c
 ** Module to control static tables
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
+char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
+
 #include <stdlib.h>
 #include <string.h>
 
+#include "mm.h"
+
 #include "opcode.h"
+#include "tree.h"
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
 #include "lua.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==0)
+#define streq(s1,s2)	(s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0)
 
-#ifndef MAXSYMBOL
-#define MAXSYMBOL	512
-#endif
-static Symbol  		tablebuffer[MAXSYMBOL] = {
-                                    {"type",{T_CFUNCTION,{lua_type}}},
-                                    {"tonumber",{T_CFUNCTION,{lua_obj2number}}},
-                                    {"next",{T_CFUNCTION,{lua_next}}},
-                                    {"nextvar",{T_CFUNCTION,{lua_nextvar}}},
-                                    {"print",{T_CFUNCTION,{lua_print}}}
-                                                 };
-Symbol	       	       *lua_table=tablebuffer;
-Word   	 		lua_ntable=5;
+#define BUFFER_BLOCK 256
 
-#ifndef MAXCONSTANT
-#define MAXCONSTANT	256
-#endif
-static char  	       *constantbuffer[MAXCONSTANT] = {"mark","nil","number",
-                                                       "string","table",
-                                                       "function","cfunction"
-                                                      };
-char  	      	      **lua_constant = constantbuffer;
-Word    		lua_nconstant=T_CFUNCTION+1;
+Symbol *lua_table;
+static Word lua_ntable = 0;
+static Word lua_maxsymbol = 0;
+
+char **lua_constant;
+static Word lua_nconstant = 0;
+static Word lua_maxconstant = 0;
 
-#ifndef MAXSTRING
-#define MAXSTRING	512
-#endif
-static char 	       *stringbuffer[MAXSTRING];
-char  		      **lua_string = stringbuffer;
-Word    		lua_nstring=0;
 
-#ifndef MAXARRAY
-#define MAXARRAY	512
-#endif
-static Hash             *arraybuffer[MAXARRAY];
-Hash  	              **lua_array = arraybuffer;
-Word    		lua_narray=0;
 
 #define MAXFILE 	20
 char  		       *lua_file[MAXFILE];
 int      		lua_nfile;
 
+/* Variables to controll garbage collection */
+#define GARBAGE_BLOCK 256
+Word lua_block=GARBAGE_BLOCK; /* when garbage collector will be called */
+Word lua_nentity;   /* counter of new entities (strings and arrays) */
+
+
+/*
+** Initialise symbol table with internal functions
+*/
+static void lua_initsymbol (void)
+{
+ int n;
+ lua_maxsymbol = BUFFER_BLOCK;
+ lua_table = (Symbol *) calloc(lua_maxsymbol, sizeof(Symbol));
+ if (lua_table == NULL)
+ {
+  lua_error ("symbol table: not enough memory");
+  return;
+ }
+ n = lua_findsymbol("type"); 
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_type;
+ n = lua_findsymbol("tonumber");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_obj2number;
+ n = lua_findsymbol("next");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_next;
+ n = lua_findsymbol("nextvar");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_nextvar;
+ n = lua_findsymbol("print");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_print;
+ n = lua_findsymbol("dofile");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
+ n = lua_findsymbol("dostring");
+ s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
+}
+
+
+/*
+** Initialise constant table with pre-defined constants
+*/
+void lua_initconstant (void)
+{
+ lua_maxconstant = BUFFER_BLOCK;
+ lua_constant = (char **) calloc(lua_maxconstant, sizeof(char *));
+ if (lua_constant == NULL)
+ {
+  lua_error ("constant table: not enough memory");
+  return;
+ }
+ lua_findconstant("mark");
+ lua_findconstant("nil");
+ lua_findconstant("number");
+ lua_findconstant("string");
+ lua_findconstant("table");
+ lua_findconstant("function");
+ lua_findconstant("cfunction");
+ lua_findconstant("userdata");
+}
 
 /*
 ** Given a name, search it at symbol table and return its index. If not
-** found, allocate at end of table, checking oveflow and return its index.
+** found, allocate it.
 ** On error, return -1.
 */
 int lua_findsymbol (char *s)
 {
- int i;
- for (i=0; i<lua_ntable; i++)
-  if (streq(s,s_name(i)))
-   return i;
- if (lua_ntable >= MAXSYMBOL-1)
+ char *n; 
+ if (lua_table == NULL)
+  lua_initsymbol(); 
+ n = lua_varcreate(s);
+ if (n == NULL)
  {
-  lua_error ("symbol table overflow");
+  lua_error ("create symbol: not enough memory");
   return -1;
  }
- s_name(lua_ntable) = strdup(s);
- if (s_name(lua_ntable) == NULL)
+ if (indexstring(n) == UNMARKED_STRING)
  {
-  lua_error ("not enough memory");
-  return -1;
- }
- s_tag(lua_ntable++) = T_NIL;
- 
- return (lua_ntable-1);
-}
-
-/*
-** Given a constant string, eliminate its delimeters (" or '), search it at 
-** constant table and return its index. If not found, allocate at end of 
-** the table, checking oveflow and return its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
-*/
-int lua_findenclosedconstant (char *s)
-{
- int i, j, l=strlen(s);
- char *c = calloc (l, sizeof(char)); 	/* make a copy */
- 
- c++;		/* create mark space */
-
- /* introduce scape characters */ 
- for (i=1,j=0; i<l-1; i++)
- {
-  if (s[i] == '\\')
+  if (lua_ntable == lua_maxsymbol)
   {
-   switch (s[++i])
+   lua_maxsymbol *= 2;
+   if (lua_maxsymbol > MAX_WORD)
    {
-    case 'n': c[j++] = '\n'; break;
-    case 't': c[j++] = '\t'; break;
-    case 'r': c[j++] = '\r'; break;
-    default : c[j++] = '\\'; c[j++] = c[i]; break;
+    lua_error("symbol table overflow");
+    return -1;
+   }
+   lua_table = (Symbol *)realloc(lua_table, lua_maxsymbol*sizeof(Symbol));
+   if (lua_table == NULL)
+   {
+    lua_error ("symbol table: not enough memory");
+    return -1;
    }
   }
-  else
-   c[j++] = s[i];
+  indexstring(n) = lua_ntable;
+  s_tag(lua_ntable) = T_NIL;
+  lua_ntable++;
  }
- c[j++] = 0;
- 
- for (i=0; i<lua_nconstant; i++)
-  if (streq(c,lua_constant[i]))
-  {
-   free (c-1);
-   return i;
-  }
- if (lua_nconstant >= MAXCONSTANT-1)
- {
-  lua_error ("lua: constant string table overflow"); 
-  return -1;
- }
- lua_constant[lua_nconstant++] = c;
- return (lua_nconstant-1);
+ return indexstring(n);
 }
 
+
 /*
-** Given a constant string, search it at constant table and return its index.
-** If not found, allocate at end of the table, checking oveflow and return 
-** its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
+** Given a name, search it at constant table and return its index. If not
+** found, allocate it.
+** On error, return -1.
 */
 int lua_findconstant (char *s)
 {
- int i;
- for (i=0; i<lua_nconstant; i++)
-  if (streq(s,lua_constant[i]))
-   return i;
- if (lua_nconstant >= MAXCONSTANT-1)
+ char *n;
+ if (lua_constant == NULL)
+  lua_initconstant();
+ n = lua_constcreate(s);
+ if (n == NULL)
  {
-  lua_error ("lua: constant string table overflow"); 
+  lua_error ("create constant: not enough memory");
   return -1;
  }
+ if (indexstring(n) == UNMARKED_STRING)
  {
-  char *c = calloc(strlen(s)+2,sizeof(char));
-  c++;		/* create mark space */
-  lua_constant[lua_nconstant++] = strcpy(c,s);
+  if (lua_nconstant == lua_maxconstant)
+  {
+   lua_maxconstant *= 2;
+   if (lua_maxconstant > MAX_WORD)
+   {
+    lua_error("constant table overflow");
+    return -1;
+   }
+   lua_constant = (char**)realloc(lua_constant,lua_maxconstant*sizeof(char*));
+   if (lua_constant == NULL)
+   {
+    lua_error ("constant table: not enough memory");
+    return -1;
+   }
+  }
+  indexstring(n) = lua_nconstant;
+  lua_constant[lua_nconstant] = n;
+  lua_nconstant++;
  }
- return (lua_nconstant-1);
+ return indexstring(n);
+}
+
+
+/*
+** Traverse symbol table objects
+*/
+void lua_travsymbol (void (*fn)(Object *))
+{
+ int i;
+ for (i=0; i<lua_ntable; i++)
+  fn(&s_object(i));
 }
 
 
@@ -172,105 +191,43 @@ int lua_findconstant (char *s)
 */
 void lua_markobject (Object *o)
 {
- if (tag(o) == T_STRING)
-  lua_markstring (svalue(o)) = 1;
- else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
-   lua_hashmark (avalue(o));
+ if (tag(o) == T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
+  indexstring(svalue(o)) = MARKED_STRING;
+ else if (tag(o) == T_ARRAY)
+  lua_hashmark (avalue(o));
 }
 
+
 /*
-** Mark all strings and arrays used by any object stored at symbol table.
+** Garbage collection. 
+** Delete all unused strings and arrays.
 */
-static void lua_marktable (void)
+void lua_pack (void)
 {
- int i;
- for (i=0; i<lua_ntable; i++)
-  lua_markobject (&s_object(i));
+ /* mark stack strings */
+ lua_travstack(lua_markobject);
+ 
+ /* mark symbol table strings */
+ lua_travsymbol(lua_markobject);
+
+ lua_strcollector();
+ lua_hashcollector();
+
+ lua_nentity = 0;      /* reset counter */
 } 
 
-/*
-** Simulate a garbage colection. When string table or array table overflows,
-** this function check if all allocated strings and arrays are in use. If
-** there are unused ones, pack (compress) the tables.
-*/
-static void lua_pack (void)
-{
- lua_markstack ();
- lua_marktable ();
- 
- { /* pack string */
-  int i, j;
-  for (i=j=0; i<lua_nstring; i++)
-   if (lua_markstring(lua_string[i]) == 1)
-   {
-    lua_string[j++] = lua_string[i];
-    lua_markstring(lua_string[i]) = 0;
-   }
-   else
-   {
-    free (lua_string[i]-1);
-   }
-  lua_nstring = j;
- }
-
- { /* pack array */
-  int i, j;
-  for (i=j=0; i<lua_narray; i++)
-   if (markarray(lua_array[i]) == 1)
-   {
-    lua_array[j++] = lua_array[i];
-    markarray(lua_array[i]) = 0;
-   }
-   else
-   {
-    lua_hashdelete (lua_array[i]);
-   }
-  lua_narray = j;
- }
-}
 
 /*
-** Allocate a new string at string table. The given string is already 
-** allocated with mark space and the function puts it at the end of the
-** table, checking overflow, and returns its own pointer, or NULL on error.
+** If the string isn't allocated, allocate a new string at string tree.
 */
 char *lua_createstring (char *s)
 {
  if (s == NULL) return NULL;
  
- if (lua_nstring >= MAXSTRING-1)
- {
+ if (lua_nentity == lua_block)
   lua_pack ();
-  if (lua_nstring >= MAXSTRING-1)
-  {
-   lua_error ("string table overflow");
-   return NULL;
-  }
- } 
- lua_string[lua_nstring++] = s;
- return s;
-}
-
-/*
-** Allocate a new array, already created, at array table. The function puts 
-** it at the end of the table, checking overflow, and returns its own pointer,
-** or NULL on error.
-*/
-void *lua_createarray (void *a)
-{
- if (a == NULL) return NULL;
- 
- if (lua_narray >= MAXARRAY-1)
- {
-  lua_pack ();
-  if (lua_narray >= MAXARRAY-1)
-  {
-   lua_error ("indexed table overflow");
-   return NULL;
-  }
- } 
- lua_array[lua_narray++] = a;
- return a;
+ lua_nentity++;
+ return lua_strcreate(s);
 }
 
 
@@ -294,6 +251,15 @@ int lua_addfile (char *fn)
  return 0;
 }
 
+/*
+** Delete a file from file stack
+*/
+int lua_delfile (void)
+{
+ lua_nfile--; 
+ return 1;
+}
+
 /*
 ** Return the last file name set.
 */
@@ -307,7 +273,7 @@ char *lua_filename (void)
 */
 void lua_nextvar (void)
 {
- int index;
+ char *varname, *next;
  Object *o = lua_getparam (1);
  if (o == NULL)
  { lua_error ("too few arguments to function `nextvar'"); return; }
@@ -315,7 +281,7 @@ void lua_nextvar (void)
  { lua_error ("too many arguments to function `nextvar'"); return; }
  if (tag(o) == T_NIL)
  {
-  index = 0;
+  varname = 0;
  }
  else if (tag(o) != T_STRING) 
  { 
@@ -324,28 +290,20 @@ void lua_nextvar (void)
  }
  else
  {
-  for (index=0; index<lua_ntable; index++)
-   if (streq(s_name(index),svalue(o))) break;
-  if (index == lua_ntable) 
-  {
-   lua_error ("name not found in function `nextvar'");
-   return;
-  }
-  index++;
-  while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
-  
-  if (index == lua_ntable-1)
-  {
-   lua_pushnil();
-   lua_pushnil();
-   return;
-  }
+  varname = svalue(o);
  }
+ next = lua_varnext(varname);
+ if (next == NULL)
+ {
+  lua_pushnil();
+  lua_pushnil();
+ }
+ else
  {
   Object name;
   tag(&name) = T_STRING;
-  svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
+  svalue(&name) = next;
   if (lua_pushobject (&name)) return;
-  if (lua_pushobject (&s_object(index))) return;
+  if (lua_pushobject (&s_object(indexstring(next)))) return;
  }
 }

table.h

@@ -1,39 +1,32 @@
 /*
-** table.c
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** 11 May 93
+** $Id: table.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
 */
 
 #ifndef table_h
 #define table_h
 
 extern Symbol *lua_table;
-extern Word    lua_ntable;
-
 extern char  **lua_constant;
-extern Word    lua_nconstant;
-
-extern char  **lua_string;
-extern Word    lua_nstring;
-
-extern Hash  **lua_array;
-extern Word    lua_narray;
 
 extern char   *lua_file[];
 extern int     lua_nfile;
 
-#define lua_markstring(s)	(*((s)-1))
+extern Word    lua_block;
+extern Word    lua_nentity;
 
 
-int   lua_findsymbol           (char *s);
-int   lua_findenclosedconstant (char *s);
-int   lua_findconstant         (char *s);
-void  lua_markobject           (Object *o);
-char *lua_createstring         (char *s);
-void *lua_createarray          (void *a);
-int   lua_addfile              (char *fn);
-char *lua_filename             (void);
-void  lua_nextvar              (void);
+void  lua_initconstant (void);
+int   lua_findsymbol      (char *s);
+int   lua_findconstant    (char *s);
+void  lua_travsymbol      (void (*fn)(Object *));
+void  lua_markobject      (Object *o);
+void  lua_pack            (void);
+char *lua_createstring    (char *s);
+int   lua_addfile         (char *fn);
+int   lua_delfile 	  (void);
+char *lua_filename        (void);
+void  lua_nextvar         (void);
 
 #endif

tree.c

@@ -0,0 +1,210 @@
+/*
+** tree.c
+** TecCGraf - PUC-Rio
+*/
+ 
+char *rcs_tree="$Id: $";
+
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "lua.h"
+#include "tree.h"
+
+
+#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b))) 
+
+
+typedef struct TreeNode
+{
+ struct TreeNode *right;
+ struct TreeNode *left;
+ Word            index;
+ char            str[1];        /* \0 byte already reserved */
+} TreeNode;
+
+static TreeNode *string_root = NULL;
+static TreeNode *constant_root = NULL;
+static TreeNode *variable_root = NULL;
+
+/*
+** Insert a new string/constant/variable at the tree. 
+*/
+static char *tree_create (TreeNode **node, char *str)
+{
+ if (*node == NULL)
+ {
+  *node = (TreeNode *) malloc (sizeof(TreeNode)+strlen(str));
+  if (*node == NULL)
+   lua_error ("memoria insuficiente\n");
+  (*node)->left = (*node)->right = NULL;
+  strcpy((*node)->str, str);
+  (*node)->index = UNMARKED_STRING;
+  return (*node)->str;
+ }
+ else
+ {
+  int c = lua_strcmp(str, (*node)->str);
+  if (c < 0) 
+   return tree_create(&(*node)->left, str);
+  else if (c > 0)
+   return tree_create(&(*node)->right, str);
+  else
+   return (*node)->str;
+ }
+}
+
+char *lua_strcreate (char *str) 
+{
+ return tree_create(&string_root, str);
+}
+
+char *lua_constcreate (char *str) 
+{
+ return tree_create(&constant_root, str);
+}
+
+char *lua_varcreate (char *str) 
+{
+ return tree_create(&variable_root, str);
+}
+
+
+
+/*
+** Free a node of the tree
+*/
+static TreeNode *lua_strfree (TreeNode *parent)
+{
+ if (parent->left == NULL && parent->right == NULL) /* no child */
+ {
+  free (parent);
+  return NULL;
+ }
+ else if (parent->left == NULL)         /* only right child */
+ {
+  TreeNode *p = parent->right;
+  free (parent);
+  return p;
+ }
+ else if (parent->right == NULL)        /* only left child */
+ {
+  TreeNode *p = parent->left;
+  free (parent);
+  return p;
+ }
+ else                                   /* two children */
+ {
+  TreeNode *p = parent, *r = parent->right;
+  while (r->left != NULL)
+  {
+   p = r;
+   r = r->left;
+  }
+  if (p == parent)
+  {
+   r->left  = parent->left;
+   parent->left = NULL;
+   parent->right = r->right;
+   r->right = lua_strfree(parent);
+  }
+  else
+  {
+   TreeNode *t = r->right;
+   r->left  = parent->left;
+   r->right = parent->right;
+   parent->left = NULL;
+   parent->right = t;
+   p->left  = lua_strfree(parent);
+  }
+  return r;
+ }
+}
+
+/*
+** Traverse tree for garbage collection
+*/
+static TreeNode *lua_travcollector (TreeNode *r)
+{
+ if (r == NULL) return NULL;
+ r->right = lua_travcollector(r->right);
+ r->left  = lua_travcollector(r->left);
+ if (r->index == UNMARKED_STRING) 
+  return lua_strfree(r);
+ else
+ {
+  r->index = UNMARKED_STRING;
+  return r;
+ }
+}
+
+
+/*
+** Garbage collection function.
+** This function traverse the tree freening unindexed strings
+*/
+void lua_strcollector (void)
+{
+ string_root = lua_travcollector(string_root);
+}
+
+/*
+** Return next variable.
+*/
+static TreeNode *tree_next (TreeNode *node, char *str)
+{
+#if 0
+ if (node == NULL) return NULL;
+ if (str == NULL || lua_strcmp(str, node->str) < 0)
+ {
+  TreeNode *result = tree_next(node->left, str);
+  return result == NULL ? node : result;
+ }
+ else
+ {
+  return tree_next(node->right, str);
+ }
+#else
+ if (node == NULL) return NULL;
+ else if (str == NULL) return node;
+ else
+ {
+  int c = lua_strcmp(str, node->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);
+ }
+#endif
+}
+
+char *lua_varnext (char *n)
+{
+ TreeNode *result = tree_next(variable_root, n);
+ return result != NULL ? result->str : NULL;
+}
+
+
+/*
+** Given an id, find the string with exaustive search
+*/
+static char *tree_name (TreeNode *node, Word index)
+{
+ if (node == NULL) return NULL;
+ if (node->index == index) return node->str;
+ else
+ {
+  char *result = tree_name(node->left, index);
+  return result != NULL ? result : tree_name(node->right, index);
+ }
+}
+char *lua_varname (Word index)
+{
+ return tree_name(variable_root, index);
+}

tree.h

@@ -0,0 +1,27 @@
+/*
+** tree.h
+** TecCGraf - PUC-Rio
+** $Id: $
+*/
+
+#ifndef tree_h
+#define tree_h
+
+#include "opcode.h"
+
+
+#define UNMARKED_STRING	0xFFFF
+#define MARKED_STRING   0xFFFE
+#define MAX_WORD        0xFFFD
+
+#define indexstring(s) (*(((Word *)s)-1))
+
+
+char *lua_strcreate    (char *str);
+char *lua_constcreate  (char *str);
+char *lua_varcreate    (char *str);
+void  lua_strcollector (void);
+char *lua_varnext      (char *n);
+char *lua_varname      (Word index);
+
+#endif

y_tab.h

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