included string.h

a null lua_Object is LUA_NOOBJECT, not NULL.

Makefile

@@ -1,29 +0,0 @@
-OBJS= hash.o inout.o lex_yy.o opcode.o table.o y_tab.o lua.o iolib.o mathlib.o strlib.o
-
-CFLAGS= -O2 -I.
-
-T= lua
-
-all:	$T
-
-$T:	$(OBJS)
-	$(CC) -o $@ $(OBJS) -lm
-
-A=--------------------------------------------------------------------------
-test:	$T
-	@echo "$A"
-	./$T sort.lua main
-	@echo "$A"
-	./$T globals.lua | sort | column
-	@echo "$A"
-	./$T array.lua
-	@echo "$A"
-	./$T save.lua
-	@echo "$A"
-	./$T test.lua retorno_multiplo norma
-
-clean:
-	rm -f $T $(OBJS) core core.*
-
-diff:
-	diff . fixed | grep -v ^Only

README

@@ -1,22 +0,0 @@
-This is Lua 1.0. It was never publicly released. This code is a snapshot of
-the status of Lua on 28 Jul 1993. It is distributed for historical curiosity
-to celebrate 10 years of Lua and is hereby placed in the public domain.
-
-There is no documentation, except the test programs. The manual for Lua 1.1
-probably works for this version as well.
-
-The source files for the lexer and parser have been lost: all that is left is
-the output of lex and yacc. A grammar can be found inside y_tab.c in yyreds.
-
-The code compiles and runs in RedHat 5.2 with gcc 2.7.2.3. It may not run in
-newer systems, because it assumes that stdin and stdout are constants, though
-ANSI C does not promise they are. If make fails, try using the fixed modules
-provided in the "fixed" directory. To see the differences (which are really
-quite minor), do "make diff".
-
-To see Lua 1.0 in action, do "make test". (The last test raises an error on
-purpose.)
-
-Enjoy!
-
--- The Lua team, lua@tecgraf.puc-rio.br

array.lua

@@ -1,15 +0,0 @@
-$debug
-
-a = @()
-
-i=0
-while i<10 do
- a[i] = i*i
- i=i+1
-end
-
-r,v = next(a,nil)
-while r ~= nil do
- print ("array["..r.."] = "..v)
- r,v = next(a,r)
-end 

fallback.c

@@ -0,0 +1,171 @@
+/*
+** fallback.c
+** TecCGraf - PUC-Rio
+*/
+ 
+char *rcs_fallback="$Id: fallback.c,v 1.10 1994/12/20 21:20:36 roberto Exp $";
+
+#include <stdio.h>
+#include <string.h>
+ 
+#include "mem.h"
+#include "fallback.h"
+#include "opcode.h"
+#include "inout.h"
+#include "lua.h"
+
+
+static void errorFB (void);
+static void indexFB (void);
+static void gettableFB (void);
+static void arithFB (void);
+static void concatFB (void);
+static void orderFB (void);
+static void GDFB (void);
+static void funcFB (void);
+
+
+/*
+** Warning: This list must be in the same order as the #define's
+*/
+struct FB  luaI_fallBacks[] = {
+{"error", {LUA_T_CFUNCTION, errorFB}},
+{"index", {LUA_T_CFUNCTION, indexFB}},
+{"gettable", {LUA_T_CFUNCTION, gettableFB}},
+{"arith", {LUA_T_CFUNCTION, arithFB}},
+{"order", {LUA_T_CFUNCTION, orderFB}},
+{"concat", {LUA_T_CFUNCTION, concatFB}},
+{"settable", {LUA_T_CFUNCTION, gettableFB}},
+{"gc", {LUA_T_CFUNCTION, GDFB}},
+{"function", {LUA_T_CFUNCTION, funcFB}}
+};
+
+#define N_FB  (sizeof(luaI_fallBacks)/sizeof(struct FB))
+
+void luaI_setfallback (void)
+{
+  int i;
+  char *name = lua_getstring(lua_getparam(1));
+  lua_Object func = lua_getparam(2);
+  if (name == NULL || !(lua_isfunction(func) || lua_iscfunction(func)))
+  {
+    lua_pushnil();
+    return;
+  }
+  for (i=0; i<N_FB; i++)
+  {
+    if (strcmp(luaI_fallBacks[i].kind, name) == 0)
+    {
+      luaI_pushobject(&luaI_fallBacks[i].function);
+      luaI_fallBacks[i].function = *luaI_Address(func);
+      return;
+    }
+  }
+  /* name not found */
+  lua_pushnil();
+}
+
+
+static void errorFB (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isstring(o))
+    fprintf (stderr, "lua: %s\n", lua_getstring(o));
+  else
+    fprintf(stderr, "lua: unknown error\n");
+}
+ 
+
+static void indexFB (void)
+{
+  lua_pushnil();
+}
+ 
+
+static void gettableFB (void)
+{
+  lua_reportbug("indexed expression not a table");
+}
+ 
+
+static void arithFB (void)
+{
+  lua_reportbug("unexpected type at conversion to number");
+}
+
+static void concatFB (void)
+{
+  lua_reportbug("unexpected type at conversion to string");
+}
+
+
+static void orderFB (void)
+{
+  lua_reportbug("unexpected type at comparison");
+}
+
+static void GDFB (void) { }
+
+static void funcFB (void)
+{
+  lua_reportbug("call expression not a function");
+}
+
+
+/*
+** Lock routines
+*/
+
+static Object *lockArray = NULL;
+static Word lockSize = 0;
+
+int luaI_lock (Object *object)
+{
+  Word i;
+  Word oldSize;
+  if (tag(object) == LUA_T_NIL)
+    return -1;
+  for (i=0; i<lockSize; i++)
+    if (tag(&lockArray[i]) == LUA_T_NIL)
+    {
+      lockArray[i] = *object;
+      return i;
+    }
+  /* no more empty spaces */
+  oldSize = lockSize;
+  if (lockArray == NULL)
+  {
+    lockSize = 10;
+    lockArray = newvector(lockSize, Object);
+  }
+  else
+  {
+    lockSize = 3*oldSize/2 + 5;
+    lockArray = growvector(lockArray, lockSize, Object);
+  }
+  for (i=oldSize; i<lockSize; i++)
+    tag(&lockArray[i]) = LUA_T_NIL;
+  lockArray[oldSize] = *object;
+  return oldSize;
+}
+
+
+void lua_unlock (int ref)
+{
+  tag(&lockArray[ref]) = LUA_T_NIL;
+}
+
+
+Object *luaI_getlocked (int ref)
+{
+  return &lockArray[ref];
+}
+
+
+void luaI_travlock (void (*fn)(Object *))
+{
+  Word i;
+  for (i=0; i<lockSize; i++)
+    fn(&lockArray[i]);
+}
+

fallback.h

@@ -0,0 +1,31 @@
+/*
+** $Id: fallback.h,v 1.6 1994/11/21 13:30:15 roberto Exp roberto $
+*/
+ 
+#ifndef fallback_h
+#define fallback_h
+
+#include "opcode.h"
+
+extern struct FB {
+  char *kind;
+  Object function;
+} luaI_fallBacks[];
+
+#define FB_ERROR  0
+#define FB_INDEX  1
+#define FB_GETTABLE  2
+#define FB_ARITH  3
+#define FB_ORDER  4
+#define FB_CONCAT  5
+#define FB_SETTABLE  6
+#define FB_GC 7
+#define FB_FUNCTION 8
+
+void luaI_setfallback (void);
+int luaI_lock (Object *object);
+Object *luaI_getlocked (int ref);
+void luaI_travlock (void (*fn)(Object *));
+
+#endif
+

fixed/iolib.c

@@ -1,402 +0,0 @@
-/*
-** iolib.c
-** Input/output library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
-*/
-
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <ctype.h>
-#ifdef __GNUC__
-#include <floatingpoint.h>
-#endif
-
-#include "lua.h"
-
-static FILE *in=NULL, *out=NULL;
-
-/*
-** Open a file to read.
-** LUA interface:
-**			status = readfrom (filename)
-** where:
-**			status = 1 -> success
-**			status = 0 -> error
-*/
-static void io_readfrom (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == NULL)			/* restore standart input */
- {
-  if (in != stdin)
-  {
-   fclose (in);
-   in = stdin;
-  }
-  lua_pushnumber (1);
- }
- else
- {
-  if (!lua_isstring (o))
-  {
-   lua_error ("incorrect argument to function 'readfrom`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"r");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (in != stdin) fclose (in);
-    in = fp;
-    lua_pushnumber (1);
-   }
-  }
- }
-}
-
-
-/*
-** Open a file to write.
-** LUA interface:
-**			status = writeto (filename)
-** where:
-**			status = 1 -> success
-**			status = 0 -> error
-*/
-static void io_writeto (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == 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 'writeto`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"w");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (1);
-   }
-  }
- }
-}
-
-
-/*
-** Read a variable. On error put nil on stack.
-** LUA interface:
-**			variable = read ([format])
-**
-** O formato pode ter um dos seguintes especificadores:
-**
-**	s ou S -> para string
-**	f ou F, g ou G, e ou E -> para reais
-**	i ou I -> para inteiros
-**
-**	Estes especificadores podem vir seguidos de numero que representa
-**	o numero de campos a serem lidos.
-*/
-static void io_read (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == NULL)			/* free format */
- {
-  int c;
-  char s[256];
-  while (isspace(c=fgetc(in)))
-   ;
-  if (c == '\"')
-  {
-   if (fscanf (in, "%[^\"]\"", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-  }
-  else if (c == '\'')
-  {
-   if (fscanf (in, "%[^\']\'", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-  }
-  else
-  {
-   char *ptr;
-   double d;
-   ungetc (c, in);
-   if (fscanf (in, "%s", s) != 1)
-   {
-    lua_pushnil ();
-    return;
-   }
-   d = strtod (s, &ptr);
-   if (!(*ptr))
-   {
-    lua_pushnumber (d);
-    return;
-   }
-  }
-  lua_pushstring (s);
-  return;
- }
- else				/* formatted */
- {
-  char *e = lua_getstring(o);
-  char t;
-  int  m=0;
-  while (isspace(*e)) e++;
-  t = *e++;
-  while (isdigit(*e))
-   m = m*10 + (*e++ - '0');
-  
-  if (m > 0)
-  {
-   char f[80];
-   char s[256];
-   sprintf (f, "%%%ds", m);
-   fscanf (in, f, s);
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     long int l;
-     sscanf (s, "%ld", &l);
-     lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float f;
-     sscanf (s, "%f", &f);
-     lua_pushnumber(f);
-    }
-    break;
-    default: 
-     lua_pushstring(s); 
-    break;
-   }
-  }
-  else
-  {
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     long int l;
-     fscanf (in, "%ld", &l);
-     lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float f;
-     fscanf (in, "%f", &f);
-     lua_pushnumber(f);
-    }
-    break;
-    default: 
-    {
-     char s[256];
-     fscanf (in, "%s", s);
-     lua_pushstring(s);
-    }
-    break;
-   }
-  }
- }
-}
-
-
-/*
-** Write a variable. On error put 0 on stack, otherwise put 1.
-** LUA interface:
-**			status = write (variable [,format])
-**
-** O formato pode ter um dos seguintes especificadores:
-**
-**	s ou S -> para string
-**	f ou F, g ou G, e ou E -> para reais
-**	i ou I -> para inteiros
-**
-**	Estes especificadores podem vir seguidos de:
-**
-**		[?][m][.n]
-**
-**	onde:
-**		? -> indica justificacao
-**			< = esquerda
-**			| = centro
-**			> = direita (default)
-**		m -> numero maximo de campos (se exceder estoura)
-**		n -> indica precisao para
-**			reais -> numero de casas decimais
-**			inteiros -> numero minimo de digitos
-**			string -> nao se aplica
-*/
-static char *buildformat (char *e, lua_Object o)
-{
- static char buffer[512];
- static char f[80];
- char *string = &buffer[255];
- char t, j='r';
- int  m=0, n=0, l;
- while (isspace(*e)) e++;
- t = *e++;
- if (*e == '<' || *e == '|' || *e == '>') j = *e++;
- while (isdigit(*e))
-  m = m*10 + (*e++ - '0');
- e++;	/* skip point */
- while (isdigit(*e))
-  n = n*10 + (*e++ - '0');
-
- sprintf(f,"%%");
- if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
- if (m != 0)   sprintf(strchr(f,0),"%d", m);
- if (n != 0)   sprintf(strchr(f,0),".%d", n);
- sprintf(strchr(f,0), "%c", t);
- switch (tolower(t))
- {
-  case 'i': t = 'i';
-   sprintf (string, f, (long int)lua_getnumber(o));
-  break;
-  case 'f': case 'g': case 'e': t = 'f';
-   sprintf (string, f, (float)lua_getnumber(o));
-  break;
-  case 's': t = 's';
-   sprintf (string, f, lua_getstring(o));
-  break;
-  default: return "";
- }
- l = strlen(string);
- if (m!=0 && l>m)
- {
-  int i;
-  for (i=0; i<m; i++)
-   string[i] = '*';
-  string[i] = 0;
- }
- else if (m!=0 && j=='|')
- {
-  int i=l-1;
-  while (isspace(string[i])) i--;
-  string -= (m-i) / 2;
-  i=0;
-  while (string[i]==0) string[i++] = ' ';
-  string[l] = 0;
- }
- return string;
-}
-static void io_write (void)
-{
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- if (o1 == NULL)			/* new line */
- {
-  fprintf (out, "\n");
-  lua_pushnumber(1);
- }
- else if (o2 == NULL)   		/* free format */
- {
-  int status=0;
-  if (lua_isnumber(o1))
-   status = fprintf (out, "%g", lua_getnumber(o1));
-  else if (lua_isstring(o1))
-   status = fprintf (out, "%s", lua_getstring(o1));
-  lua_pushnumber(status);
- }
- else					/* formated */
- {
-  if (!lua_isstring(o2))
-  { 
-   lua_error ("incorrect format to function `write'"); 
-   lua_pushnumber(0);
-   return;
-  }
-  lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
- }
-}
-
-/*
-** Execute a executable program using "sustem".
-** On error put 0 on stack, otherwise put 1.
-*/
-void io_execute (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == NULL || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  system(lua_getstring(o));
-  lua_pushnumber (1);
- }
- return;
-}
-
-/*
-** Remove a file.
-** On error put 0 on stack, otherwise put 1.
-*/
-void io_remove  (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == NULL || !lua_isstring (o))
- {
-  lua_error ("incorrect argument to function 'execute`");
-  lua_pushnumber (0);
- }
- else
- {
-  if (remove(lua_getstring(o)) == 0)
-   lua_pushnumber (1);
-  else
-   lua_pushnumber (0);
- }
- return;
-}
-
-/*
-** Open io library
-*/
-void iolib_open (void)
-{
- in=stdin; out=stdout;
- lua_register ("readfrom", io_readfrom);
- lua_register ("writeto",  io_writeto);
- lua_register ("read",     io_read);
- lua_register ("write",    io_write);
- lua_register ("execute",  io_execute);
- lua_register ("remove",   io_remove);
-}

fixed/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 = {NULL}, *yyout = {NULL};
-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);
-	}

fixed/lua.c

@@ -1,55 +0,0 @@
-/*
-** lua.c
-** Linguagem para Usuarios de Aplicacao
-** TeCGraf - PUC-Rio
-** 28 Apr 93
-*/
-
-#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));
-}
-
-int main (int argc, char *argv[])
-{
- int i;
- if (argc < 2)
- {
-  puts ("usage: lua filename [functionnames]");
-  return;
- }
- lua_register ("callfunc", callfunc);
- lua_register ("execstr", execstr);
- lua_register ("test", test);
- iolib_open ();
- strlib_open ();
- mathlib_open ();
- lua_dofile (argv[1]);
- for (i=2; i<argc; i++)
- {
-  lua_call (argv[i],0);
- }
- return 0;
-}
-
-

floatingpoint.h

@@ -1 +0,0 @@
-/* empty file to please silly code in iolib.c and opcode.c */

globals.lua

@@ -1,5 +0,0 @@
-k,v=nextvar(k)
-while k do
- print(k)
- k,v=nextvar(k)
-end

hash.c

@@ -1,172 +1,289 @@
 /*
 ** hash.c
 ** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
-** Modified by Waldemar Celes Filho
-** 12 May 93
 */
 
-#include <string.h>
-#include <stdlib.h>
+char *rcs_hash="$Id: hash.c,v 2.23 1995/01/12 14:19:04 roberto Exp $";
 
+#include <string.h>
+
+#include "mem.h"
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
 #include "lua.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==0)
-#define strneq(s1,s2)	(strcmp(s1,s2)!=0)
-
-#define new(s)		((s *)malloc(sizeof(s)))
-#define newvector(n,s)	((s *)calloc(n,sizeof(s)))
+#define streq(s1,s2)	(s1 == s2 || (*(s1) == *(s2) && strcmp(s1,s2)==0))
 
 #define nhash(t)	((t)->nhash)
-#define nodelist(t)	((t)->list)
-#define list(t,i)	((t)->list[i])
-#define ref_tag(n)	(tag(&(n)->ref))
-#define ref_nvalue(n)	(nvalue(&(n)->ref))
-#define ref_svalue(n)	(svalue(&(n)->ref))
+#define nuse(t)		((t)->nuse)
+#define markarray(t)    ((t)->mark)
+#define nodevector(t)	((t)->node)
+#define node(t,i)	(&(t)->node[i])
+#define ref(n)		(&(n)->ref)
+#define val(n)		(&(n)->val)
 
-static int head (Hash *t, Object *ref)		/* hash function */
+
+#define REHASH_LIMIT	0.70	/* avoid more than this % full */
+
+
+static Hash *listhead = NULL;
+
+
+
+/* hash dimensions values */
+static Word dimensions[] = 
+ {3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
+  12853, 25717, 51437, 65521, 0};  /* 65521 == last prime < MAX_WORD */
+
+static Word redimension (Word nhash)
 {
- if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
- else if (tag(ref) == T_STRING)
+ Word i;
+ for (i=0; dimensions[i]!=0; i++)
  {
-  int h;
-  char *name = svalue(ref);
-  for (h=0; *name!=0; name++)		/* interpret name as binary number */
+  if (dimensions[i] > nhash)
+   return dimensions[i];
+ }
+ lua_error("table overflow");
+ return 0;  /* to avoid warnings */
+}
+
+static Word hashindex (Hash *t, Object *ref)		/* hash function */
+{
+ switch (tag(ref))
+ {
+  case LUA_T_NIL:
+   lua_reportbug ("unexpected type to index table");
+   return -1;  /* UNREACHEABLE */
+  case LUA_T_NUMBER:
+   return (((Word)nvalue(ref))%nhash(t));
+  case LUA_T_STRING:
   {
-   h <<= 8;
-   h  += (unsigned char) *name;		/* avoid sign extension */
-   h  %= nhash(t);			/* make it a valid index */
+   unsigned long h = tsvalue(ref)->hash;
+   if (h == 0)
+   {
+     char *name = svalue(ref);
+     while (*name)
+       h = ((h<<5)-h)^(unsigned char)*(name++);
+     tsvalue(ref)->hash = h;
+   }
+   return (Word)h%nhash(t);  /* make it a valid index */
   }
-  return h;
- }
- else
- {
-  lua_reportbug ("unexpected type to index table");
-  return -1;
+  case LUA_T_FUNCTION:
+   return (((IntPoint)bvalue(ref))%nhash(t));
+  case LUA_T_CFUNCTION:
+   return (((IntPoint)fvalue(ref))%nhash(t));
+  case LUA_T_ARRAY:
+   return (((IntPoint)avalue(ref))%nhash(t));
+  default:  /* user data */
+   return (((IntPoint)uvalue(ref))%nhash(t));
  }
 }
 
-static Node *present(Hash *t, Object *ref, int h)
+Bool lua_equalObj (Object *t1, Object *t2)
 {
- Node *n=NULL, *p;
- if (tag(ref) == T_NUMBER)
- {
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
-   if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
- }  
- else if (tag(ref) == T_STRING)
- {
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
-   if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
- }  
- if (n==NULL)				/* name not present */
-  return NULL;
-#if 0
- if (p!=NULL)				/* name present but not first */
- {
-  p->next=n->next;			/* move-to-front self-organization */
-  n->next=list(t,h);
-  list(t,h)=n;
- }
-#endif
- return n;
+  if (tag(t1) != tag(t2)) return 0;
+  switch (tag(t1))
+  {
+    case LUA_T_NIL: return 1;
+    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
+    case LUA_T_STRING: return streq(svalue(t1), svalue(t2));
+    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
+    case LUA_T_FUNCTION: return bvalue(t1) == bvalue(t2);
+    case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
+    default: return uvalue(t1) == uvalue(t2);
+  }
 }
 
-static void freelist (Node *n)
-{
- while (n)
+static Word present (Hash *t, Object *ref)
+{ 
+ Word h = hashindex(t, ref);
+ while (tag(ref(node(t, h))) != LUA_T_NIL)
  {
-  Node *next = n->next;
-  free (n);
-  n = next;
+  if (lua_equalObj(ref, ref(node(t, h))))
+    return h;
+  h = (h+1) % nhash(t);
  }
+ return h;
+}
+
+
+/*
+** Alloc a vector node 
+*/
+static Node *hashnodecreate (Word nhash)
+{
+ Word i;
+ Node *v = newvector (nhash, Node);
+ for (i=0; i<nhash; i++)
+   tag(ref(&v[i])) = LUA_T_NIL;
+ return v;
 }
 
 /*
 ** Create a new hash. Return the hash pointer or NULL on error.
 */
-Hash *lua_hashcreate (unsigned int nhash)
+static Hash *hashcreate (Word nhash)
 {
- Hash *t = new (Hash);
- if (t == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
+ Hash *t = new(Hash);
+ nhash = redimension((Word)((float)nhash/REHASH_LIMIT));
+ nodevector(t) = hashnodecreate(nhash);
  nhash(t) = nhash;
+ nuse(t) = 0;
  markarray(t) = 0;
- nodelist(t) = newvector (nhash, Node*);
- if (nodelist(t) == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
  return t;
 }
 
 /*
 ** Delete a hash
 */
-void lua_hashdelete (Hash *h)
+static void hashdelete (Hash *t)
 {
- int i;
- for (i=0; i<nhash(h); i++)
-  freelist (list(h,i));
- free (nodelist(h));
- free(h);
+ luaI_free (nodevector(t));
+ luaI_free(t);
 }
 
-/*
-** If the hash node is present, return its pointer, otherwise create a new
-** node for the given reference and also return its pointer.
-** On error, return NULL.
-*/
-Object *lua_hashdefine (Hash *t, Object *ref)
-{
- int   h;
- Node *n;
- h = head (t, ref);
- if (h < 0) return NULL; 
- 
- n = present(t, ref, h);
- if (n == NULL)
- {
-  n = new(Node);
-  if (n == NULL)
-  {
-   lua_error ("not enough memory");
-   return NULL;
-  }
-  n->ref = *ref;
-  tag(&n->val) = T_NIL;
-  n->next = list(t,h);			/* link node to head of list */
-  list(t,h) = n;
- }
- return (&n->val);
-}
 
 /*
 ** Mark a hash and check its elements 
 */
 void lua_hashmark (Hash *h)
 {
- int i;
- 
- markarray(h) = 1;
- 
- for (i=0; i<nhash(h); i++)
+ if (markarray(h) == 0)
  {
-  Node *n;
-  for (n = list(h,i); n != NULL; n = n->next)
+  Word i;
+  markarray(h) = 1;
+  for (i=0; i<nhash(h); i++)
   {
-   lua_markobject (&n->ref);
-   lua_markobject (&n->val);
+   Node *n = node(h,i);
+   if (tag(ref(n)) != LUA_T_NIL)
+   {
+    lua_markobject(&n->ref);
+    lua_markobject(&n->val);
+   }
   }
+ } 
+}
+
+
+static void call_fallbacks (void)
+{
+  Hash *curr_array;
+  Object t;
+  tag(&t) = LUA_T_ARRAY;
+  for (curr_array = listhead; curr_array; curr_array = curr_array->next)
+    if (markarray(curr_array) != 1)
+    {
+      avalue(&t) = curr_array;
+      luaI_gcFB(&t);
+    }
+  tag(&t) = LUA_T_NIL;
+  luaI_gcFB(&t);  /* end of list */
+}
+
+ 
+/*
+** Garbage collection to arrays
+** Delete all unmarked arrays.
+*/
+Long lua_hashcollector (void)
+{
+ Hash *curr_array = listhead, *prev = NULL;
+ Long counter = 0;
+ call_fallbacks();
+ while (curr_array != NULL)
+ {
+  Hash *next = curr_array->next;
+  if (markarray(curr_array) != 1)
+  {
+   if (prev == NULL) listhead = next;
+   else              prev->next = next;
+   hashdelete(curr_array);
+   ++counter;
+  }
+  else
+  {
+   markarray(curr_array) = 0;
+   prev = curr_array;
+  }
+  curr_array = next;
  }
+ return counter;
+}
+
+
+/*
+** Create a new array
+** This function inserts the new array in the array list. It also
+** executes garbage collection if the number of arrays created
+** exceed a pre-defined range.
+*/
+Hash *lua_createarray (Word nhash)
+{
+ Hash *array;
+ lua_pack();
+ array = hashcreate(nhash);
+ array->next = listhead;
+ listhead = array;
+ return array;
+}
+
+
+/*
+** Re-hash
+*/
+static void rehash (Hash *t)
+{
+ Word i;
+ Word   nold = nhash(t);
+ Node *vold = nodevector(t);
+ nhash(t) = redimension(nhash(t));
+ nodevector(t) = hashnodecreate(nhash(t));
+ for (i=0; i<nold; i++)
+ {
+  Node *n = vold+i;
+  if (tag(ref(n)) != LUA_T_NIL && tag(val(n)) != LUA_T_NIL)
+   *node(t, present(t, ref(n))) = *n;  /* copy old node to new hahs */
+ }
+ luaI_free(vold);
+}
+
+/*
+** If the hash node is present, return its pointer, otherwise return
+** null.
+*/
+Object *lua_hashget (Hash *t, Object *ref)
+{
+ Word h = present(t, ref);
+ if (tag(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ else return NULL;
+}
+
+
+/*
+** If the hash node is present, return its pointer, otherwise create a new
+** node for the given reference and also return its pointer.
+*/
+Object *lua_hashdefine (Hash *t, Object *ref)
+{
+ Word   h;
+ Node *n;
+ h = present(t, ref);
+ n = node(t, h);
+ if (tag(ref(n)) == LUA_T_NIL)
+ {
+  nuse(t)++;
+  if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT)
+  {
+   rehash(t);
+   h = present(t, ref);
+   n = node(t, h);
+  }
+  *ref(n) = *ref;
+  tag(val(n)) = LUA_T_NIL;
+ }
+ return (val(n));
 }
 
 
@@ -176,84 +293,44 @@ 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)
+static void hashnext (Hash *t, Word i)
 {
- if (h < nhash(a))
- {  
-  int i;
-  for (i=h; i<nhash(a); i++)
+ if (i >= nhash(t))
+ {
+  lua_pushnil(); lua_pushnil();
+  return;
+ }
+ while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
+ {
+  if (++i >= nhash(t))
   {
-   if (list(a,i) != NULL && tag(&list(a,i)->val) != T_NIL)
-   {
-    lua_pushobject (&list(a,i)->ref);
-    lua_pushobject (&list(a,i)->val);
-    return;
-   }
+   lua_pushnil(); lua_pushnil();
+   return;
   }
  }
- lua_pushnil();
- lua_pushnil();
+ luaI_pushobject(ref(node(t,i)));
+ luaI_pushobject(val(node(t,i)));
 }
+
 void lua_next (void)
 {
- Hash   *a;
- Object *o = lua_getparam (1);
- Object *r = lua_getparam (2);
- if (o == NULL || r == NULL)
- { lua_error ("too few arguments to function `next'"); return; }
- if (lua_getparam (3) != NULL)
- { lua_error ("too many arguments to function `next'"); return; }
- if (tag(o) != T_ARRAY)
- { lua_error ("first argument of function `next' is not a table"); return; }
- a = avalue(o);
- if (tag(r) == T_NIL)
+ Hash   *t;
+ lua_Object o = lua_getparam(1);
+ lua_Object r = lua_getparam(2);
+ if (o == LUA_NOOBJECT || r == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `next'");
+ if (lua_getparam(3) != LUA_NOOBJECT)
+   lua_error ("too many arguments to function `next'");
+ if (!lua_istable(o))
+   lua_error ("first argument of function `next' is not a table");
+ t = avalue(luaI_Address(o));
+ if (lua_isnil(r))
  {
-  firstnode (a, 0);
-  return;
+  hashnext(t, 0);
  }
  else
  {
-  int h = head (a, r);
-  if (h >= 0)
-  {
-   Node *n = list(a,h);
-   while (n)
-   {
-    if (memcmp(&n->ref,r,sizeof(Object)) == 0)
-    {
-     if (n->next == NULL)
-     {
-      firstnode (a, h+1);
-      return;
-     }
-     else if (tag(&n->next->val) != T_NIL)
-     {
-      lua_pushobject (&n->next->ref);
-      lua_pushobject (&n->next->val);
-      return;
-     }
-     else
-     {
-      Node *next = n->next->next;
-      while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
-      if (next == NULL)
-      {
-       firstnode (a, h+1);
-       return;
-      }
-      else
-      {
-       lua_pushobject (&next->ref);
-       lua_pushobject (&next->val);
-      }
-      return;
-     }
-    }
-    n = n->next;
-   }
-   if (n == NULL)
-    lua_error ("error in function 'next': reference not found");
-  }
+  Word h = present (t, luaI_Address(r));
+  hashnext(t, h+1);
  }
 }

hash.h

@@ -2,34 +2,36 @@
 ** 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 2.7 1994/12/20 21:20:36 roberto Exp roberto $
 */
 
 #ifndef hash_h
 #define hash_h
 
+#include "types.h"
+
 typedef struct node
 {
  Object ref;
  Object val;
- struct node *next;
 } Node;
 
 typedef struct Hash
 {
+ struct Hash   *next;
  char           mark;
- unsigned int   nhash;
- Node         **list;
+ Word          nhash;
+ Word           nuse;
+ Node          *node;
 } Hash;
 
-#define markarray(t)		((t)->mark)
 
-Hash 	*lua_hashcreate (unsigned int nhash);
-void 	 lua_hashdelete (Hash *h);
+Bool     lua_equalObj (Object *t1, Object *t2);
+Hash    *lua_createarray (Word nhash);
+void     lua_hashmark (Hash *h);
+Long     lua_hashcollector (void);
+Object  *lua_hashget (Hash *t, Object *ref);
 Object 	*lua_hashdefine (Hash *t, Object *ref);
-void 	 lua_hashmark   (Hash *h);
-
 void     lua_next (void);
 
 #endif

inout.c

@@ -2,59 +2,54 @@
 ** inout.c
 ** Provide function to realise the input/output function and debugger 
 ** facilities.
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
+** Also provides some predefined lua functions.
 */
 
+char *rcs_inout="$Id: inout.c,v 2.15 1994/12/16 15:55:04 roberto Exp roberto $";
+
 #include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
+#include "mem.h"
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
+#include "tree.h"
+#include "lua.h"
 
 /* Exported variables */
-int lua_linenumber;
-int lua_debug;
-int lua_debugline;
+Word lua_linenumber;
+Bool lua_debug;
+Word lua_debugline = 0;
+
 
 /* Internal variables */
+ 
 #ifndef MAXFUNCSTACK
-#define MAXFUNCSTACK 32
+#define MAXFUNCSTACK 100
 #endif
-static struct { int file; int function; } funcstack[MAXFUNCSTACK];
-static int nfuncstack=0;
+ 
+typedef struct FuncStackNode {
+  struct FuncStackNode *next;
+  char *file;
+  Word function;
+  Word line;
+} FuncStackNode;
+ 
+static FuncStackNode *funcStack = NULL;
+static Word nfuncstack=0;
 
 static FILE *fp;
 static char *st;
-static void (*usererror) (char *s);
-
-/*
-** Function to set user function to handle errors.
-*/
-void lua_errorfunction (void (*fn) (char *s))
-{
- usererror = fn;
-}
 
 /*
 ** Function to get the next character from the input file
 */
 static int fileinput (void)
 {
- int c = fgetc (fp);
- return (c == EOF ? 0 : c);
-}
-
-/*
-** Function to unget the next character from to input file
-*/
-static void fileunput (int c)
-{
- ungetc (c, fp);
+ return fgetc (fp);
 }
 
 /*
@@ -62,31 +57,25 @@ static void fileunput (int c)
 */
 static int stringinput (void)
 {
- st++;
- return (*(st-1));
-}
-
-/*
-** Function to unget the next character from to input string
-*/
-static void stringunput (int c)
-{
- st--;
+ return *st++;
 }
 
 /*
 ** Function to open a file to be input unit. 
-** Return 0 on success or 1 on error.
+** Return 0 on success or error message on error.
 */
-int lua_openfile (char *fn)
+char *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;
- return 0;
+ if (fp == NULL)
+ {
+   static char buff[32];
+   sprintf(buff, "unable to open file %.10s", fn);
+   return buff;
+ }
+ return lua_addfile (fn);
 }
 
 /*
@@ -96,6 +85,7 @@ void lua_closefile (void)
 {
  if (fp != NULL)
  {
+  lua_delfile();
   fclose (fp);
   fp = NULL;
  }
@@ -104,54 +94,58 @@ void lua_closefile (void)
 /*
 ** Function to open a string to be input unit
 */
-int lua_openstring (char *s)
+char *lua_openstring (char *s)
 {
  lua_linenumber = 1;
  lua_setinput (stringinput);
- lua_setunput (stringunput);
  st = s;
  {
   char sn[64];
   sprintf (sn, "String: %10.10s...", s);
-  if (lua_addfile (sn)) return 1;
+  return lua_addfile (sn);
  }
- return 0;
 }
 
 /*
-** Call user function to handle error messages, if registred. Or report error
-** using standard function (fprintf).
+** Function to close an opened string
 */
-void lua_error (char *s)
+void lua_closestring (void)
 {
- if (usererror != NULL) usererror (s);
- else			    fprintf (stderr, "lua: %s\n", s);
+ lua_delfile();
 }
 
+
 /*
 ** Called to execute  SETFUNCTION opcode, this function pushs a function into
-** function stack. Return 0 on success or 1 on error.
+** function stack.
 */
-int lua_pushfunction (int file, int function)
+void lua_pushfunction (char *file, Word function)
 {
- if (nfuncstack >= MAXFUNCSTACK-1)
+ FuncStackNode *newNode;
+ if (nfuncstack++ >= MAXFUNCSTACK)
  {
-  lua_error ("function stack overflow");
-  return 1;
+  lua_reportbug("function stack overflow");
  }
- funcstack[nfuncstack].file = file;
- funcstack[nfuncstack].function = function;
- nfuncstack++;
- return 0;
+ newNode = new(FuncStackNode);
+ newNode->function = function;
+ newNode->file = file;
+ newNode->line= lua_debugline;
+ newNode->next = funcStack;
+ funcStack = newNode;
 }
 
 /*
-** Called to execute  RESET opcode, this function pops a function from 
+** Called to execute RESET opcode, this function pops a function from 
 ** function stack.
 */
 void lua_popfunction (void)
 {
- nfuncstack--;
+ FuncStackNode *temp = funcStack;
+ if (temp == NULL) return;
+ --nfuncstack;
+ lua_debugline = temp->line;
+ funcStack = temp->next;
+ luaI_free(temp);
 }
 
 /*
@@ -159,30 +153,142 @@ void lua_popfunction (void)
 */
 void lua_reportbug (char *s)
 {
- char msg[1024];
+ char msg[MAXFUNCSTACK*80];
  strcpy (msg, s);
  if (lua_debugline != 0)
  {
-  int i;
-  if (nfuncstack > 0)
+  if (funcStack)
   {
-   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_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_file[funcstack[i].file]);
+   FuncStackNode *func = funcStack;
+   int line = lua_debugline;
+   sprintf (strchr(msg,0), "\n\tactive stack:\n");
+   do
+   {
+     sprintf (strchr(msg,0),
+       "\t-> function \"%s\" at file \"%s\":%u\n", 
+              lua_constant[func->function]->str, func->file, line);
+     line = func->line;
+     func = func->next;
+     lua_popfunction();
+   } while (func);
   }
   else
   {
    sprintf (strchr(msg,0),
-         "\n\tin statement begining at line %d of file \"%s\"", 
+         "\n\tin statement begining at line %u of file \"%s\"", 
          lua_debugline, lua_filename());
   }
  }
  lua_error (msg);
 }
 
+ 
+/*
+** 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();
+}
+
+/*
+** 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: print object values
+*/
+void lua_print (void)
+{
+ int i=1;
+ lua_Object obj;
+ while ((obj=lua_getparam (i++)) != LUA_NOOBJECT)
+ {
+  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber(obj));
+  else if (lua_isstring(obj))    printf("%s\n",lua_getstring(obj));
+  else if (lua_isfunction(obj))  printf("function: %p\n",bvalue(luaI_Address(obj)));
+  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction(obj)
+);
+  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata(obj));
+  else if (lua_istable(obj))     printf("table: %p\n",avalue(luaI_Address(obj)));
+  else if (lua_isnil(obj))       printf("nil\n");
+  else                           printf("invalid value to print\n");
+ }
+}
+
+
+/*
+** Internal function: return an object type.
+*/
+void luaI_type (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (o == LUA_NOOBJECT)
+    lua_error("no parameter to function 'type'");
+  switch (lua_type(o))
+  {
+    case LUA_T_NIL :
+      lua_pushliteral("nil");
+      break;
+    case LUA_T_NUMBER :
+      lua_pushliteral("number");
+      break;
+    case LUA_T_STRING :
+      lua_pushliteral("string");
+      break;
+    case LUA_T_ARRAY :
+      lua_pushliteral("table");
+      break;
+    case LUA_T_FUNCTION :
+      lua_pushliteral("function");
+      break;
+    case LUA_T_CFUNCTION :
+      lua_pushliteral("cfunction");
+      break;
+    default :
+      lua_pushliteral("userdata");
+      break;
+  }
+}
+ 
+/*
+** Internal function: convert an object to a number
+*/
+void lua_obj2number (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isnumber(o))
+    lua_pushobject(o);
+  else if (lua_isstring(o))
+  {
+    char c;
+    float f;
+    if (sscanf(lua_getstring(o),"%f %c",&f,&c) == 1)
+      lua_pushnumber(f);
+    else
+      lua_pushnil();
+  }
+  else
+    lua_pushnil();
+}
+
+
+void luaI_error (void)
+{
+  char *s = lua_getstring(lua_getparam(1));
+  if (s == NULL) s = "(no message)";
+  lua_reportbug(s);
+}
+

inout.h

@@ -1,24 +1,30 @@
 /*
-** inout.h
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 11 May 93
+** $Id: inout.h,v 1.6 1994/11/21 21:41:09 roberto Stab roberto $
 */
 
 
 #ifndef inout_h
 #define inout_h
 
-extern int lua_linenumber;
-extern int lua_debug;
-extern int lua_debugline;
+#include "types.h"
 
-int  lua_openfile     (char *fn);
+extern Word lua_linenumber;
+extern Bool lua_debug;
+extern Word lua_debugline;
+
+char *lua_openfile     (char *fn);
 void lua_closefile    (void);
-int  lua_openstring   (char *s);
-int  lua_pushfunction (int file, int function);
+char *lua_openstring   (char *s);
+void lua_closestring  (void);
+void lua_pushfunction (char *file, Word function);
 void lua_popfunction  (void);
 void lua_reportbug    (char *s);
 
+void    lua_internaldofile (void);
+void    lua_internaldostring (void);
+void    lua_print      (void);
+void    luaI_type       (void);
+void    lua_obj2number (void);
+void	luaI_error     (void);
+
 #endif

iolib.c

@@ -1,21 +1,20 @@
 /*
 ** iolib.c
 ** Input/output library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
-#include <stdlib.h>
-#include <string.h>
+char *rcs_iolib="$Id: iolib.c,v 1.20 1995/02/02 18:54:58 roberto Exp roberto $";
+
 #include <stdio.h>
 #include <ctype.h>
-#ifdef __GNUC__
-#include <floatingpoint.h>
-#endif
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <string.h>
+#include <time.h>
+#include <stdlib.h>
 
 #include "lua.h"
+#include "lualib.h"
 
 static FILE *in=stdin, *out=stdout;
 
@@ -30,7 +29,7 @@ static FILE *in=stdin, *out=stdout;
 static void io_readfrom (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL)			/* restore standart input */
+ if (o == LUA_NOOBJECT)			/* restore standart input */
  {
   if (in != stdin)
   {
@@ -75,7 +74,7 @@ static void io_readfrom (void)
 static void io_writeto (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL)			/* restore standart output */
+ if (o == LUA_NOOBJECT)			/* restore standart output */
  {
   if (out != stdout)
   {
@@ -109,6 +108,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 == LUA_NOOBJECT)			/* restore standart output */
+ {
+  if (out != stdout)
+  {
+   fclose (out);
+   out = stdout;
+  }
+  lua_pushnumber (1);
+ }
+ else
+ {
+  if (!lua_isstring (o))
+  {
+   lua_error ("incorrect argument to function 'appendto`");
+   lua_pushnumber (0);
+  }
+  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 +177,7 @@ static void io_writeto (void)
 static void io_read (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL)			/* free format */
+ if (o == LUA_NOOBJECT || !lua_isstring(o))	/* free format */
  {
   int c;
   char s[256];
@@ -134,23 +185,34 @@ static void io_read (void)
    ;
   if (c == '\"')
   {
-   if (fscanf (in, "%[^\"]\"", s) != 1)
+   int 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 n=0;
+   while((c = fgetc(in)) != '\'')
    {
-    lua_pushnil ();
-    return;
+    if (c == EOF)
+    {
+     lua_pushnil ();
+     return;
+    }
+    s[n++] = c;
    }
+   s[n] = 0;
   }
   else
   {
-   char *ptr;
    double d;
    ungetc (c, in);
    if (fscanf (in, "%s", s) != 1)
@@ -158,8 +220,7 @@ static void io_read (void)
     lua_pushnil ();
     return;
    }
-   d = strtod (s, &ptr);
-   if (!(*ptr))
+   if (sscanf(s, "%lf %*c", &d) == 1)
    {
     lua_pushnumber (d);
     return;
@@ -183,7 +244,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':
@@ -195,9 +265,9 @@ static void io_read (void)
     break;
     case 'f': case 'g': case 'e':
     {
-     float f;
-     sscanf (s, "%f", &f);
-     lua_pushnumber(f);
+     float fl;
+     sscanf (s, "%f", &fl);
+     lua_pushnumber(fl);
     }
     break;
     default: 
@@ -212,22 +282,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;
    }
@@ -236,6 +309,38 @@ static void io_read (void)
 }
 
 
+/*
+** Read characters until a given one. The delimiter is not read.
+*/
+static void io_readuntil (void)
+{
+ int n=255,m=0;
+ int c,d;
+ char *s;
+ lua_Object lo = lua_getparam(1);
+ if (!lua_isstring(lo))
+  d = EOF; 
+ else
+  d = *lua_getstring(lo);
+ 
+ s = (char *)malloc(n+1);
+ while((c = fgetc(in)) != EOF && c != d)
+ {
+  if (m==n)
+  {
+   n *= 2;
+   s = (char *)realloc(s, n+1);
+  }
+  s[m++] = c;
+ }
+ if (c != EOF) ungetc(c,in);
+ s[m] = 0;
+ lua_pushstring(s);
+ free(s);
+}
+
+
+
 /*
 ** Write a variable. On error put 0 on stack, otherwise put 1.
 ** LUA interface:
@@ -264,39 +369,49 @@ static void io_read (void)
 */
 static char *buildformat (char *e, lua_Object o)
 {
- static char buffer[512];
+ static char buffer[2048];
  static char f[80];
  char *string = &buffer[255];
+ char *fstart=e, *fspace, *send;
  char t, j='r';
- int  m=0, n=0, l;
+ int  m=0, n=-1, l;
  while (isspace(*e)) e++;
+ fspace = e;
  t = *e++;
  if (*e == '<' || *e == '|' || *e == '>') j = *e++;
  while (isdigit(*e))
   m = m*10 + (*e++ - '0');
- e++;	/* skip point */
+ if (*e == '.') e++;	/* skip point */
  while (isdigit(*e))
-  n = n*10 + (*e++ - '0');
+  if (n < 0) n = (*e++ - '0');
+  else       n = n*10 + (*e++ - '0');
 
  sprintf(f,"%%");
  if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
- if (m != 0)   sprintf(strchr(f,0),"%d", m);
- if (n != 0)   sprintf(strchr(f,0),".%d", n);
- sprintf(strchr(f,0), "%c", t);
- switch (tolower(t))
+ if (m >  0)   sprintf(strchr(f,0),"%d", m);
+ if (n >= 0)   sprintf(strchr(f,0),".%d", n);
+ switch (t)
  {
-  case 'i': t = 'i';
+  case 'i': case 'I': t = 'd';
+   sprintf(strchr(f,0), "%c", t);
    sprintf (string, f, (long int)lua_getnumber(o));
   break;
-  case 'f': case 'g': case 'e': t = 'f';
+  case 'f': case 'g': case 'e': case 'G': case 'E': 
+   sprintf(strchr(f,0), "%c", t);
    sprintf (string, f, (float)lua_getnumber(o));
   break;
-  case 's': t = 's';
+  case 'F': t = 'f';
+   sprintf(strchr(f,0), "%c", t);
+   sprintf (string, f, (float)lua_getnumber(o));
+  break;
+  case 's': case 'S': t = 's';
+   sprintf(strchr(f,0), "%c", t);
    sprintf (string, f, lua_getstring(o));
   break;
   default: return "";
  }
  l = strlen(string);
+ send = string+l;
  if (m!=0 && l>m)
  {
   int i;
@@ -306,25 +421,34 @@ static char *buildformat (char *e, lua_Object o)
  }
  else if (m!=0 && j=='|')
  {
+  int k;
   int i=l-1;
-  while (isspace(string[i])) i--;
-  string -= (m-i) / 2;
-  i=0;
-  while (string[i]==0) string[i++] = ' ';
-  string[l] = 0;
+  while (isspace(string[i]) || string[i]==0) i--;
+  string -= (m-i)/2;
+  for(k=0; k<(m-i)/2; k++)
+   string[k] = ' ';
  }
+ /* add space characteres */
+ while (fspace != fstart)
+ {
+  string--;
+  fspace--;
+  *string = *fspace; 
+ }
+ while (isspace(*e)) *send++ = *e++;
+ *send = 0;
  return string;
 }
 static void io_write (void)
 {
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
- if (o1 == NULL)			/* new line */
+ if (o1 == LUA_NOOBJECT)			/* new line */
  {
   fprintf (out, "\n");
   lua_pushnumber(1);
  }
- else if (o2 == NULL)   		/* free format */
+ else if (o2 == LUA_NOOBJECT)   		/* free format */
  {
   int status=0;
   if (lua_isnumber(o1))
@@ -346,21 +470,21 @@ 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)
+static void io_execute (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL || !lua_isstring (o))
+ if (o == LUA_NOOBJECT || !lua_isstring (o))
  {
   lua_error ("incorrect argument to function 'execute`");
   lua_pushnumber (0);
  }
  else
  {
-  system(lua_getstring(o));
-  lua_pushnumber (1);
+  int res = system(lua_getstring(o));
+  lua_pushnumber (res);
  }
  return;
 }
@@ -369,10 +493,10 @@ void io_execute (void)
 ** Remove a file.
 ** On error put 0 on stack, otherwise put 1.
 */
-void io_remove  (void)
+static void io_remove  (void)
 {
  lua_Object o = lua_getparam (1);
- if (o == NULL || !lua_isstring (o))
+ if (o == LUA_NOOBJECT || !lua_isstring (o))
  {
   lua_error ("incorrect argument to function 'execute`");
   lua_pushnumber (0);
@@ -387,6 +511,88 @@ void io_remove  (void)
  return;
 }
 
+
+/*
+** To get a environment variables
+*/
+static void io_getenv (void)
+{
+ lua_Object s = lua_getparam(1);
+ if (!lua_isstring(s))
+  lua_pushnil();
+ else
+ {
+  char *env = getenv(lua_getstring(s));
+  if (env == NULL) lua_pushnil();
+  else             lua_pushstring(env); 
+ }
+}
+
+/*
+** Return time: hour, min, sec
+*/
+static void io_time (void)
+{
+ time_t t;
+ struct tm *s;
+ 
+ time(&t);
+ s = localtime(&t);
+ lua_pushnumber(s->tm_hour);
+ lua_pushnumber(s->tm_min);
+ lua_pushnumber(s->tm_sec);
+}
+ 
+/*
+** Return date: dd, mm, yyyy
+*/
+static void io_date (void)
+{
+ time_t t;
+ struct tm *s;
+ 
+ time(&t);
+ s = localtime(&t);
+ lua_pushnumber(s->tm_mday);
+ lua_pushnumber(s->tm_mon+1);
+ lua_pushnumber(s->tm_year+1900);
+}
+ 
+/*
+** Beep
+*/
+static void io_beep (void)
+{
+ printf("\a");
+}
+ 
+/*
+** To exit
+*/
+static void io_exit (void)
+{
+ lua_Object o = lua_getparam(1);
+ if (lua_isstring(o))
+  printf("%s\n", lua_getstring(o));
+ exit(1);
+}
+
+/*
+** To debug a lua program. Start a dialog with the user, interpreting
+   lua commands until an 'cont'.
+*/
+static void io_debug (void)
+{
+  while (1)
+  {
+    char buffer[250];
+    fprintf(stderr, "lua_debug> ");
+    if (gets(buffer) == 0) return;
+    if (strcmp(buffer, "cont") == 0) return;
+    lua_dostring(buffer);
+  }
+}
+
 /*
 ** Open io library
 */
@@ -394,8 +600,16 @@ void iolib_open (void)
 {
  lua_register ("readfrom", io_readfrom);
  lua_register ("writeto",  io_writeto);
+ lua_register ("appendto", io_appendto);
  lua_register ("read",     io_read);
+ lua_register ("readuntil",io_readuntil);
  lua_register ("write",    io_write);
  lua_register ("execute",  io_execute);
  lua_register ("remove",   io_remove);
+ lua_register ("getenv",   io_getenv);
+ lua_register ("time",     io_time);
+ lua_register ("date",     io_date);
+ lua_register ("beep",     io_beep);
+ lua_register ("exit",     io_exit);
+ lua_register ("debug",    io_debug);
 }

lex.c

@@ -0,0 +1,271 @@
+char *rcs_lex = "$Id: lex.c,v 2.13 1994/12/20 21:20:36 roberto Exp celes $";
+ 
+
+#include <ctype.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "tree.h"
+#include "table.h"
+#include "opcode.h"
+#include "inout.h"
+#include "parser.h"
+#include "ugly.h"
+
+#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
+
+#define 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;
+}
+
+
+/* The reserved words must be listed in lexicographic order */
+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]))
+
+
+static int findReserved (char *name)
+{
+  int l = 0;
+  int h = RESERVEDSIZE - 1;
+  while (l <= h)
+  {
+    int m = (l+h)/2;
+    int comp = lua_strcmp(name, reserved[m].name);
+    if (comp < 0)
+      h = m-1;
+    else if (comp == 0)
+      return reserved[m].token;
+    else
+      l = m+1;
+  }
+  return 0;
+}
+
+
+int yylex (void)
+{
+  float a;
+  while (1)
+  {
+    yytextLast = yytext;
+#if 0
+    fprintf(stderr,"'%c' %d\n",current,current);
+#endif
+    switch (current)
+    {
+      case EOF:
+      case 0:
+       return 0;
+      case '\n': lua_linenumber++;
+      case ' ':
+      case '\t':
+        next();
+        continue;
+
+      case '$':
+	next();
+	while (isalnum(current) || current == '_')
+          save_and_next();
+        *yytextLast = 0;
+	if (lua_strcmp(yytext, "debug") == 0)
+	{
+	  yylval.vInt = 1;
+	  return DEBUG;
+        }
+	else if (lua_strcmp(yytext, "nodebug") == 0)
+	{
+	  yylval.vInt = 0;
+	  return DEBUG;
+        }
+	return WRONGTOKEN;
+
+      case '-':
+        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 EQ; }
+
+      case '<':
+        save_and_next();
+        if (current != '=') return '<';
+        else { save_and_next(); return LE; }
+
+      case '>':
+        save_and_next();
+        if (current != '=') return '>';
+        else { save_and_next(); return GE; }
+
+      case '~':
+        save_and_next();
+        if (current != '=') return '~';
+        else { save_and_next(); return NE; }
+
+      case '"':
+      case '\'':
+      {
+        int del = current;
+        next();  /* skip the delimiter */
+        while (current != del)
+        {
+          switch (current)
+          {
+            case EOF:
+            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(current); next(); break;
+              }
+              break;
+            default:
+              save_and_next();
+          }
+        }
+        next();  /* skip the delimiter */
+        *yytextLast = 0;
+        yylval.vWord = luaI_findconstant(lua_constcreate(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 '_':
+      {
+        Word res;
+        do { save_and_next(); } while (isalnum(current) || current == '_');
+        *yytextLast = 0;
+        res = findReserved(yytext);
+        if (res) return res;
+        yylval.pNode = lua_constcreate(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 */
+	a=0.0;
+        goto fraction;
+
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+	a=0.0;
+        do { a=10*a+current-'0'; save_and_next(); } while (isdigit(current));
+        if (current == '.') save_and_next();
+fraction:
+	{ float da=0.1;
+	  while (isdigit(current))
+	  {a+=(current-'0')*da; da/=10.0; save_and_next()};
+          if (current == 'e' || current == 'E')
+          {
+	    int e=0;
+	    int neg;
+	    float ea;
+            save_and_next();
+	    neg=(current=='-');
+            if (current == '+' || current == '-') save_and_next();
+            if (!isdigit(current)) return WRONGTOKEN;
+            do { e=10*e+current-'0'; save_and_next(); } while (isdigit(current));
+	    for (ea=neg?0.1:10.0; e>0; e>>=1) 
+	    {
+	      if (e & 1) a*=ea;
+	      ea*=ea;
+	    }
+          }
+          yylval.vFloat = a;
+          return NUMBER;
+        }
+
+      case U_and: case U_do: case U_else: case U_elseif: case U_end:
+      case U_function: case U_if: case U_local: case U_nil: case U_not:
+      case U_or: case U_repeat: case U_return: case U_then:
+      case U_until: case U_while:
+      {
+        int old = current;
+        next();
+        return reserved[old-U_and].token;
+      }
+
+      case U_eq:	next(); return EQ;
+      case U_le:	next(); return LE;
+      case U_ge:	next(); return GE;
+      case U_ne:	next(); return NE;
+      case U_sc:	next(); return CONC;
+
+      default: 		/* also end of file */
+      {
+        save_and_next();
+        return yytext[0];
+      }
+    }
+  }
+}

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,74 @@
 /*
 ** lua.c
 ** Linguagem para Usuarios de Aplicacao
-** TeCGraf - PUC-Rio
-** 28 Apr 93
 */
 
+char *rcs_lua="$Id: lua.c,v 1.3 1994/12/14 19:58:20 celes Exp $";
+
 #include <stdio.h>
+#include <string.h>
 
 #include "lua.h"
 #include "lualib.h"
 
+static int lua_argc;
+static char **lua_argv;
 
-void test (void)
+/*
+%F Allow Lua code to access argv strings.
+%i Receive from Lua the argument number (starting with 1).
+%o Return to Lua the argument, or nil if it does not exist.
+*/
+static void lua_getargv (void)
 {
-  lua_pushobject(lua_getparam(1));
-  lua_call ("c", 1);
+ lua_Object lo = lua_getparam(1);
+ if (!lua_isnumber(lo))
+  lua_pushnil();
+ else
+ {
+  int n = (int)lua_getnumber(lo);
+  if (n < 1 || n > lua_argc) lua_pushnil();
+  else                       lua_pushstring(lua_argv[n]);
+ }
 }
 
 
-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 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);
+ int result = 0;
  iolib_open ();
  strlib_open ();
  mathlib_open ();
- lua_dofile (argv[1]);
- for (i=2; i<argc; i++)
+
+ lua_register("argv", lua_getargv);
+
+ if (argc < 2)
  {
-  lua_call (argv[i],0);
+   char buffer[250];
+   while (gets(buffer) != 0)
+     result = lua_dostring(buffer);
  }
+ else
+ {
+  for (i=1; i<argc; i++)
+  {
+   if (strcmp(argv[i], "--") == 0)
+   {
+    lua_argc = argc-i-1;
+    lua_argv = argv+i;
+    break;
+   }
+  }
+  for (i=1; i<argc; i++)
+  {
+   if (strcmp(argv[i], "--") == 0)
+    break;
+   else
+    result = lua_dofile (argv[i]);
+  }
+ }
+ return result;
 }
 
 

lua.h

@@ -2,53 +2,99 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** 19 May 93
+** $Id: lua.h,v 3.15 1995/01/18 20:15:05 celes Exp celes $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+/* Private Part */
+ 
+typedef enum
+{
+ LUA_T_NIL	= -1,
+ LUA_T_NUMBER	= -2,
+ LUA_T_STRING	= -3,
+ LUA_T_ARRAY	= -4,
+ LUA_T_FUNCTION	= -5,
+ LUA_T_CFUNCTION= -6,
+ LUA_T_USERDATA = 0
+} lua_Type;
+ 
+
+/* Public Part */
+
+#define LUA_NOOBJECT  0
+
 typedef void (*lua_CFunction) (void);
-typedef struct Object *lua_Object;
+typedef unsigned int lua_Object;
 
-#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+lua_Object     lua_setfallback		(char *name, lua_CFunction fallback);
 
-
-void           lua_errorfunction    	(void (*fn) (char *s));
 void           lua_error		(char *s);
 int            lua_dofile 		(char *filename);
 int            lua_dostring 		(char *string);
-int            lua_call 		(char *functionname, int nparam);
+int            lua_callfunction		(lua_Object function);
+int	       lua_call			(char *funcname);
+
+void	       lua_beginblock		(void);
+void	       lua_endblock		(void);
 
 lua_Object     lua_getparam 		(int number);
+#define	       lua_getresult(_)		lua_getparam(_)
+
 float          lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
-char 	      *lua_copystring 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
 void          *lua_getuserdata  	(lua_Object object);
-lua_Object     lua_getfield         	(lua_Object object, char *field);
-lua_Object     lua_getindexed         	(lua_Object object, float index);
+
+void 	       lua_pushnil 		(void);
+void           lua_pushnumber 		(float n);
+void           lua_pushstring 		(char *s);
+void           lua_pushliteral 		(char *s);
+void           lua_pushcfunction	(lua_CFunction fn);
+void           lua_pushusertag     	(void *u, int tag);
+void           lua_pushobject       	(lua_Object object);
+
 lua_Object     lua_getglobal 		(char *name);
+void           lua_storeglobal		(char *name);
 
-lua_Object     lua_pop 			(void);
+void           lua_storesubscript	(void);
+lua_Object     lua_getsubscript         (void);
 
-int 	       lua_pushnil 		(void);
-int            lua_pushnumber 		(float n);
-int            lua_pushstring 		(char *s);
-int            lua_pushcfunction	(lua_CFunction fn);
-int            lua_pushuserdata     	(void *u);
-int            lua_pushobject       	(lua_Object object);
+int            lua_type 		(lua_Object object);
 
-int            lua_storeglobal		(char *name);
-int            lua_storefield		(lua_Object object, char *field);
-int            lua_storeindexed		(lua_Object object, float index);
+int	       lua_lock			(void);
+lua_Object     lua_getlocked		(int ref);
+void	       lua_pushlocked		(int ref);
+void	       lua_unlock		(int ref);
 
-int            lua_isnil 		(lua_Object object);
-int            lua_isnumber 		(lua_Object object);
-int            lua_isstring 		(lua_Object object);
-int            lua_istable          	(lua_Object object);
-int            lua_iscfunction 		(lua_Object object);
-int            lua_isuserdata 		(lua_Object object);
+lua_Object     lua_createtable		(void);
+
+
+/* some useful macros */
+
+#define lua_lockobject(o)  (lua_pushobject(o), lua_lock())
+
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+
+#define lua_pushuserdata(u)     lua_pushusertag(u, LUA_T_USERDATA)
+
+#define lua_isnil(_)            (lua_type(_)==LUA_T_NIL)
+#define lua_isnumber(_)         (lua_type(_)==LUA_T_NUMBER)
+#define lua_isstring(_)         (lua_type(_)==LUA_T_STRING)
+#define lua_istable(_)          (lua_type(_)==LUA_T_ARRAY)
+#define lua_isfunction(_)       (lua_type(_)==LUA_T_FUNCTION)
+#define lua_iscfunction(_)      (lua_type(_)==LUA_T_CFUNCTION)
+#define lua_isuserdata(_)       (lua_type(_)>=LUA_T_USERDATA)
+
+
+/* for lua 1.1 compatibility. Avoid using these macros */
+
+#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_getsubscript())
+#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushliteral(f), lua_getsubscript())
+
+#define lua_copystring(o) (strdup(lua_getstring(o)))
 
 #endif

lua.stx

@@ -0,0 +1,974 @@
+%{
+
+char *rcs_luastx = "$Id: lua.stx,v 3.16 1994/12/27 20:41:11 celes Exp roberto $";
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "mem.h"
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "tree.h"
+#include "table.h"
+#include "lua.h"
+
+/* to avoid warnings generated by yacc */
+int yyparse (void);
+#define malloc luaI_malloc
+#define realloc luaI_realloc
+#define free luaI_free
+
+#ifndef LISTING
+#define LISTING 0
+#endif
+
+#ifndef CODE_BLOCK
+#define CODE_BLOCK 256
+#endif
+static int   maxcode;
+static int   maxmain;
+static Long   maxcurr;  /* to allow maxcurr *= 2 without overflow */
+static Byte  *funcCode = NULL;
+static Byte **initcode;
+static Byte  *basepc;
+static int   maincode;
+static int   pc;
+
+#define MAXVAR 32
+static Long    varbuffer[MAXVAR];    /* variables in an assignment list;
+				it's long to store negative Word values */
+static int     nvarbuffer=0;	     /* number of variables at a list */
+
+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;
+
+
+/* Internal functions */
+
+static void code_byte (Byte c)
+{
+ if (pc>maxcurr-2)  /* 1 byte free to code HALT of main code */
+ {
+  if (maxcurr >= MAX_INT)
+    lua_error("code size overflow");
+  maxcurr *= 2;
+  if (maxcurr >= MAX_INT)
+    maxcurr = MAX_INT;
+  basepc = growvector(basepc, maxcurr, Byte);
+ }
+ 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_code (Byte *b)
+{
+ CodeCode code;
+ code.b = b;
+ 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");
+}
+
+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]);
+}
+
+static void flush_list (int m, int n)
+{
+  if (n == 0) return;
+  if (m == 0)
+    code_byte(STORELIST0); 
+  else
+  if (m < 255)
+  {
+    code_byte(STORELIST);
+    code_byte(m);
+  }
+  else
+   lua_error ("list constructor too long");
+  code_byte(n);
+}
+
+static void add_nlocalvar (int n)
+{
+ if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
+  nlocalvar += n;
+ else
+  lua_error ("too many local variables");
+}
+
+static void incr_nvarbuffer (void)
+{
+ if (nvarbuffer < MAXVAR-1)
+  nvarbuffer++;
+ else
+  lua_error ("variable buffer overflow");
+}
+
+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);
+  }
+}
+
+/*
+** 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);
+ }
+ else if (number < 0)	/* local var */
+ {
+  number = (-number) - 1;
+  if (number < 10) code_byte(PUSHLOCAL0 + number);
+  else
+  {
+   code_byte(PUSHLOCAL);
+   code_byte(number);
+  }
+ }
+ else
+ {
+  code_byte(PUSHINDEXED);
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ if (n+nlocalvar == 0)
+   code_byte(ADJUST0);
+ else
+ {
+   code_byte(ADJUST);
+   code_byte(n+nlocalvar);
+ }
+}
+
+static void init_function (TreeNode *func)
+{
+ if (funcCode == NULL)	/* first function */
+ {
+  funcCode = newvector(CODE_BLOCK, Byte);
+  maxcode = CODE_BLOCK;
+ }
+ pc=0; basepc=funcCode; maxcurr=maxcode; 
+ nlocalvar=0;
+  if (lua_debug)
+  {
+    code_byte(SETFUNCTION); 
+    code_code((Byte *)luaI_strdup(lua_file[lua_nfile-1]));
+    code_word(luaI_findconstant(func));
+  }
+}
+
+static void codereturn (void)
+{
+  if (lua_debug) code_byte(RESET); 
+  if (nlocalvar == 0)
+    code_byte(RETCODE0);
+  else
+  {
+    code_byte(RETCODE);
+    code_byte(nlocalvar);
+  }
+}
+
+static void codedebugline (void)
+{
+  if (lua_debug)
+  {
+    code_byte(SETLINE);
+    code_word(lua_linenumber);
+  }
+}
+
+static void adjust_mult_assign (int vars, int exps, int temps)
+{
+  if (exps < 0) 
+  {
+    int r = vars - (-exps-1);
+    if (r >= 0)
+      code_byte(r);
+    else
+    {
+      code_byte(0);
+      lua_codeadjust(temps);
+    }
+  }
+  else if (vars != exps)
+    lua_codeadjust(temps);
+}
+
+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);
+  }
+ }
+}
+
+static void codeIf (Long thenAdd, Long elseAdd)
+{
+  Long elseinit = elseAdd+sizeof(Word)+1;
+  if (pc == elseinit)		/* no else */
+  {
+    pc -= sizeof(Word)+1;
+    elseinit = pc;
+  }
+  else
+  {
+    basepc[elseAdd] = JMP;
+    code_word_at(basepc+elseAdd+1, pc-elseinit);
+  }
+  basepc[thenAdd] = IFFJMP;
+  code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
+}
+
+static void yyerror (char *s)
+{
+ static char msg[256];
+ sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
+          s, lua_lasttext (), lua_linenumber, lua_filename());
+ lua_error (msg);
+}
+
+
+/*
+** Parse LUA code.
+*/
+void lua_parse (Byte **code)
+{
+ initcode = code;
+ *initcode = newvector(CODE_BLOCK, Byte);
+ maincode = 0; 
+ maxmain = CODE_BLOCK;
+ if (yyparse ()) lua_error("parse error");
+ (*initcode)[maincode++] = RETCODE0;
+#if LISTING
+{ static void PrintCode (Byte *c, Byte *end);
+ PrintCode(*initcode,*initcode+maincode); }
+#endif
+}
+
+
+%}
+
+
+%union 
+{
+ int   vInt;
+ float vFloat;
+ char *pChar;
+ Word  vWord;
+ Long  vLong;
+ Byte *pByte;
+ TreeNode *pNode;
+}
+
+%start functionlist
+
+%token WRONGTOKEN
+%token NIL
+%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
+%token RETURN
+%token LOCAL
+%token FUNCTION
+%token <vFloat> NUMBER
+%token <vWord>  STRING
+%token <pNode>  NAME 
+%token <vInt>   DEBUG
+
+%type <vLong> PrepJump
+%type <vInt>  expr, exprlist, exprlist1, varlist1, funcParams, funcvalue
+%type <vInt>  fieldlist, localdeclist, decinit
+%type <vInt>  ffieldlist1
+%type <vInt>  lfieldlist1
+%type <vLong> var, singlevar
+%type <pByte> body
+
+%left AND OR
+%left EQ NE '>' '<' LE GE
+%left CONC
+%left '+' '-'
+%left '*' '/'
+%left UNARY NOT
+%right '^'
+
+
+%% /* 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 method
+	     | functionlist setdebug
+	     ;
+
+function     : FUNCTION NAME 
+               {
+		init_function($2);
+	       }
+               body 	 
+	       { 
+		Word func = luaI_findsymbol($2);
+	        s_tag(func) = LUA_T_FUNCTION;
+	        s_bvalue(func) = $4;
+	       }
+	       ;
+
+method         : FUNCTION NAME ':' NAME
+	       {
+		init_function($4);
+	        localvar[nlocalvar]=luaI_findsymbolbyname("self");
+	        add_nlocalvar(1);
+	       }
+	       body
+	       {
+	        /* assign function to table field */
+	        pc=maincode; basepc=*initcode; maxcurr=maxmain;
+	        nlocalvar=0;
+		lua_pushvar(luaI_findsymbol($2)+1);
+                code_byte(PUSHSTRING);
+		code_word(luaI_findconstant($4));
+                code_byte(PUSHFUNCTION);
+                code_code($6);
+                code_byte(STOREINDEXED0);
+		maincode=pc; *initcode=basepc; maxmain=maxcurr;
+	       }
+	       ;
+
+body :  '(' parlist ')' block END
+	{
+          codereturn();
+	  $$ = newvector(pc, Byte);
+	  memcpy($$, basepc, pc*sizeof(Byte));
+	  funcCode = basepc; maxcode=maxcurr;
+#if LISTING
+                PrintCode(funcCode,funcCode+pc);
+#endif
+	}
+		;
+
+statlist : /* empty */
+	 | statlist stat sc
+	 ;
+
+sc	 : /* empty */ | ';' ;
+
+stat  : { codedebugline(); } stat1 ;
+
+cond  : { codedebugline(); } expr1 ;
+
+stat1  : IF expr1 THEN PrepJump block PrepJump elsepart END
+	{ codeIf($4, $6); }
+
+       | WHILE {$<vLong>$=pc;} expr1 DO PrepJump block PrepJump END
+       {
+        basepc[$5] = IFFJMP;
+	code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1));
+        basepc[$7] = UPJMP;
+	code_word_at(basepc+$7+1, pc - ($<vLong>2));
+       }
+     
+       | REPEAT {$<vLong>$=pc;} block UNTIL cond PrepJump
+       {
+        basepc[$6] = IFFUPJMP;
+	code_word_at(basepc+$6+1, pc - ($<vLong>2));
+       }
+
+       | varlist1 '=' exprlist1
+       {
+        {
+         int i;
+         adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer);
+	 for (i=nvarbuffer-1; i>=0; i--)
+	  lua_codestore (i);
+	 if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
+	  lua_codeadjust (0);
+	}
+       } 
+       | functioncall	{ code_byte(0); }
+       | LOCAL localdeclist decinit
+	{ add_nlocalvar($2);
+	  adjust_mult_assign($2, $3, 0);
+	 }
+       ;
+
+elsepart : /* empty */
+	 | ELSE block
+         | ELSEIF cond THEN PrepJump block PrepJump elsepart
+	{ codeIf($4, $6); }
+         ;
+     
+block    : {$<vInt>$ = nlocalvar;} statlist ret 
+         {
+	  if (nlocalvar != $<vInt>1)
+	  {
+           nlocalvar = $<vInt>1;
+	   lua_codeadjust (0);
+	  }
+         }
+         ;
+
+ret	: /* empty */
+        | RETURN { codedebugline(); } exprlist sc
+          {
+           if ($3 < 0) code_byte(MULT_RET);
+           codereturn();
+          }
+	;
+
+PrepJump : /* empty */
+	 { 
+	  $$ = pc;
+	  code_byte(0);		/* open space */
+	  code_word (0);
+         }
+	   
+expr1	 : expr { if ($1 == 0) code_byte(1); }
+	 ;
+				
+expr :  '(' expr ')'  { $$ = $2; }
+     |  expr1 EQ  expr1	{ code_byte(EQOP);   $$ = 1; }
+     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 1; }
+     |	expr1 '>' expr1	{ code_byte(GTOP);   $$ = 1; }
+     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 1; }
+     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 1; }
+     |	expr1 GE  expr1	{ code_byte(GEOP);   $$ = 1; }
+     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 1; }
+     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 1; }
+     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; }
+     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 1; }
+     |	expr1 '^' expr1 { code_byte(POWOP);  $$ = 1; }
+     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 1; }
+     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 1;}
+     | table { $$ = 1; }
+     |  varexp          { $$ = 1;}
+     |  NUMBER          { code_number($1); $$ = 1; }
+     |  STRING
+     {
+      code_byte(PUSHSTRING);
+      code_word($1);
+      $$ = 1;
+     }
+     |	NIL		{code_byte(PUSHNIL); $$ = 1; }
+     |  functioncall    { $$ = 0; }
+     |	NOT expr1	{ code_byte(NOTOP);  $$ = 1;}
+     |	expr1 AND PrepJump {code_byte(POP); } expr1
+     { 
+      basepc[$3] = ONFJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 1;
+     }
+     |	expr1 OR PrepJump {code_byte(POP); } expr1	
+     { 
+      basepc[$3] = ONTJMP;
+      code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
+      $$ = 1;
+     }
+     ;
+
+table :
+     {
+      code_byte(CREATEARRAY);
+      $<vLong>$ = pc; code_word(0);
+     }
+      '{' fieldlist '}'
+     {
+      code_word_at(basepc+$<vLong>1, $3);
+     }
+         ;
+
+functioncall : funcvalue funcParams
+	{ code_byte(CALLFUNC); code_byte($1+$2); }
+	     ;
+
+funcvalue    : varexp { $$ = 0; }
+	     | varexp ':' NAME 
+	     { 
+               code_byte(PUSHSELF); 
+	       code_word(luaI_findconstant($3));
+               $$ = 1;
+	     }
+	     ;
+
+funcParams :	'(' exprlist ')'
+	{ if ($2<0) { code_byte(1); $$ = -$2; } else $$ = $2; }
+	|	table  { $$ = 1; }
+	;
+
+exprlist  :	/* empty */		{ $$ = 0; }
+	  |	exprlist1		{ $$ = $1; }
+	  ;
+		
+exprlist1 :	expr	{ if ($1 == 0) $$ = -1; else $$ = 1; }
+	  |	exprlist1 ',' { if ($1 < 0) code_byte(1); } expr 
+	{
+          int r = $1 < 0 ? -$1 : $1;
+          $$ = ($4 == 0) ? -(r+1) : r+1;
+	}
+	  ;
+
+parlist  :	/* empty */ { lua_codeadjust(0); }
+	  |	parlist1    { lua_codeadjust(0); }
+	  ;
+		
+parlist1 :	NAME		  
+		{
+		 localvar[nlocalvar]=luaI_findsymbol($1); 
+		 add_nlocalvar(1);
+		}
+	  |	parlist1 ',' NAME 
+		{
+		 localvar[nlocalvar]=luaI_findsymbol($3); 
+		 add_nlocalvar(1);
+		}
+	  ;
+		
+fieldlist  : /* empty */ { $$ =  0; }
+	   | lfieldlist1 lastcomma
+  	     { $$ = $1; flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+	   | ffieldlist1 lastcomma
+	     { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
+	   | lfieldlist1 ';' 
+	     { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
+	    ffieldlist1 lastcomma
+	     { $$ = $1+$4; flush_record($4%FIELDS_PER_FLUSH); }
+	   ;
+
+lastcomma  : /* empty */ 
+	   | ','
+	   ;
+
+ffieldlist1 : ffield			{$$=1;}
+	   | ffieldlist1 ',' ffield	
+		{
+		  $$=$1+1;
+		  if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
+		}
+	   ; 
+
+ffield      : NAME '=' expr1 
+	      { 
+	       push_field(luaI_findconstant($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	  :	singlevar { $$ = $1; }
+	  |	varexp '[' expr1 ']' 
+	  {
+	   $$ = 0;		/* indexed variable */
+	  }
+	  |	varexp '.' NAME
+	  {
+	   code_byte(PUSHSTRING);
+	   code_word(luaI_findconstant($3));
+	   $$ = 0;		/* indexed variable */
+	  }
+	  ;
+		
+singlevar :	NAME
+	  {
+	   Word s = luaI_findsymbol($1);
+	   int local = lua_localname (s);
+	   if (local == -1)	/* global var */
+	    $$ = s + 1;		/* return positive value */
+           else
+	    $$ = -(local+1);		/* return negative value */
+	  }
+	  ;
+
+varexp	: var { lua_pushvar($1); }
+	;
+	  
+localdeclist  : NAME {localvar[nlocalvar]=luaI_findsymbol($1); $$ = 1;}
+     	  | localdeclist ',' NAME 
+	    {
+	     localvar[nlocalvar+$1]=luaI_findsymbol($3); 
+	     $$ = $1+1;
+	    }
+	  ;
+		
+decinit	  : /* empty */  { $$ = 0; }
+	  | '=' exprlist1 { $$ = $2; }
+	  ;
+	  
+setdebug  : DEBUG {lua_debug = $1;}
+
+%%
+
+#if LISTING
+
+static void PrintCode (Byte *code, Byte *end)
+{
+ Byte *p = code;
+ printf ("\n\nCODE\n");
+ while (p != end)
+ {
+  switch ((OpCode)*p)
+  {
+   case PUSHNIL:	printf ("%d    PUSHNIL\n", (p++)-code); break;
+   case PUSH0: case PUSH1: case PUSH2:
+    			printf ("%d    PUSH%c\n", p-code, *p-PUSH0+'0');
+    			p++;
+   			break;
+   case PUSHBYTE:
+    			printf ("%d    PUSHBYTE   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case PUSHWORD:
+                        {
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHWORD   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHFLOAT:
+			{
+			 CodeFloat c;
+			 int n = p-code;
+			 p++;
+			 get_float(c,p);
+    			 printf ("%d    PUSHFLOAT  %f\n", n, c.f);
+			}
+   			break;
+   case PUSHSTRING:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHSTRING   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHFUNCTION:
+			{
+			 CodeCode c;
+			 int n = p-code;
+			 p++;
+			 get_code(c,p);
+			 printf ("%d    PUSHFUNCTION  %p\n", n, c.b);
+			}
+			break;
+
+   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
+   case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
+   case PUSHLOCAL8: case PUSHLOCAL9:
+    			printf ("%d    PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0');
+    			p++;
+   			break;
+   case PUSHLOCAL:	printf ("%d    PUSHLOCAL   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case PUSHGLOBAL:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHGLOBAL   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHINDEXED:    printf ("%d    PUSHINDEXED\n", (p++)-code); break;
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
+   case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
+   case STORELOCAL8: case STORELOCAL9:
+    			printf ("%d    STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
+    			p++;
+   			break;
+   case STORELOCAL:
+    			printf ("%d    STORELOCAL   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STOREGLOBAL:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    STOREGLOBAL   %d\n", n, c.w);
+			}
+   			break;
+   case PUSHSELF:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    PUSHSELF   %d\n", n, c.w);
+			}
+			break;
+   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
+   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STORELIST0:
+	printf("%d      STORELIST0  %d\n", p-code, *(++p));
+        p++;
+        break;
+   case STORELIST:
+	printf("%d      STORELIST  %d %d\n", p-code, *(p+1), *(p+2));
+        p+=3;
+        break;
+   case STORERECORD:
+       printf("%d      STORERECORD  %d\n", p-code, *(++p));
+       p += *p*sizeof(Word) + 1;
+       break;
+   case ADJUST0: printf ("%d    ADJUST0\n", (p++)-code); break;
+   case ADJUST:
+    			printf ("%d    ADJUST   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case CREATEARRAY:	
+    {
+      CodeWord c;
+      int n = p-code;
+      p++;
+      get_word(c,p);
+      printf ("%d    CREATEARRAY %d\n", n, c.w);
+      break;
+    }
+   case EQOP:       	printf ("%d    EQOP\n", (p++)-code); break;
+   case LTOP:       	printf ("%d    LTOP\n", (p++)-code); break;
+   case LEOP:       	printf ("%d    LEOP\n", (p++)-code); break;
+   case ADDOP:       	printf ("%d    ADDOP\n", (p++)-code); break;
+   case SUBOP:       	printf ("%d    SUBOP\n", (p++)-code); break;
+   case MULTOP:      	printf ("%d    MULTOP\n", (p++)-code); break;
+   case DIVOP:       	printf ("%d    DIVOP\n", (p++)-code); break;
+   case POWOP:       	printf ("%d    POWOP\n", (p++)-code); break;
+   case CONCOP:       	printf ("%d    CONCOP\n", (p++)-code); break;
+   case MINUSOP:       	printf ("%d    MINUSOP\n", (p++)-code); break;
+   case NOTOP:       	printf ("%d    NOTOP\n", (p++)-code); break;
+   case ONTJMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    ONTJMP  %d\n", n, c.w);
+			}
+   			break;
+   case ONFJMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    ONFJMP  %d\n", n, c.w);
+			}
+   			break;
+   case JMP:	   
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    JMP  %d\n", n, c.w);
+			}
+   			break;
+   case UPJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    UPJMP  %d\n", n, c.w);
+			}
+   			break;
+   case IFFJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    IFFJMP  %d\n", n, c.w);
+			}
+   			break;
+   case IFFUPJMP:
+    			{
+			 CodeWord c;
+			 int n = p-code;
+			 p++;
+			 get_word(c,p);
+    			 printf ("%d    IFFUPJMP  %d\n", n, c.w);
+			}
+   			break;
+   case POP:       	printf ("%d    POP\n", (p++)-code); break;
+   case CALLFUNC:
+	printf ("%d    CALLFUNC %d %d\n", p-code, *(p+1), *(p+2));
+	p+=3;
+	break;
+   case RETCODE0: printf ("%d    RETCODE0\n", (p++)-code); break;
+   case RETCODE:
+    			printf ("%d    RETCODE   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case SETFUNCTION:
+                        {
+			 CodeCode c1;
+                         CodeWord c2;
+                         int n = p-code;
+                         p++;
+                         get_code(c1,p);
+                         get_word(c2,p);
+                         printf ("%d    SETFUNCTION  %s  %d\n", n, (char *)c1.b, c2.w);
+                        }
+                        break;
+   case SETLINE:
+                        {
+                         CodeWord c;
+                         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: lualib.h,v 1.2 1994/08/24 15:29:02 celes Stab roberto $
 */
 
 #ifndef lualib_h
@@ -13,3 +13,4 @@ void strlib_open  (void);
 void mathlib_open (void);
 
 #endif
+

luamem.c

@@ -0,0 +1,44 @@
+/*
+** mem.c
+** TecCGraf - PUC-Rio
+*/
+
+char *rcs_mem = "$Id: mem.c,v 1.4 1995/01/13 22:11:12 roberto Exp roberto $";
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "mem.h"
+#include "lua.h"
+
+void luaI_free (void *block)
+{
+  *((int *)block) = -1;  /* to catch errors */
+  free(block);
+}
+
+
+void *luaI_malloc (unsigned long size)
+{
+  void *block = malloc((size_t)size);
+  if (block == NULL)
+    lua_error("not enough memory");
+  return block;
+}
+
+
+void *luaI_realloc (void *oldblock, unsigned long size)
+{
+  void *block = realloc(oldblock, (size_t)size);
+  if (block == NULL)
+    lua_error("not enough memory");
+  return block;
+}
+
+
+char *luaI_strdup (char *str)
+{
+  char *newstr = luaI_malloc(strlen(str)+1);
+  strcpy(newstr, str);
+  return newstr;
+}

luamem.h

@@ -0,0 +1,25 @@
+/*
+** mem.c
+** memory manager for lua
+** $Id: mem.h,v 1.1 1994/11/16 17:38:08 roberto Stab roberto $
+*/
+ 
+#ifndef mem_h
+#define mem_h
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+void luaI_free (void *block);
+void *luaI_malloc (unsigned long size);
+void *luaI_realloc (void *oldblock, unsigned long size);
+
+char *luaI_strdup (char *str);
+
+#define new(s)          ((s *)luaI_malloc(sizeof(s)))
+#define newvector(n,s)  ((s *)luaI_malloc((n)*sizeof(s)))
+#define growvector(old,n,s) ((s *)luaI_realloc(old,(n)*sizeof(s)))
+
+#endif 
+

makefile

@@ -0,0 +1,78 @@
+# $Id: makefile,v 1.12 1995/02/02 19:02:03 roberto Exp $
+# Compilation parameters
+CC = gcc
+CFLAGS = -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
+
+#CC = acc
+#CFLAGS = -fast -I/usr/5include
+
+AR = ar
+ARFLAGS	= rvl
+
+# Aplication modules
+LUAMOD =	\
+	parser 	\
+	lex	\
+	opcode	\
+	hash	\
+	table	\
+	inout	\
+	tree    \
+	fallback\
+	mem
+
+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 : parser.c $(LUAOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib lua.a
+
+lualib.a : $(LIBOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib $@
+
+liblua.so.1.0 : lua.o
+	ld -o liblua.so.1.0 $(LUAOBJS)
+
+%.o	: %.c
+	$(CC) $(CFLAGS) -c -o $@ $<
+
+
+parser.c : lua.stx
+	yacc++ -d lua.stx ; mv -f y.tab.c parser.c ; mv -f y.tab.h parser.h
+
+clear	:
+	rcsclean
+	rm -f *.o
+	rm -f parser.c parser.h
+	co lua.h lualib.h
+
+% : RCS/%,v
+	co $@
+
+
+fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h inout.h 
+hash.o : hash.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+inout.o : inout.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 
+iolib.o : iolib.c mem.h lua.h lualib.h 
+lex.o : lex.c tree.h types.h table.h opcode.h lua.h inout.h parser.h ugly.h 
+lua.o : lua.c lua.h lualib.h 
+mathlib.o : mathlib.c lualib.h lua.h 
+mem.o : mem.c mem.h lua.h 
+opcode.o : opcode.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
+  fallback.h 
+strlib.o : strlib.c mem.h lua.h lualib.h 
+table.o : table.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h \
+  fallback.h 
+tree.o : tree.c mem.h lua.h tree.h types.h table.h opcode.h 
+parser.o : parser.c mem.h opcode.h lua.h types.h tree.h hash.h inout.h table.h 

mathlib.c

@@ -1,25 +1,28 @@
 /*
 ** mathlib.c
-** Mathematica library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
+** Mathematics library to LUA
 */
 
+char *rcs_mathlib="$Id: mathlib.c,v 1.8 1995/01/04 18:49:54 roberto Exp $";
+
 #include <stdio.h>		/* NULL */
 #include <math.h>
 
+#include "lualib.h"
 #include "lua.h"
 
+#define PI          3.14159265358979323846
+#define TODEGREE(a) ((a)*180.0/PI)
+#define TORAD(a)    ((a)*PI/180.0)
+
 static void math_abs (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `abs'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `abs'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `abs'"); return; }
+   lua_error ("incorrect arguments to function `abs'");
  d = lua_getnumber(o);
  if (d < 0) d = -d;
  lua_pushnumber (d);
@@ -30,12 +33,12 @@ static void math_sin (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `sin'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `sin'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `sin'"); return; }
+   lua_error ("incorrect arguments to function `sin'");
  d = lua_getnumber(o);
- lua_pushnumber (sin(d));
+ lua_pushnumber (sin(TORAD(d)));
 }
 
 
@@ -44,12 +47,12 @@ static void math_cos (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `cos'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `cos'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `cos'"); return; }
+   lua_error ("incorrect arguments to function `cos'");
  d = lua_getnumber(o);
- lua_pushnumber (cos(d));
+ lua_pushnumber (cos(TORAD(d)));
 }
 
 
@@ -58,12 +61,12 @@ static void math_tan (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `tan'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `tan'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `tan'"); return; }
+   lua_error ("incorrect arguments to function `tan'");
  d = lua_getnumber(o);
- lua_pushnumber (tan(d));
+ lua_pushnumber (tan(TORAD(d)));
 }
 
 
@@ -71,12 +74,12 @@ static void math_asin (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `asin'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `asin'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `asin'"); return; }
+   lua_error ("incorrect arguments to function `asin'");
  d = lua_getnumber(o);
- lua_pushnumber (asin(d));
+ lua_pushnumber (TODEGREE(asin(d)));
 }
 
 
@@ -84,12 +87,12 @@ static void math_acos (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `acos'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `acos'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `acos'"); return; }
+   lua_error ("incorrect arguments to function `acos'");
  d = lua_getnumber(o);
- lua_pushnumber (acos(d));
+ lua_pushnumber (TODEGREE(acos(d)));
 }
 
 
@@ -98,12 +101,12 @@ static void math_atan (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `atan'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `atan'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `atan'"); return; }
+   lua_error ("incorrect arguments to function `atan'");
  d = lua_getnumber(o);
- lua_pushnumber (atan(d));
+ lua_pushnumber (TODEGREE(atan(d)));
 }
 
 
@@ -111,10 +114,10 @@ static void math_ceil (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `ceil'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `ceil'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `ceil'"); return; }
+   lua_error ("incorrect arguments to function `ceil'");
  d = lua_getnumber(o);
  lua_pushnumber (ceil(d));
 }
@@ -124,10 +127,10 @@ static void math_floor (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `floor'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `floor'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `floor'"); return; }
+   lua_error ("incorrect arguments to function `floor'");
  d = lua_getnumber(o);
  lua_pushnumber (floor(d));
 }
@@ -138,7 +141,7 @@ static void math_mod (void)
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
  if (!lua_isnumber(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `mod'"); return; }
+   lua_error ("incorrect arguments to function `mod'");
  d1 = (int) lua_getnumber(o1);
  d2 = (int) lua_getnumber(o2);
  lua_pushnumber (d1%d2);
@@ -149,24 +152,36 @@ static void math_sqrt (void)
 {
  double d;
  lua_Object o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `sqrt'"); return; }
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `sqrt'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `sqrt'"); return; }
+   lua_error ("incorrect arguments to function `sqrt'");
  d = lua_getnumber(o);
  lua_pushnumber (sqrt(d));
 }
 
+static int old_pow;
+
 static void math_pow (void)
 {
- double d1, d2;
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `pow'"); return; }
- d1 = lua_getnumber(o1);
- d2 = lua_getnumber(o2);
- lua_pushnumber (pow(d1,d2));
+ lua_Object op = lua_getparam(3);
+ if (!lua_isnumber(o1) || !lua_isnumber(o2) || *(lua_getstring(op)) != 'p')
+ {
+   lua_Object old = lua_getlocked(old_pow);
+   lua_pushobject(o1);
+   lua_pushobject(o2);
+   lua_pushobject(op);
+   if (lua_callfunction(old) != 0)
+     lua_error(NULL);
+ }
+ else
+ {
+   double d1 = lua_getnumber(o1);
+   double d2 = lua_getnumber(o2);
+   lua_pushnumber (pow(d1,d2));
+ }
 }
 
 static void math_min (void)
@@ -174,15 +189,15 @@ static void math_min (void)
  int i=1;
  double d, dmin;
  lua_Object o;
- if ((o = lua_getparam(i++)) == NULL)
- { lua_error ("too few arguments to function `min'"); return; }
+ if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `min'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `min'"); return; }
+   lua_error ("incorrect arguments to function `min'");
  dmin = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != NULL)
+ while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
  {
   if (!lua_isnumber(o))
-  { lua_error ("incorrect arguments to function `min'"); return; }
+    lua_error ("incorrect arguments to function `min'");
   d = lua_getnumber (o);
   if (d < dmin) dmin = d;
  }
@@ -195,15 +210,15 @@ static void math_max (void)
  int i=1;
  double d, dmax;
  lua_Object o;
- if ((o = lua_getparam(i++)) == NULL)
- { lua_error ("too few arguments to function `max'"); return; }
+ if ((o = lua_getparam(i++)) == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `max'");
  if (!lua_isnumber(o))
- { lua_error ("incorrect arguments to function `max'"); return; }
+   lua_error ("incorrect arguments to function `max'");
  dmax = lua_getnumber (o);
- while ((o = lua_getparam(i++)) != NULL)
+ while ((o = lua_getparam(i++)) != LUA_NOOBJECT)
  {
   if (!lua_isnumber(o))
-  { lua_error ("incorrect arguments to function `max'"); return; }
+    lua_error ("incorrect arguments to function `max'");
   d = lua_getnumber (o);
   if (d > dmax) dmax = d;
  }
@@ -211,6 +226,67 @@ static void math_max (void)
 }
 
 
+static void math_log (void)
+{
+ double d;
+ lua_Object o = lua_getparam (1);
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `log'");
+ if (!lua_isnumber(o))
+   lua_error ("incorrect arguments to function `log'");
+ d = lua_getnumber(o);
+ lua_pushnumber (log(d));
+}
+
+
+static void math_log10 (void)
+{
+ double d;
+ lua_Object o = lua_getparam (1);
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `log10'");
+ if (!lua_isnumber(o))
+   lua_error ("incorrect arguments to function `log10'");
+ d = lua_getnumber(o);
+ lua_pushnumber (log10(d));
+}
+
+
+static void math_exp (void)
+{
+ double d;
+ lua_Object o = lua_getparam (1);
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `exp'");
+ if (!lua_isnumber(o))
+   lua_error ("incorrect arguments to function `exp'");
+ d = lua_getnumber(o);
+ lua_pushnumber (exp(d));
+}
+
+static void math_deg (void)
+{
+ float d;
+ lua_Object o = lua_getparam (1);
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `deg'");
+ if (!lua_isnumber(o))
+   lua_error ("incorrect arguments to function `deg'");
+ d = lua_getnumber(o);
+ lua_pushnumber (d*180./PI);
+}
+
+static void math_rad (void)
+{
+ float d;
+ lua_Object o = lua_getparam (1);
+ if (o == LUA_NOOBJECT)
+   lua_error ("too few arguments to function `rad'");
+ if (!lua_isnumber(o))
+   lua_error ("incorrect arguments to function `rad'");
+ d = lua_getnumber(o);
+ lua_pushnumber (d/180.*PI);
+}
 
 /*
 ** Open math library
@@ -228,7 +304,12 @@ void mathlib_open (void)
  lua_register ("floor", math_floor);
  lua_register ("mod",   math_mod);
  lua_register ("sqrt",  math_sqrt);
- lua_register ("pow",   math_pow);
  lua_register ("min",   math_min);
  lua_register ("max",   math_max);
+ lua_register ("log",   math_log);
+ lua_register ("log10", math_log10);
+ lua_register ("exp",   math_exp);
+ lua_register ("deg",   math_deg);
+ lua_register ("rad",   math_rad);
+ old_pow = lua_lockobject(lua_setfallback("arith", math_pow));
 }

mathlib.h

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

opcode.h

@@ -1,12 +1,15 @@
 /*
-** opcode.h
 ** TeCGraf - PUC-Rio
-** 16 Apr 92
+** $Id: opcode.h,v 3.9 1994/11/23 14:31:11 roberto Stab $
 */
 
 #ifndef opcode_h
 #define opcode_h
 
+#include "lua.h"
+#include "types.h"
+#include "tree.h"
+
 #ifndef STACKGAP
 #define STACKGAP	128
 #endif 
@@ -15,42 +18,48 @@
 #define real float
 #endif
 
-typedef unsigned char  Byte;
+#define FIELDS_PER_FLUSH 40
+
+#define MAX_TEMPS	20
 
-typedef unsigned short Word;
 
 typedef enum 
 { 
- NOP,
  PUSHNIL,
  PUSH0, PUSH1, PUSH2,
  PUSHBYTE,
  PUSHWORD,
  PUSHFLOAT,
  PUSHSTRING,
+ PUSHFUNCTION,
  PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
  PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
  PUSHLOCAL,
  PUSHGLOBAL,
  PUSHINDEXED,
- PUSHMARK,
- PUSHOBJECT,
+ PUSHSELF,
  STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
  STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
  STORELOCAL,
  STOREGLOBAL,
  STOREINDEXED0,
  STOREINDEXED,
- STOREFIELD,
+ STORELIST0,
+ STORELIST,
+ STORERECORD,
+ ADJUST0,
  ADJUST,
  CREATEARRAY,
  EQOP,
  LTOP,
  LEOP,
+ GTOP,
+ GEOP,
  ADDOP,
  SUBOP,
  MULTOP,
  DIVOP,
+ POWOP,
  CONCOP,
  MINUSOP,
  NOTOP,
@@ -62,62 +71,51 @@ typedef enum
  IFFUPJMP,
  POP,
  CALLFUNC,
+ RETCODE0,
  RETCODE,
- HALT,
  SETFUNCTION,
  SETLINE,
  RESET
 } OpCode;
 
-typedef enum
-{
- T_MARK,
- T_NIL,
- T_NUMBER,
- T_STRING,
- T_ARRAY,
- T_FUNCTION,
- T_CFUNCTION,
- T_USERDATA
-} Type; 
+#define MULT_RET	255
+
 
 typedef void (*Cfunction) (void);
 typedef int  (*Input) (void);
-typedef void (*Unput) (int );
 
 typedef union
 {
- Cfunction 	 f;
- real    	 n;
- char      	*s;
- Byte      	*b;
+ Cfunction     f;
+ real          n;
+ TaggedString *ts;
+ Byte         *b;
  struct Hash    *a;
  void           *u;
 } Value;
 
 typedef struct Object
 {
- Type  tag;
+ lua_Type  tag;
  Value value;
 } Object;
 
 typedef struct
 {
- char   *name;
  Object  object;
 } Symbol;
 
 /* Macros to access structure members */
 #define tag(o)		((o)->tag)
 #define nvalue(o)	((o)->value.n)
-#define svalue(o)	((o)->value.s)
+#define svalue(o)	((o)->value.ts->str)
+#define tsvalue(o)	((o)->value.ts)
 #define bvalue(o)	((o)->value.b)
 #define avalue(o)	((o)->value.a)
 #define fvalue(o)	((o)->value.f)
 #define uvalue(o)	((o)->value.u)
 
 /* 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 +125,40 @@ typedef struct
 #define s_fvalue(i)	(fvalue(&s_object(i)))
 #define s_uvalue(i)	(uvalue(&s_object(i)))
 
+typedef union
+{
+ struct {char c1; char c2;} m;
+ Word w;
+} CodeWord;
+#define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ float f;
+} CodeFloat;
+#define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
+                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ Byte *b;
+} CodeCode;
+#define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
+                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
+
 
 /* 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 */
-int     lua_parse      (void); 		/* from "lua.stx" module */
-void    lua_type       (void);
-void 	lua_obj2number (void);
-void 	lua_print      (void);
+void    lua_setinput   (Input fn);	/* from "lex.c" module */
+char   *lua_lasttext   (void);		/* from "lex.c" module */
+int     yylex (void);		        /* from "lex.c" module */
+void    lua_parse      (Byte **code);	/* from "lua.stx" module */
+void    lua_travstack (void (*fn)(Object *));
+Object *luaI_Address (lua_Object o);
+void	luaI_pushobject (Object *o);
+void    luaI_gcFB       (Object *o);
 
 #endif

save.lua

@@ -1,47 +0,0 @@
-$debug
-
-
-function savevar (n,v)
- if v = nil then return end;
- if type(v) = "number" then print(n.."="..v) return end
- if type(v) = "string" then print(n.."='"..v.."'") return end
- if type(v) = "table" then
-   if v.__visited__ ~= nil then
-     print(n .. "=" .. v.__visited__);
-   else
-    print(n.."=@()")
-    v.__visited__ = n;
-    local r,f;
-    r,f = next(v,nil);
-    while r ~= nil do
-      if r ~= "__visited__" then
-        if type(r) = 'string' then
-          savevar(n.."['"..r.."']",f)
-	else
-          savevar(n.."["..r.."]",f)
-	end
-      end
-      r,f = next(v,r)
-    end
-   end
- end
-end
-
-function save ()
-local n,v
-  n,v = nextvar(nil)
-  while n ~= nil do 
-    savevar(n,v); 
-    n,v = nextvar(n)
-  end
-end
-
-a = 3
-x = @{a = 4, b = "name", l=@[4,5,67]}
-
-b = @{t=5}
-x.next = b
-
-
-save()
-

sort.lua

@@ -1,56 +0,0 @@
-$debug
-
-function quicksort(r,s)
-	if s<=r then return end		-- caso basico da recursao
-	local v=x[r]
-	local i=r
-	local j=s+1
-		i=i+1; while x[i]<v do i=i+1 end
-		j=j-1; while x[j]>v do j=j-1 end
-		x[i],x[j]=x[j],x[i]
-	while j>i do			-- separacao
-		i=i+1; while x[i]<v do i=i+1 end
-		j=j-1; while x[j]>v do j=j-1 end
-		x[i],x[j]=x[j],x[i]
-	end
-	x[i],x[j]=x[j],x[i]		-- undo last swap
-	x[j],x[r]=x[r],x[j]
-	quicksort(r,j-1)		-- recursao
-	quicksort(j+1,s)
-end
-
-function sort(a,n)			-- selection sort
- local i=1
- while i<=n do
-  local m=i
-  local j=i+1
-  while j<=n do
-   if a[j]<a[m] then m=j end
-   j=j+1
-  end
- a[i],a[m]=a[m],a[i]			-- swap a[i] and a[m]
- i=i+1
- end
-end
-
-function main()
- x=@()
- n=-1
- n=n+1;	x[n]="a"
- n=n+1;	x[n]="waldemar"
- n=n+1;	x[n]="luiz"
- n=n+1;	x[n]="lula"
- n=n+1;	x[n]="peter"
- n=n+1;	x[n]="raquel"
- n=n+1;	x[n]="camilo"
- n=n+1;	x[n]="andre"
- n=n+1;	x[n]="marcelo"
- n=n+1;	x[n]="sedrez"
- n=n+1;	x[n]="z"
--- quicksort(1,n-1)
- print(x[0]..","..x[1]..","..x[2]..","..x[3]..","..x[4]..","..x[5]..","..x[6]..","..x[7]..","..x[8]..","..x[9]..","..x[10])
- sort (x, n-1)
- print(x[0]..","..x[1]..","..x[2]..","..x[3]..","..x[4]..","..x[5]..","..x[6]..","..x[7]..","..x[8]..","..x[9]..","..x[10])
-end
-
-

strlib.c

@@ -1,36 +1,70 @@
 /*
 ** strlib.c
 ** String library to LUA
-**
-** Waldemar Celes Filho
-** TeCGraf - PUC-Rio
-** 19 May 93
 */
 
-#include <stdlib.h>
+char *rcs_strlib="$Id: strlib.c,v 1.11 1995/02/02 20:05:37 roberto Exp roberto $";
+
 #include <string.h>
+#include <stdlib.h>
 #include <ctype.h>
 
-
 #include "lua.h"
+#include "lualib.h"
+
+
+static char *newstring (lua_Object o)
+{
+  char *s = lua_getstring(o);
+  char *ns = (char *)malloc(strlen(s)+1);
+  if (ns == 0)
+    lua_error("not enough memory for new string");
+  strcpy(ns, s);
+  return ns;
+}
+
 
 /*
 ** Return the position of the first caracter of a substring into a string
 ** LUA interface:
-**			n = strfind (string, substring)
+**			n = strfind (string, substring, init, end)
 */
 static void str_find (void)
 {
- int n;
- char *s1, *s2;
+ char *s1, *s2, *f;
+ int init; 
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
+ lua_Object o3 = lua_getparam (3);
+ lua_Object o4 = lua_getparam (4);
  if (!lua_isstring(o1) || !lua_isstring(o2))
- { lua_error ("incorrect arguments to function `strfind'"); return; }
+   lua_error ("incorrect arguments to function `strfind'");
+ if (o3 == LUA_NOOBJECT)
+  init = 0;
+ else if (lua_isnumber(o3))
+  init = lua_getnumber(o3)-1;
+ else
+ {
+   lua_error ("incorrect arguments to function `strfind'");
+   return;  /* to avoid warnings */
+ }
  s1 = lua_getstring(o1);
  s2 = lua_getstring(o2);
- n = strstr(s1,s2) - s1 + 1;
- lua_pushnumber (n);
+ f = strstr(s1+init,s2);
+ if (f != NULL)
+ {
+  int pos = f-s1+1;
+  if (o4 == LUA_NOOBJECT)
+   lua_pushnumber (pos);
+  else if (!lua_isnumber(o4))
+   lua_error ("incorrect arguments to function `strfind'");
+  else if ((int)lua_getnumber(o4) >= pos+strlen(s2)-1)
+   lua_pushnumber (pos);
+  else
+   lua_pushnil();
+ }
+ else
+  lua_pushnil();
 }
 
 /*
@@ -42,7 +76,7 @@ static void str_len (void)
 {
  lua_Object o = lua_getparam (1);
  if (!lua_isstring(o))
- { lua_error ("incorrect arguments to function `strlen'"); return; }
+   lua_error ("incorrect arguments to function `strlen'");
  lua_pushnumber(strlen(lua_getstring(o)));
 }
 
@@ -59,19 +93,21 @@ 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))
- { lua_error ("incorrect arguments to function `strsub'"); return; }
- s = strdup (lua_getstring(o1));
+ if (!lua_isstring(o1) || !lua_isnumber(o2))
+   lua_error ("incorrect arguments to function `strsub'");
+ if (o3 != LUA_NOOBJECT && !lua_isnumber(o3))
+   lua_error ("incorrect third argument to function `strsub'");
+ s = newstring(o1);
  start = lua_getnumber (o2);
- end = lua_getnumber (o3);
+ end = o3 == LUA_NOOBJECT ? strlen(s) : lua_getnumber (o3);
  if (end < start || start < 1 || end > strlen(s))
-  lua_pushstring ("");
+  lua_pushliteral("");
  else
  {
   s[end] = 0;
   lua_pushstring (&s[start-1]);
  }
- free (s);
+ free(s);
 }
 
 /*
@@ -84,8 +120,8 @@ static void str_lower (void)
  char *s, *c;
  lua_Object o = lua_getparam (1);
  if (!lua_isstring(o))
- { lua_error ("incorrect arguments to function `strlower'"); return; }
- c = s = strdup(lua_getstring(o));
+   lua_error ("incorrect arguments to function `strlower'");
+ c = s = newstring(o);
  while (*c != 0)
  {
   *c = tolower(*c);
@@ -106,8 +142,8 @@ static void str_upper (void)
  char *s, *c;
  lua_Object o = lua_getparam (1);
  if (!lua_isstring(o))
- { lua_error ("incorrect arguments to function `strlower'"); return; }
- c = s = strdup(lua_getstring(o));
+   lua_error ("incorrect arguments to function `strlower'");
+ c = s = newstring(o);
  while (*c != 0)
  {
   *c = toupper(*c);

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,157 @@
 /*
 ** table.c
 ** Module to control static tables
-** TeCGraf - PUC-Rio
-** 11 May 93
 */
 
-#include <stdlib.h>
+char *rcs_table="$Id: table.c,v 2.27 1995/01/13 22:11:12 roberto Exp celes $";
+
 #include <string.h>
 
+#include "mem.h"
 #include "opcode.h"
+#include "tree.h"
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
 #include "lua.h"
+#include "fallback.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==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 Long lua_maxsymbol = 0;
+
+TaggedString **lua_constant;
+static Word lua_nconstant = 0;
+static Long 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;
 
+#define GARBAGE_BLOCK 256
+#define MIN_GARBAGE_BLOCK 10
+
+static void lua_nextvar (void);
+static void setglobal (void);
+static void getglobal (void);
+
+/*
+** Initialise symbol table with internal functions
+*/
+static void lua_initsymbol (void)
+{
+ Word n;
+ lua_maxsymbol = BUFFER_BLOCK;
+ lua_table = newvector(lua_maxsymbol, Symbol);
+ n = luaI_findsymbolbyname("next");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
+ n = luaI_findsymbolbyname("dofile");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
+ n = luaI_findsymbolbyname("setglobal");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = setglobal;
+ n = luaI_findsymbolbyname("getglobal");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = getglobal;
+ n = luaI_findsymbolbyname("nextvar");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
+ n = luaI_findsymbolbyname("type"); 
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
+ n = luaI_findsymbolbyname("tonumber");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
+ n = luaI_findsymbolbyname("print");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
+ n = luaI_findsymbolbyname("dostring");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
+ n = luaI_findsymbolbyname("setfallback");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
+ n = luaI_findsymbolbyname("error");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
+}
+
+
+/*
+** Initialise constant table with pre-defined constants
+*/
+void lua_initconstant (void)
+{
+ lua_maxconstant = BUFFER_BLOCK;
+ lua_constant = newvector(lua_maxconstant, TaggedString *);
+}
+
 
 /*
 ** 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.
+*/
+Word luaI_findsymbol (TreeNode *t)
+{
+ if (lua_table == NULL)
+  lua_initsymbol(); 
+ if (t->varindex == NOT_USED)
+ {
+  if (lua_ntable == lua_maxsymbol)
+  {
+   if (lua_maxsymbol >= MAX_WORD)
+     lua_error("symbol table overflow");
+   lua_maxsymbol *= 2;
+   if (lua_maxsymbol >= MAX_WORD)
+     lua_maxsymbol = MAX_WORD; 
+   lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
+  }
+  t->varindex = lua_ntable;
+  s_tag(lua_ntable) = LUA_T_NIL;
+  lua_ntable++;
+ }
+ return t->varindex;
+}
+
+
+Word luaI_findsymbolbyname (char *name)
+{
+  return luaI_findsymbol(lua_constcreate(name));
+}
+
+
+/*
+** Given a name, search it at constant table and return its index. If not
+** found, allocate it.
 ** On error, return -1.
 */
-int lua_findsymbol (char *s)
+Word luaI_findconstant (TreeNode *t)
 {
- int i;
+ if (lua_constant == NULL)
+  lua_initconstant();
+ if (t->constindex == NOT_USED)
+ {
+  if (lua_nconstant == lua_maxconstant)
+  {
+   if (lua_maxconstant >= MAX_WORD)
+     lua_error("constant table overflow");
+   lua_maxconstant *= 2;
+   if (lua_maxconstant >= MAX_WORD)
+     lua_maxconstant = MAX_WORD;
+   lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
+  }
+  t->constindex = lua_nconstant;
+  lua_constant[lua_nconstant] = &(t->ts);
+  lua_nconstant++;
+ }
+ return t->constindex;
+}
+
+
+/*
+** Traverse symbol table objects
+*/
+void lua_travsymbol (void (*fn)(Object *))
+{
+ Word i;
  for (i=0; i<lua_ntable; i++)
-  if (streq(s,s_name(i)))
-   return i;
- if (lua_ntable >= MAXSYMBOL-1)
- {
-  lua_error ("symbol table overflow");
-  return -1;
- }
- s_name(lua_ntable) = strdup(s);
- if (s_name(lua_ntable) == NULL)
- {
-  lua_error ("not enough memory");
-  return -1;
- }
- s_tag(lua_ntable++) = T_NIL;
- 
- return (lua_ntable-1);
-}
-
-/*
-** Given a constant string, eliminate its delimeters (" or '), search it at 
-** constant table and return its index. If not found, allocate at end of 
-** the table, checking oveflow and return its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
-*/
-int lua_findenclosedconstant (char *s)
-{
- int i, j, l=strlen(s);
- char *c = calloc (l, sizeof(char)); 	/* make a copy */
- 
- c++;		/* create mark space */
-
- /* introduce scape characters */ 
- for (i=1,j=0; i<l-1; i++)
- {
-  if (s[i] == '\\')
-  {
-   switch (s[++i])
-   {
-    case 'n': c[j++] = '\n'; break;
-    case 't': c[j++] = '\t'; break;
-    case 'r': c[j++] = '\r'; break;
-    default : c[j++] = '\\'; c[j++] = c[i]; break;
-   }
-  }
-  else
-   c[j++] = s[i];
- }
- c[j++] = 0;
- 
- for (i=0; i<lua_nconstant; i++)
-  if (streq(c,lua_constant[i]))
-  {
-   free (c-1);
-   return i;
-  }
- if (lua_nconstant >= MAXCONSTANT-1)
- {
-  lua_error ("lua: constant string table overflow"); 
-  return -1;
- }
- lua_constant[lua_nconstant++] = c;
- return (lua_nconstant-1);
-}
-
-/*
-** Given a constant string, search it at constant table and return its index.
-** If not found, allocate at end of the table, checking oveflow and return 
-** its index.
-**
-** For each allocation, the function allocate a extra char to be used to
-** mark used string (it's necessary to deal with constant and string 
-** uniformily). The function store at the table the second position allocated,
-** that represents the beginning of the real string. On error, return -1.
-** 
-*/
-int lua_findconstant (char *s)
-{
- int i;
- for (i=0; i<lua_nconstant; i++)
-  if (streq(s,lua_constant[i]))
-   return i;
- if (lua_nconstant >= MAXCONSTANT-1)
- {
-  lua_error ("lua: constant string table overflow"); 
-  return -1;
- }
- {
-  char *c = calloc(strlen(s)+2,sizeof(char));
-  c++;		/* create mark space */
-  lua_constant[lua_nconstant++] = strcpy(c,s);
- }
- return (lua_nconstant-1);
+  fn(&s_object(i));
 }
 
 
@@ -172,126 +160,55 @@ 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)
+ if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
+   tsvalue(o)->marked = 1;
+ else if (tag(o) == LUA_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));
+  static Long block = GARBAGE_BLOCK; /* when garbage collector will be called */
+  static Long nentity = 0;  /* counter of new entities (strings and arrays) */
+  Long recovered = 0;
+  if (nentity++ < block) return;
+  lua_travstack(lua_markobject); /* mark stack objects */
+  lua_travsymbol(lua_markobject); /* mark symbol table objects */
+  luaI_travlock(lua_markobject); /* mark locked objects */
+  recovered += lua_strcollector();
+  recovered += lua_hashcollector();
+  nentity = 0;				/* reset counter */
+  block=(16*block-7*recovered)/12;	/* adapt block size */
+  if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
 } 
 
-/*
-** Simulate a garbage colection. When string table or array table overflows,
-** this function check if all allocated strings and arrays are in use. If
-** there are unused ones, pack (compress) the tables.
-*/
-static void lua_pack (void)
-{
- lua_markstack ();
- lua_marktable ();
- 
- { /* pack string */
-  int i, j;
-  for (i=j=0; i<lua_nstring; i++)
-   if (lua_markstring(lua_string[i]) == 1)
-   {
-    lua_string[j++] = lua_string[i];
-    lua_markstring(lua_string[i]) = 0;
-   }
-   else
-   {
-    free (lua_string[i]-1);
-   }
-  lua_nstring = j;
- }
-
- { /* pack array */
-  int i, j;
-  for (i=j=0; i<lua_narray; i++)
-   if (markarray(lua_array[i]) == 1)
-   {
-    lua_array[j++] = lua_array[i];
-    markarray(lua_array[i]) = 0;
-   }
-   else
-   {
-    lua_hashdelete (lua_array[i]);
-   }
-  lua_narray = j;
- }
-}
-
-/*
-** Allocate a new string at string table. The given string is already 
-** allocated with mark space and the function puts it at the end of the
-** table, checking overflow, and returns its own pointer, or NULL on error.
-*/
-char *lua_createstring (char *s)
-{
- if (s == NULL) return NULL;
- 
- if (lua_nstring >= MAXSTRING-1)
- {
-  lua_pack ();
-  if (lua_nstring >= MAXSTRING-1)
-  {
-   lua_error ("string table overflow");
-   return NULL;
-  }
- } 
- lua_string[lua_nstring++] = s;
- return s;
-}
-
-/*
-** Allocate a new array, already created, at array table. The function puts 
-** it at the end of the table, checking overflow, and returns its own pointer,
-** or NULL on error.
-*/
-void *lua_createarray (void *a)
-{
- if (a == NULL) return NULL;
- 
- if (lua_narray >= MAXARRAY-1)
- {
-  lua_pack ();
-  if (lua_narray >= MAXARRAY-1)
-  {
-   lua_error ("indexed table overflow");
-   return NULL;
-  }
- } 
- lua_array[lua_narray++] = a;
- return a;
-}
-
 
 /*
 ** Add a file name at file table, checking overflow. This function also set
 ** the external variable "lua_filename" with the function filename set.
-** Return 0 on success or 1 on error.
+** Return 0 on success or error message on error.
 */
-int lua_addfile (char *fn)
+char *lua_addfile (char *fn)
 {
- if (lua_nfile >= MAXFILE-1)
- {
-  lua_error ("too many files");
-  return 1;
- }
- if ((lua_file[lua_nfile++] = strdup (fn)) == NULL)
- {
-  lua_error ("not enough memory");
-  return 1;
- }
- return 0;
+ if (lua_nfile >= MAXFILE)
+   return "too many files";
+ if ((lua_file[lua_nfile++] = luaI_strdup (fn)) == NULL)
+   return "not enough memory";
+ return NULL;
+}
+
+/*
+** Delete a file from file stack
+*/
+int lua_delfile (void)
+{
+ luaI_free(lua_file[--lua_nfile]); 
+ return 1;
 }
 
 /*
@@ -305,47 +222,56 @@ char *lua_filename (void)
 /*
 ** Internal function: return next global variable
 */
-void lua_nextvar (void)
+static void lua_nextvar (void)
 {
- int index;
- Object *o = lua_getparam (1);
- if (o == NULL)
- { lua_error ("too few arguments to function `nextvar'"); return; }
- if (lua_getparam (2) != NULL)
- { lua_error ("too many arguments to function `nextvar'"); return; }
- if (tag(o) == T_NIL)
+ char *varname;
+ TreeNode *next;
+ lua_Object o = lua_getparam(1);
+ if (o == LUA_NOOBJECT)
+   lua_reportbug("too few arguments to function `nextvar'");
+ if (lua_getparam(2) != LUA_NOOBJECT)
+   lua_reportbug("too many arguments to function `nextvar'");
+ if (lua_isnil(o))
+   varname = NULL;
+ else if (!lua_isstring(o))
  {
-  index = 0;
+   lua_reportbug("incorrect argument to function `nextvar'"); 
+   return;  /* to avoid warnings */
  }
- else if (tag(o) != T_STRING) 
- { 
-  lua_error ("incorrect argument to function `nextvar'"); 
-  return;
+ else
+   varname = lua_getstring(o);
+ next = lua_varnext(varname);
+ if (next == NULL)
+ {
+  lua_pushnil();
+  lua_pushnil();
  }
  else
- {
-  for (index=0; index<lua_ntable; index++)
-   if (streq(s_name(index),svalue(o))) break;
-  if (index == lua_ntable) 
-  {
-   lua_error ("name not found in function `nextvar'");
-   return;
-  }
-  index++;
-  while (index < lua_ntable-1 && tag(&s_object(index)) == T_NIL) index++;
-  
-  if (index == lua_ntable-1)
-  {
-   lua_pushnil();
-   lua_pushnil();
-   return;
-  }
- }
  {
   Object name;
-  tag(&name) = T_STRING;
-  svalue(&name) = lua_createstring(lua_strdup(s_name(index)));
-  if (lua_pushobject (&name)) return;
-  if (lua_pushobject (&s_object(index))) return;
+  tag(&name) = LUA_T_STRING;
+  tsvalue(&name) = &(next->ts);
+  luaI_pushobject(&name);
+  luaI_pushobject(&s_object(next->varindex));
  }
 }
+
+
+static void setglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  lua_Object value = lua_getparam(2);
+  if (!lua_isstring(name))
+    lua_reportbug("incorrect argument to function `setglobal'");
+  lua_pushobject(value);
+  lua_storeglobal(lua_getstring(name));
+}
+
+
+static void getglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  if (!lua_isstring(name))
+    lua_reportbug("incorrect argument to function `getglobal'");
+  lua_pushobject(lua_getglobal(lua_getstring(name)));
+}

table.h

@@ -1,39 +1,31 @@
 /*
-** table.c
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** 11 May 93
+** $Id: table.h,v 2.9 1994/11/23 14:31:11 roberto Stab roberto $
 */
 
 #ifndef table_h
 #define table_h
 
+#include "tree.h"
+#include "opcode.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 TaggedString **lua_constant;
 
 extern char   *lua_file[];
 extern int     lua_nfile;
 
-#define lua_markstring(s)	(*((s)-1))
 
-
-int   lua_findsymbol           (char *s);
-int   lua_findenclosedconstant (char *s);
-int   lua_findconstant         (char *s);
-void  lua_markobject           (Object *o);
-char *lua_createstring         (char *s);
-void *lua_createarray          (void *a);
-int   lua_addfile              (char *fn);
-char *lua_filename             (void);
-void  lua_nextvar              (void);
+void  lua_initconstant (void);
+Word  luaI_findsymbolbyname (char *name);
+Word  luaI_findsymbol      (TreeNode *t);
+Word  luaI_findconstant    (TreeNode *t);
+void  lua_travsymbol      (void (*fn)(Object *));
+void  lua_markobject      (Object *o);
+void  lua_pack            (void);
+char *lua_addfile         (char *fn);
+int   lua_delfile 	  (void);
+char *lua_filename        (void);
 
 #endif

test.lua

@@ -1,15 +0,0 @@
-$debug
-
-
-function somaP (x1,y1,x2,y2)
-  return x1+x2, y1+y2
-end
-
-function norma (x,y)
-  return x*x+y*y
-end
-
-function retorno_multiplo ()
- print (norma(somaP(2,3,4,5)))
-end
-

tree.c

@@ -0,0 +1,141 @@
+/*
+** tree.c
+** TecCGraf - PUC-Rio
+*/
+ 
+char *rcs_tree="$Id: tree.c,v 1.12 1994/12/20 21:20:36 roberto Exp roberto $";
+
+
+#include <string.h>
+
+#include "mem.h"
+#include "lua.h"
+#include "tree.h"
+#include "table.h"
+
+
+#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b))) 
+
+
+typedef struct StringNode {
+  struct StringNode *next;
+  TaggedString ts;
+} StringNode;
+
+static StringNode *string_root = NULL;
+
+static TreeNode *constant_root = NULL;
+
+/*
+** Insert a new constant/variable at the tree. 
+*/
+static TreeNode *tree_create (TreeNode **node, char *str)
+{
+ if (*node == NULL)
+ {
+  *node = (TreeNode *) luaI_malloc(sizeof(TreeNode)+strlen(str));
+  (*node)->left = (*node)->right = NULL;
+  strcpy((*node)->ts.str, str);
+  (*node)->ts.marked = 0;
+  (*node)->ts.hash = 0;
+  (*node)->varindex = (*node)->constindex = NOT_USED;
+  return *node;
+ }
+ else
+ {
+  int c = lua_strcmp(str, (*node)->ts.str);
+  if (c < 0) 
+   return tree_create(&(*node)->left, str);
+  else if (c > 0)
+   return tree_create(&(*node)->right, str);
+  else
+   return *node;
+ }
+}
+
+TaggedString *lua_createstring (char *str) 
+{
+  StringNode *newString;
+  if (str == NULL) return NULL;
+  lua_pack();
+  newString = (StringNode *)luaI_malloc(sizeof(StringNode)+strlen(str));
+  newString->ts.marked = 0;
+  newString->ts.hash = 0;
+  strcpy(newString->ts.str, str);
+  newString->next = string_root;
+  string_root = newString;
+  return &(newString->ts);
+}
+
+
+TreeNode *lua_constcreate (char *str) 
+{
+ return tree_create(&constant_root, str);
+}
+
+
+/*
+** Garbage collection function.
+** This function traverse the string list freeing unindexed strings
+*/
+Long lua_strcollector (void)
+{
+  StringNode *curr = string_root, *prev = NULL;
+  Long counter = 0;
+  while (curr)
+  {
+    StringNode *next = curr->next;
+    if (!curr->ts.marked)
+    {
+      if (prev == NULL) string_root = next;
+      else prev->next = next;
+      luaI_free(curr);
+      ++counter;
+    }
+    else
+    {
+      curr->ts.marked = 0;
+      prev = curr;
+    }
+    curr = next;
+  }
+  return counter;
+}
+
+/*
+** Return next variable.
+*/
+static TreeNode *tree_next (TreeNode *node, char *str)
+{
+ if (node == NULL) return NULL;
+ else if (str == NULL) return node;
+ else
+ {
+  int c = lua_strcmp(str, node->ts.str);
+  if (c == 0)
+   return node->left != NULL ? node->left : node->right;
+  else if (c < 0)
+  {
+   TreeNode *result = tree_next(node->left, str);
+   return result != NULL ? result : node->right;
+  }
+  else
+   return tree_next(node->right, str);
+ }
+}
+
+TreeNode *lua_varnext (char *n)
+{
+  TreeNode *result;
+  char *name = n;
+  while (1)
+  { /* repeat until a valid (non nil) variable */
+    result = tree_next(constant_root, name);
+    if (result == NULL) return NULL;
+    if (result->varindex != NOT_USED &&
+        s_tag(result->varindex) != LUA_T_NIL)
+      return result;
+    name = result->ts.str;
+  }
+}
+

tree.h

@@ -0,0 +1,37 @@
+/*
+** tree.h
+** TecCGraf - PUC-Rio
+** $Id: tree.h,v 1.8 1994/12/20 21:20:36 roberto Exp roberto $
+*/
+
+#ifndef tree_h
+#define tree_h
+
+#include "types.h"
+
+#define NOT_USED  0xFFFE
+
+
+typedef struct TaggedString
+{
+  unsigned long hash;  /* 0 if not initialized */
+  char marked;   /* for garbage collection */
+  char str[1];   /* \0 byte already reserved */
+} TaggedString;
+ 
+typedef struct TreeNode
+{
+ struct TreeNode *right;
+ struct TreeNode *left;
+ unsigned short varindex;  /* != NOT_USED  if this is a symbol */
+ unsigned short constindex;  /* != NOT_USED  if this is a constant */
+ TaggedString ts;
+} TreeNode;
+
+
+TaggedString *lua_createstring (char *str);
+TreeNode *lua_constcreate  (char *str);
+Long lua_strcollector (void);
+TreeNode *lua_varnext      (char *n);
+
+#endif

type.lua

@@ -1,35 +0,0 @@
-$debug
-
-function check (object, class)
- local v = next(object,nil);
- while v ~= nil do
-   if class[v] = nil then print("unknown field: " .. v) 
-   elseif type(object[v]) ~= class[v].type  
-     then print("wrong type for field " .. v)
-   end
-   v = next(object,v);
- end
- v = next(class,nil);
- while v ~= nil do
-   if object[v] = nil then
-     if class[v].default ~= nil then
-       object[v] = class[v].default
-     else print("field "..v.." not initialized")
-     end
-   end
-   v = next(class,v);
- end
-end
-
-typetrilha = @{x = @{default = 0, type = "number"},
-               y = @{default = 0, type = "number"},
-               name = @{type = "string"}
-              }
-
-function trilha (t)  check(t,typetrilha) end
-
-t1 = @trilha{ x = 4, name = "3"}
-
-a = "na".."me"
-
-

types.h

@@ -0,0 +1,31 @@
+/*
+** TeCGraf - PUC-Rio
+** $Id: types.h,v 1.2 1994/12/27 20:41:47 celes Exp roberto $
+*/
+
+#ifndef types_h
+#define types_h
+
+#include <limits.h>
+
+#ifndef real
+#define real float
+#endif
+
+typedef int Bool;  /* boolean values */
+
+#define Byte lua_Byte	/* some systems have Byte as a predefined type */
+typedef unsigned char  Byte;  /* unsigned 8 bits */
+
+#define Word lua_Word	/* some systems have Word as a predefined type */
+typedef unsigned short Word;  /* unsigned 16 bits */
+
+#define MAX_WORD  (USHRT_MAX-2)  /* maximum value of a word (-2 for safety) */
+#define MAX_INT   (INT_MAX-2)  /* maximum value of a int (-2 for safety) */
+
+#define Long lua_Long	/* some systems have Long as a predefined type */
+typedef signed long  Long;  /* 32 bits */
+
+typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
+
+#endif

ugly.h

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

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