Browse Source

oldest known commit

The Lua team 32 years ago
commit
cd05d9c5cb
17 changed files with 5459 additions and 0 deletions
  1. 259 0
      hash.c
  2. 35 0
      hash.h
  3. 188 0
      inout.c
  4. 24 0
      inout.h
  5. 401 0
      iolib.c
  6. 923 0
      lex_yy.c
  7. 54 0
      lua.c
  8. 54 0
      lua.h
  9. 15 0
      lualib.h
  10. 234 0
      mathlib.c
  11. 933 0
      opcode.c
  12. 144 0
      opcode.h
  13. 131 0
      strlib.c
  14. 351 0
      table.c
  15. 39 0
      table.h
  16. 1639 0
      y_tab.c
  17. 35 0
      y_tab.h

+ 259 - 0
hash.c

@@ -0,0 +1,259 @@
+/*
+** 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>
+
+#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 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))
+
+static int head (Hash *t, Object *ref)		/* hash function */
+{
+ if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
+ else if (tag(ref) == T_STRING)
+ {
+  int h;
+  char *name = svalue(ref);
+  for (h=0; *name!=0; name++)		/* interpret name as binary number */
+  {
+   h <<= 8;
+   h  += (unsigned char) *name;		/* avoid sign extension */
+   h  %= nhash(t);			/* make it a valid index */
+  }
+  return h;
+ }
+ else
+ {
+  lua_reportbug ("unexpected type to index table");
+  return -1;
+ }
+}
+
+static Node *present(Hash *t, Object *ref, int h)
+{
+ 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;
+}
+
+static void freelist (Node *n)
+{
+ while (n)
+ {
+  Node *next = n->next;
+  free (n);
+  n = next;
+ }
+}
+
+/*
+** Create a new hash. Return the hash pointer or NULL on error.
+*/
+Hash *lua_hashcreate (unsigned int nhash)
+{
+ Hash *t = new (Hash);
+ if (t == NULL)
+ {
+  lua_error ("not enough memory");
+  return NULL;
+ }
+ nhash(t) = nhash;
+ 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)
+{
+ int i;
+ for (i=0; i<nhash(h); i++)
+  freelist (list(h,i));
+ free (nodelist(h));
+ free(h);
+}
+
+/*
+** 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++)
+ {
+  Node *n;
+  for (n = list(h,i); n != NULL; n = n->next)
+  {
+   lua_markobject (&n->ref);
+   lua_markobject (&n->val);
+  }
+ }
+}
+
+
+/*
+** Internal function to manipulate arrays. 
+** Given an array object and a reference value, return the next element
+** in the hash.
+** This function pushs the element value and its reference to the stack.
+*/
+#include "lua.h"
+static void firstnode (Hash *a, int h)
+{
+ if (h < nhash(a))
+ {  
+  int i;
+  for (i=h; i<nhash(a); i++)
+  {
+   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();
+}
+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)
+ {
+  firstnode (a, 0);
+  return;
+ }
+ 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");
+  }
+ }
+}

+ 35 - 0
hash.h

@@ -0,0 +1,35 @@
+/*
+** hash.h
+** hash manager for lua
+** Luiz Henrique de Figueiredo - 17 Aug 90
+** Modified by Waldemar Celes Filho
+** 26 Apr 93
+*/
+
+#ifndef hash_h
+#define hash_h
+
+typedef struct node
+{
+ Object ref;
+ Object val;
+ struct node *next;
+} Node;
+
+typedef struct Hash
+{
+ char           mark;
+ unsigned int   nhash;
+ Node         **list;
+} Hash;
+
+#define markarray(t)		((t)->mark)
+
+Hash 	*lua_hashcreate (unsigned int nhash);
+void 	 lua_hashdelete (Hash *h);
+Object 	*lua_hashdefine (Hash *t, Object *ref);
+void 	 lua_hashmark   (Hash *h);
+
+void     lua_next (void);
+
+#endif

+ 188 - 0
inout.c

@@ -0,0 +1,188 @@
+/*
+** inout.c
+** Provide function to realise the input/output function and debugger 
+** facilities.
+**
+** Waldemar Celes Filho
+** TeCGraf - PUC-Rio
+** 11 May 93
+*/
+
+#include <stdio.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+
+/* Exported variables */
+int lua_linenumber;
+int lua_debug;
+int lua_debugline;
+
+/* Internal variables */
+#ifndef MAXFUNCSTACK
+#define MAXFUNCSTACK 32
+#endif
+static struct { int file; int function; } funcstack[MAXFUNCSTACK];
+static int 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);
+}
+
+/*
+** Function to get the next character from the input string
+*/
+static int stringinput (void)
+{
+ st++;
+ return (*(st-1));
+}
+
+/*
+** Function to unget the next character from to input string
+*/
+static void stringunput (int c)
+{
+ st--;
+}
+
+/*
+** Function to open a file to be input unit. 
+** Return 0 on success or 1 on error.
+*/
+int lua_openfile (char *fn)
+{
+ lua_linenumber = 1;
+ lua_setinput (fileinput);
+ lua_setunput (fileunput);
+ fp = fopen (fn, "r");
+ if (fp == NULL) return 1;
+ if (lua_addfile (fn)) return 1;
+ return 0;
+}
+
+/*
+** Function to close an opened file
+*/
+void lua_closefile (void)
+{
+ if (fp != NULL)
+ {
+  fclose (fp);
+  fp = NULL;
+ }
+}
+
+/*
+** Function to open a string to be input unit
+*/
+int 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 0;
+}
+
+/*
+** Call user function to handle error messages, if registred. Or report error
+** using standard function (fprintf).
+*/
+void lua_error (char *s)
+{
+ if (usererror != NULL) usererror (s);
+ else			    fprintf (stderr, "lua: %s\n", s);
+}
+
+/*
+** Called to execute  SETFUNCTION opcode, this function pushs a function into
+** function stack. Return 0 on success or 1 on error.
+*/
+int lua_pushfunction (int file, int function)
+{
+ if (nfuncstack >= MAXFUNCSTACK-1)
+ {
+  lua_error ("function stack overflow");
+  return 1;
+ }
+ funcstack[nfuncstack].file = file;
+ funcstack[nfuncstack].function = function;
+ nfuncstack++;
+ return 0;
+}
+
+/*
+** Called to execute  RESET opcode, this function pops a function from 
+** function stack.
+*/
+void lua_popfunction (void)
+{
+ nfuncstack--;
+}
+
+/*
+** Report bug building a message and sending it to lua_error function.
+*/
+void lua_reportbug (char *s)
+{
+ char msg[1024];
+ strcpy (msg, s);
+ if (lua_debugline != 0)
+ {
+  int i;
+  if (nfuncstack > 0)
+  {
+   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]);
+  }
+  else
+  {
+   sprintf (strchr(msg,0),
+         "\n\tin statement begining at line %d of file \"%s\"", 
+         lua_debugline, lua_filename());
+  }
+ }
+ lua_error (msg);
+}
+

+ 24 - 0
inout.h

@@ -0,0 +1,24 @@
+/*
+** inout.h
+**
+** Waldemar Celes Filho
+** TeCGraf - PUC-Rio
+** 11 May 93
+*/
+
+
+#ifndef inout_h
+#define inout_h
+
+extern int lua_linenumber;
+extern int lua_debug;
+extern int lua_debugline;
+
+int  lua_openfile     (char *fn);
+void lua_closefile    (void);
+int  lua_openstring   (char *s);
+int  lua_pushfunction (int file, int function);
+void lua_popfunction  (void);
+void lua_reportbug    (char *s);
+
+#endif

+ 401 - 0
iolib.c

@@ -0,0 +1,401 @@
+/*
+** 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=stdin, *out=stdout;
+
+/*
+** 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)
+{
+ 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);
+}

+ 923 - 0
lex_yy.c

@@ -0,0 +1,923 @@
+# 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);
+	}

+ 54 - 0
lua.c

@@ -0,0 +1,54 @@
+/*
+** 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));
+}
+
+void main (int argc, char *argv[])
+{
+ int i;
+ if (argc < 2)
+ {
+  puts ("usage: lua filename [functionnames]");
+  return;
+ }
+ lua_register ("callfunc", callfunc);
+ lua_register ("execstr", execstr);
+ lua_register ("test", test);
+ iolib_open ();
+ strlib_open ();
+ mathlib_open ();
+ lua_dofile (argv[1]);
+ for (i=2; i<argc; i++)
+ {
+  lua_call (argv[i],0);
+ }
+}
+
+

+ 54 - 0
lua.h

@@ -0,0 +1,54 @@
+/*
+** LUA - Linguagem para Usuarios de Aplicacao
+** Grupo de Tecnologia em Computacao Grafica
+** TeCGraf - PUC-Rio
+** 19 May 93
+*/
+
+
+#ifndef lua_h
+#define lua_h
+
+typedef void (*lua_CFunction) (void);
+typedef struct Object *lua_Object;
+
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+
+
+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);
+
+lua_Object     lua_getparam 		(int number);
+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);
+lua_Object     lua_getglobal 		(char *name);
+
+lua_Object     lua_pop 			(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_storeglobal		(char *name);
+int            lua_storefield		(lua_Object object, char *field);
+int            lua_storeindexed		(lua_Object object, float index);
+
+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);
+
+#endif

+ 15 - 0
lualib.h

@@ -0,0 +1,15 @@
+/*
+** Libraries to use in LUA programs
+** Grupo de Tecnologia em Computacao Grafica
+** TeCGraf - PUC-Rio
+** 19 May 93
+*/
+
+#ifndef lualib_h
+#define lualib_h
+
+void iolib_open   (void);
+void strlib_open  (void);
+void mathlib_open (void);
+
+#endif

+ 234 - 0
mathlib.c

@@ -0,0 +1,234 @@
+/*
+** mathlib.c
+** Mathematica library to LUA
+**
+** Waldemar Celes Filho
+** TeCGraf - PUC-Rio
+** 19 May 93
+*/
+
+#include <stdio.h>		/* NULL */
+#include <math.h>
+
+#include "lua.h"
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `abs'"); return; }
+ d = lua_getnumber(o);
+ if (d < 0) d = -d;
+ lua_pushnumber (d);
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `sin'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (sin(d));
+}
+
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `cos'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (cos(d));
+}
+
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `tan'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (tan(d));
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `asin'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (asin(d));
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `acos'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (acos(d));
+}
+
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `atan'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (atan(d));
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `ceil'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (ceil(d));
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `floor'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (floor(d));
+}
+
+static void math_mod (void)
+{
+ int d1, d2;
+ lua_Object o1 = lua_getparam (1);
+ lua_Object o2 = lua_getparam (2);
+ if (!lua_isnumber(o1) || !lua_isnumber(o2))
+ { lua_error ("incorrect arguments to function `mod'"); return; }
+ d1 = (int) lua_getnumber(o1);
+ d2 = (int) lua_getnumber(o2);
+ lua_pushnumber (d1%d2);
+}
+
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `sqrt'"); return; }
+ d = lua_getnumber(o);
+ lua_pushnumber (sqrt(d));
+}
+
+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));
+}
+
+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 (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `min'"); return; }
+ dmin = lua_getnumber (o);
+ while ((o = lua_getparam(i++)) != NULL)
+ {
+  if (!lua_isnumber(o))
+  { lua_error ("incorrect arguments to function `min'"); return; }
+  d = lua_getnumber (o);
+  if (d < dmin) dmin = d;
+ }
+ lua_pushnumber (dmin);
+}
+
+
+static void math_max (void)
+{
+ int i=1;
+ double d, dmax;
+ lua_Object o;
+ if ((o = lua_getparam(i++)) == NULL)
+ { lua_error ("too few arguments to function `max'"); return; }
+ if (!lua_isnumber(o))
+ { lua_error ("incorrect arguments to function `max'"); return; }
+ dmax = lua_getnumber (o);
+ while ((o = lua_getparam(i++)) != NULL)
+ {
+  if (!lua_isnumber(o))
+  { lua_error ("incorrect arguments to function `max'"); return; }
+  d = lua_getnumber (o);
+  if (d > dmax) dmax = d;
+ }
+ lua_pushnumber (dmax);
+}
+
+
+
+/*
+** Open math library
+*/
+void mathlib_open (void)
+{
+ lua_register ("abs",   math_abs);
+ lua_register ("sin",   math_sin);
+ lua_register ("cos",   math_cos);
+ lua_register ("tan",   math_tan);
+ lua_register ("asin",  math_asin);
+ lua_register ("acos",  math_acos);
+ lua_register ("atan",  math_atan);
+ lua_register ("ceil",  math_ceil);
+ lua_register ("floor", math_floor);
+ lua_register ("mod",   math_mod);
+ lua_register ("sqrt",  math_sqrt);
+ lua_register ("pow",   math_pow);
+ lua_register ("min",   math_min);
+ lua_register ("max",   math_max);
+}

+ 933 - 0
opcode.c

@@ -0,0 +1,933 @@
+/*
+** opcode.c
+** TecCGraf - PUC-Rio
+** 26 Apr 93
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifdef __GNUC__
+#include <floatingpoint.h>
+#endif
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "lua.h"
+
+#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
+#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
+
+#ifndef MAXSTACK
+#define MAXSTACK 256
+#endif
+static Object stack[MAXSTACK] = {{T_MARK, {NULL}}};
+static Object *top=stack+1, *base=stack+1;
+
+
+/*
+** Concatenate two given string, creating a mark space at the beginning.
+** Return the new string pointer.
+*/
+static char *lua_strconc (char *l, char *r)
+{
+ char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char));
+ if (s == NULL)
+ {
+  lua_error ("not enough memory");
+  return NULL;
+ }
+ *s++ = 0; 			/* create mark space */
+ return strcat(strcpy(s,l),r);
+}
+
+/*
+** Duplicate a string,  creating a mark space at the beginning.
+** Return the new string pointer.
+*/
+char *lua_strdup (char *l)
+{
+ char *s = calloc (strlen(l)+2, sizeof(char));
+ if (s == NULL)
+ {
+  lua_error ("not enough memory");
+  return NULL;
+ }
+ *s++ = 0; 			/* create mark space */
+ return strcpy(s,l);
+}
+
+/*
+** Convert, if possible, to a number tag.
+** Return 0 in success or not 0 on error.
+*/ 
+static int lua_tonumber (Object *obj)
+{
+ char *ptr;
+ if (tag(obj) != T_STRING)
+ {
+  lua_reportbug ("unexpected type at conversion to number");
+  return 1;
+ }
+ nvalue(obj) = strtod(svalue(obj), &ptr);
+ if (*ptr)
+ {
+  lua_reportbug ("string to number convertion failed");
+  return 2;
+ }
+ tag(obj) = T_NUMBER;
+ return 0;
+}
+
+/*
+** Test if is possible to convert an object to a number one.
+** If possible, return the converted object, otherwise return nil object.
+*/ 
+static Object *lua_convtonumber (Object *obj)
+{
+ static Object cvt;
+ 
+ if (tag(obj) == T_NUMBER)
+ {
+  cvt = *obj;
+  return &cvt;
+ }
+  
+ tag(&cvt) = T_NIL;
+ if (tag(obj) == T_STRING)
+ {
+  char *ptr;
+  nvalue(&cvt) = strtod(svalue(obj), &ptr);
+  if (*ptr == 0)
+   tag(&cvt) = T_NUMBER;
+ }
+ return &cvt;
+}
+
+
+
+/*
+** Convert, if possible, to a string tag
+** Return 0 in success or not 0 on error.
+*/ 
+static int lua_tostring (Object *obj)
+{
+ static char s[256];
+ if (tag(obj) != T_NUMBER)
+ {
+  lua_reportbug ("unexpected type at conversion to string");
+  return 1;
+ }
+ if ((int) nvalue(obj) == nvalue(obj))
+  sprintf (s, "%d", (int) nvalue(obj));
+ else
+  sprintf (s, "%g", nvalue(obj));
+ svalue(obj) = lua_createstring(lua_strdup(s));
+ if (svalue(obj) == NULL)
+  return 1;
+ tag(obj) = T_STRING;
+ return 0;
+}
+
+
+/*
+** Execute the given opcode. Return 0 in success or 1 on error.
+*/
+int lua_execute (Byte *pc)
+{
+ while (1)
+ {
+  switch ((OpCode)*pc++)
+  {
+   case NOP: break;
+   
+   case PUSHNIL: tag(top++) = T_NIL; break;
+   
+   case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
+   case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
+   case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
+
+   case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
+   
+   case PUSHWORD: 
+    tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word);
+   break;
+   
+   case PUSHFLOAT:
+    tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float);
+   break;
+   case PUSHSTRING:
+   {
+    int w = *((Word *)(pc));
+    pc += sizeof(Word);
+    tag(top) = T_STRING; svalue(top++) = lua_constant[w];
+   }
+   break;
+   
+   case PUSHLOCAL0: *top++ = *(base + 0); break;
+   case PUSHLOCAL1: *top++ = *(base + 1); break;
+   case PUSHLOCAL2: *top++ = *(base + 2); break;
+   case PUSHLOCAL3: *top++ = *(base + 3); break;
+   case PUSHLOCAL4: *top++ = *(base + 4); break;
+   case PUSHLOCAL5: *top++ = *(base + 5); break;
+   case PUSHLOCAL6: *top++ = *(base + 6); break;
+   case PUSHLOCAL7: *top++ = *(base + 7); break;
+   case PUSHLOCAL8: *top++ = *(base + 8); break;
+   case PUSHLOCAL9: *top++ = *(base + 9); break;
+   
+   case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
+   
+   case PUSHGLOBAL: 
+    *top++ = s_object(*((Word *)(pc))); pc += sizeof(Word);
+   break;
+   
+   case PUSHINDEXED:
+    --top;
+    if (tag(top-1) != T_ARRAY)
+    {
+     lua_reportbug ("indexed expression not a table");
+     return 1;
+    }
+    {
+     Object *h = lua_hashdefine (avalue(top-1), top);
+     if (h == NULL) return 1;
+     *(top-1) = *h;
+    }
+   break;
+   
+   case PUSHMARK: tag(top++) = T_MARK; break;
+   
+   case PUSHOBJECT: *top = *(top-3); top++; break;
+   
+   case STORELOCAL0: *(base + 0) = *(--top); break;
+   case STORELOCAL1: *(base + 1) = *(--top); break;
+   case STORELOCAL2: *(base + 2) = *(--top); break;
+   case STORELOCAL3: *(base + 3) = *(--top); break;
+   case STORELOCAL4: *(base + 4) = *(--top); break;
+   case STORELOCAL5: *(base + 5) = *(--top); break;
+   case STORELOCAL6: *(base + 6) = *(--top); break;
+   case STORELOCAL7: *(base + 7) = *(--top); break;
+   case STORELOCAL8: *(base + 8) = *(--top); break;
+   case STORELOCAL9: *(base + 9) = *(--top); break;
+    
+   case STORELOCAL: *(base + (*pc++)) = *(--top); break;
+   
+   case STOREGLOBAL:
+    s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word);
+   break;
+
+   case STOREINDEXED0:
+    if (tag(top-3) != T_ARRAY)
+    {
+     lua_reportbug ("indexed expression not a table");
+     return 1;
+    }
+    {
+     Object *h = lua_hashdefine (avalue(top-3), top-2);
+     if (h == NULL) return 1;
+     *h = *(top-1);
+    }
+    top -= 3;
+   break;
+   
+   case STOREINDEXED:
+   {
+    int n = *pc++;
+    if (tag(top-3-n) != T_ARRAY)
+    {
+     lua_reportbug ("indexed expression not a table");
+     return 1;
+    }
+    {
+     Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
+     if (h == NULL) return 1;
+     *h = *(top-1);
+    }
+    --top;
+   }
+   break;
+   
+   case STOREFIELD:
+    if (tag(top-3) != T_ARRAY)
+    {
+     lua_error ("internal error - table expected");
+     return 1;
+    }
+    *(lua_hashdefine (avalue(top-3), top-2)) = *(top-1);
+    top -= 2;
+   break;
+   
+   case ADJUST:
+   {
+    Object *newtop = base + *(pc++);
+    if (top != newtop)
+    {
+     while (top < newtop) tag(top++) = T_NIL;
+     top = newtop;
+    }
+   }
+   break;
+   
+   case CREATEARRAY:
+    if (tag(top-1) == T_NIL) 
+     nvalue(top-1) = 101;
+    else 
+    {
+     if (tonumber(top-1)) return 1;
+     if (nvalue(top-1) <= 0) nvalue(top-1) = 101;
+    }
+    avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1)));
+    if (avalue(top-1) == NULL)
+     return 1;
+    tag(top-1) = T_ARRAY;
+   break;
+   
+   case EQOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) != tag(r)) 
+     tag(top-1) = T_NIL;
+    else
+    {
+     switch (tag(l))
+     {
+      case T_NIL:       tag(top-1) = T_NUMBER; break;
+      case T_NUMBER:    tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
+      case T_ARRAY:     tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
+      case T_FUNCTION:  tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
+      case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
+      case T_USERDATA:  tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
+      case T_STRING:    tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
+      case T_MARK:      return 1;
+     }
+    }
+    nvalue(top-1) = 1;
+   }
+   break;
+    
+   case LTOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
+     tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
+    else
+    {
+     if (tostring(l) || tostring(r))
+      return 1;
+     tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
+    }
+    nvalue(top-1) = 1; 
+   }
+   break;
+   
+   case LEOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
+     tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
+    else
+    {
+     if (tostring(l) || tostring(r))
+      return 1;
+     tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
+    }
+    nvalue(top-1) = 1; 
+   }
+   break;
+   
+   case ADDOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) += nvalue(r);
+    --top;
+   }
+   break; 
+   
+   case SUBOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) -= nvalue(r);
+    --top;
+   }
+   break; 
+   
+   case MULTOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) *= nvalue(r);
+    --top;
+   }
+   break; 
+   
+   case DIVOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) /= nvalue(r);
+    --top;
+   }
+   break; 
+   
+   case CONCOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tostring(r) || tostring(l))
+     return 1;
+    svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
+    if (svalue(l) == NULL)
+     return 1;
+    --top;
+   }
+   break; 
+   
+   case MINUSOP:
+    if (tonumber(top-1))
+     return 1;
+    nvalue(top-1) = - nvalue(top-1);
+   break; 
+   
+   case NOTOP:
+    tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
+   break; 
+   
+   case ONTJMP:
+   {
+    int n = *((Word *)(pc));
+    pc += sizeof(Word);
+    if (tag(top-1) != T_NIL) pc += n;
+   }
+   break;
+   
+   case ONFJMP:	   
+   {
+    int n = *((Word *)(pc));
+    pc += sizeof(Word);
+    if (tag(top-1) == T_NIL) pc += n;
+   }
+   break;
+   
+   case JMP: pc += *((Word *)(pc)) + sizeof(Word); break;
+    
+   case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break; 
+   
+   case IFFJMP:
+   {
+    int n = *((Word *)(pc));
+    pc += sizeof(Word);
+    top--;
+    if (tag(top) == T_NIL) pc += n;
+   }
+   break;
+
+   case IFFUPJMP:
+   {
+    int n = *((Word *)(pc));
+    pc += sizeof(Word);
+    top--;
+    if (tag(top) == T_NIL) pc -= n;
+   }
+   break;
+
+   case POP: --top; break;
+   
+   case CALLFUNC:
+   {
+    Byte *newpc;
+    Object *b = top-1;
+    while (tag(b) != T_MARK) b--;
+    if (tag(b-1) == T_FUNCTION)
+    {
+     lua_debugline = 0;			/* always reset debug flag */
+     newpc = bvalue(b-1);
+     bvalue(b-1) = pc;		        /* store return code */
+     nvalue(b) = (base-stack);		/* store base value */
+     base = b+1;
+     pc = newpc;
+     if (MAXSTACK-(base-stack) < STACKGAP)
+     {
+      lua_error ("stack overflow");
+      return 1;
+     }
+    }
+    else if (tag(b-1) == T_CFUNCTION)
+    {
+     int nparam; 
+     lua_debugline = 0;			/* always reset debug flag */
+     nvalue(b) = (base-stack);		/* store base value */
+     base = b+1;
+     nparam = top-base;			/* number of parameters */
+     (fvalue(b-1))();			/* call C function */
+     
+     /* shift returned values */
+     { 
+      int i;
+      int nretval = top - base - nparam;
+      top = base - 2;
+      base = stack + (int) nvalue(base-1);
+      for (i=0; i<nretval; i++)
+      {
+       *top = *(top+nparam+2);
+       ++top;
+      }
+     }
+    }
+    else
+    {
+     lua_reportbug ("call expression not a function");
+     return 1;
+    }
+   }
+   break;
+   
+   case RETCODE:
+   {
+    int i;
+    int shift = *pc++;
+    int nretval = top - base - shift;
+    top = base - 2;
+    pc = bvalue(base-2);
+    base = stack + (int) nvalue(base-1);
+    for (i=0; i<nretval; i++)
+    {
+     *top = *(top+shift+2);
+     ++top;
+    }
+   }
+   break;
+   
+   case HALT:
+   return 0;		/* success */
+   
+   case SETFUNCTION:
+   {
+    int file, func;
+    file = *((Word *)(pc));
+    pc += sizeof(Word);
+    func = *((Word *)(pc));
+    pc += sizeof(Word);
+    if (lua_pushfunction (file, func))
+     return 1;
+   }
+   break;
+   
+   case SETLINE:
+    lua_debugline = *((Word *)(pc));
+    pc += sizeof(Word);
+   break;
+   
+   case RESET:
+    lua_popfunction ();
+   break;
+   
+   default:
+    lua_error ("internal error - opcode didn't match");
+   return 1;
+  }
+ }
+}
+
+
+/*
+** Mark all strings and arrays used by any object stored at stack.
+*/
+void lua_markstack (void)
+{
+ Object *o;
+ for (o = top-1; o >= stack; o--)
+  lua_markobject (o);
+}
+
+/*
+** Open file, generate opcode and execute global statement. Return 0 on
+** success or 1 on error.
+*/
+int lua_dofile (char *filename)
+{
+ if (lua_openfile (filename)) return 1;
+ if (lua_parse ()) { lua_closefile (); return 1; }
+ lua_closefile ();
+ return 0;
+}
+
+/*
+** Generate opcode stored on string and execute global statement. Return 0 on
+** success or 1 on error.
+*/
+int lua_dostring (char *string)
+{
+ if (lua_openstring (string)) return 1;
+ if (lua_parse ()) return 1;
+ return 0;
+}
+
+/*
+** Execute the given function. Return 0 on success or 1 on error.
+*/
+int lua_call (char *functionname, int nparam)
+{
+ static Byte startcode[] = {CALLFUNC, HALT};
+ int i; 
+ Object func = s_object(lua_findsymbol(functionname));
+ if (tag(&func) != T_FUNCTION) return 1;
+ for (i=1; i<=nparam; i++)
+  *(top-i+2) = *(top-i);
+ top += 2;
+ tag(top-nparam-1) = T_MARK;
+ *(top-nparam-2) = func;
+ return (lua_execute (startcode));
+}
+
+/*
+** Get a parameter, returning the object handle or NULL on error.
+** 'number' must be 1 to get the first parameter.
+*/
+Object *lua_getparam (int number)
+{
+ if (number <= 0 || number > top-base) return NULL;
+ return (base+number-1);
+}
+
+/*
+** Given an object handle, return its number value. On error, return 0.0.
+*/
+real lua_getnumber (Object *object)
+{
+ if (tonumber (object)) return 0.0;
+ else                   return (nvalue(object));
+}
+
+/*
+** Given an object handle, return its string pointer. On error, return NULL.
+*/
+char *lua_getstring (Object *object)
+{
+ if (tostring (object)) return NULL;
+ else                   return (svalue(object));
+}
+
+/*
+** Given an object handle, return a copy of its string. On error, return NULL.
+*/
+char *lua_copystring (Object *object)
+{
+ if (tostring (object)) return NULL;
+ else                   return (strdup(svalue(object)));
+}
+
+/*
+** Given an object handle, return its cfuntion pointer. On error, return NULL.
+*/
+lua_CFunction lua_getcfunction (Object *object)
+{
+ if (tag(object) != T_CFUNCTION) return NULL;
+ else                            return (fvalue(object));
+}
+
+/*
+** Given an object handle, return its user data. On error, return NULL.
+*/
+void *lua_getuserdata (Object *object)
+{
+ if (tag(object) != T_USERDATA) return NULL;
+ else                           return (uvalue(object));
+}
+
+/*
+** Given an object handle and a field name, return its field object.
+** On error, return NULL.
+*/
+Object *lua_getfield (Object *object, char *field)
+{
+ if (tag(object) != T_ARRAY)
+  return NULL;
+ else
+ {
+  Object ref;
+  tag(&ref) = T_STRING;
+  svalue(&ref) = lua_createstring(lua_strdup(field));
+  return (lua_hashdefine(avalue(object), &ref));
+ }
+}
+
+/*
+** Given an object handle and an index, return its indexed object.
+** On error, return NULL.
+*/
+Object *lua_getindexed (Object *object, float index)
+{
+ if (tag(object) != T_ARRAY)
+  return NULL;
+ else
+ {
+  Object ref;
+  tag(&ref) = T_NUMBER;
+  nvalue(&ref) = index;
+  return (lua_hashdefine(avalue(object), &ref));
+ }
+}
+
+/*
+** Get a global object. Return the object handle or NULL on error.
+*/
+Object *lua_getglobal (char *name)
+{
+ int n = lua_findsymbol(name);
+ if (n < 0) return NULL;
+ return &s_object(n);
+}
+
+/*
+** Pop and return an object
+*/
+Object *lua_pop (void)
+{
+ if (top <= base) return NULL;
+ top--;
+ return top;
+}
+
+/*
+** Push a nil object
+*/
+int lua_pushnil (void)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ tag(top) = T_NIL;
+ return 0;
+}
+
+/*
+** Push an object (tag=number) to stack. Return 0 on success or 1 on error.
+*/
+int lua_pushnumber (real n)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ tag(top) = T_NUMBER; nvalue(top++) = n;
+ return 0;
+}
+
+/*
+** Push an object (tag=string) to stack. Return 0 on success or 1 on error.
+*/
+int lua_pushstring (char *s)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ tag(top) = T_STRING; 
+ svalue(top++) = lua_createstring(lua_strdup(s));
+ return 0;
+}
+
+/*
+** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error.
+*/
+int lua_pushcfunction (lua_CFunction fn)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ tag(top) = T_CFUNCTION; fvalue(top++) = fn;
+ return 0;
+}
+
+/*
+** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error.
+*/
+int lua_pushuserdata (void *u)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ tag(top) = T_USERDATA; uvalue(top++) = u;
+ return 0;
+}
+
+/*
+** Push an object to stack.
+*/
+int lua_pushobject (Object *o)
+{
+ if ((top-stack) >= MAXSTACK-1)
+ {
+  lua_error ("stack overflow");
+  return 1;
+ }
+ *top++ = *o;
+ return 0;
+}
+
+/*
+** Store top of the stack at a global variable array field. 
+** Return 1 on error, 0 on success.
+*/
+int lua_storeglobal (char *name)
+{
+ int n = lua_findsymbol (name);
+ if (n < 0) return 1;
+ if (tag(top-1) == T_MARK) return 1;
+ s_object(n) = *(--top);
+ return 0;
+}
+
+/*
+** Store top of the stack at an array field. Return 1 on error, 0 on success.
+*/
+int lua_storefield (lua_Object object, char *field)
+{
+ if (tag(object) != T_ARRAY)
+  return 1;
+ else
+ {
+  Object ref, *h;
+  tag(&ref) = T_STRING;
+  svalue(&ref) = lua_createstring(lua_strdup(field));
+  h = lua_hashdefine(avalue(object), &ref);
+  if (h == NULL) return 1;
+  if (tag(top-1) == T_MARK) return 1;
+  *h = *(--top);
+ }
+ return 0;
+}
+
+
+/*
+** Store top of the stack at an array index. Return 1 on error, 0 on success.
+*/
+int lua_storeindexed (lua_Object object, float index)
+{
+ if (tag(object) != T_ARRAY)
+  return 1;
+ else
+ {
+  Object ref, *h;
+  tag(&ref) = T_NUMBER;
+  nvalue(&ref) = index;
+  h = lua_hashdefine(avalue(object), &ref);
+  if (h == NULL) return 1;
+  if (tag(top-1) == T_MARK) return 1;
+  *h = *(--top);
+ }
+ return 0;
+}
+
+
+/*
+** Given an object handle, return if it is nil.
+*/
+int lua_isnil (Object *object)
+{
+ return (object != NULL && tag(object) == T_NIL);
+}
+
+/*
+** Given an object handle, return if it is a number one.
+*/
+int lua_isnumber (Object *object)
+{
+ return (object != NULL && tag(object) == T_NUMBER);
+}
+
+/*
+** Given an object handle, return if it is a string one.
+*/
+int lua_isstring (Object *object)
+{
+ return (object != NULL && tag(object) == T_STRING);
+}
+
+/*
+** Given an object handle, return if it is an array one.
+*/
+int lua_istable (Object *object)
+{
+ return (object != NULL && tag(object) == T_ARRAY);
+}
+
+/*
+** Given an object handle, return if it is a cfunction one.
+*/
+int lua_iscfunction (Object *object)
+{
+ return (object != NULL && tag(object) == T_CFUNCTION);
+}
+
+/*
+** Given an object handle, return if it is an user data one.
+*/
+int lua_isuserdata (Object *object)
+{
+ return (object != NULL && tag(object) == T_USERDATA);
+}
+
+/*
+** Internal function: return an object type. 
+*/
+void lua_type (void)
+{
+ Object *o = lua_getparam(1);
+ lua_pushstring (lua_constant[tag(o)]);
+}
+
+/*
+** Internal function: convert an object to a number
+*/
+void lua_obj2number (void)
+{
+ Object *o = lua_getparam(1);
+ lua_pushobject (lua_convtonumber(o));
+}
+
+/*
+** Internal function: print object values
+*/
+void lua_print (void)
+{
+ int i=1;
+ void *obj;
+ while ((obj=lua_getparam (i++)) != NULL)
+ {
+  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber (obj));
+  else if (lua_isstring(obj))    printf("%s\n",lua_getstring (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",obj);
+  else if (lua_isnil(obj))       printf("nil\n");
+  else			         printf("invalid value to print\n");
+ }
+}
+

+ 144 - 0
opcode.h

@@ -0,0 +1,144 @@
+/*
+** opcode.h
+** TeCGraf - PUC-Rio
+** 16 Apr 92
+*/
+
+#ifndef opcode_h
+#define opcode_h
+
+#ifndef STACKGAP
+#define STACKGAP	128
+#endif 
+
+#ifndef real
+#define real float
+#endif
+
+typedef unsigned char  Byte;
+
+typedef unsigned short Word;
+
+typedef enum 
+{ 
+ NOP,
+ PUSHNIL,
+ PUSH0, PUSH1, PUSH2,
+ PUSHBYTE,
+ PUSHWORD,
+ PUSHFLOAT,
+ PUSHSTRING,
+ PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
+ PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
+ PUSHLOCAL,
+ PUSHGLOBAL,
+ PUSHINDEXED,
+ PUSHMARK,
+ PUSHOBJECT,
+ STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
+ STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
+ STORELOCAL,
+ STOREGLOBAL,
+ STOREINDEXED0,
+ STOREINDEXED,
+ STOREFIELD,
+ ADJUST,
+ CREATEARRAY,
+ EQOP,
+ LTOP,
+ LEOP,
+ ADDOP,
+ SUBOP,
+ MULTOP,
+ DIVOP,
+ CONCOP,
+ MINUSOP,
+ NOTOP,
+ ONTJMP,
+ ONFJMP,
+ JMP,
+ UPJMP,
+ IFFJMP,
+ IFFUPJMP,
+ POP,
+ CALLFUNC,
+ 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; 
+
+typedef void (*Cfunction) (void);
+typedef int  (*Input) (void);
+typedef void (*Unput) (int );
+
+typedef union
+{
+ Cfunction 	 f;
+ real    	 n;
+ char      	*s;
+ Byte      	*b;
+ struct Hash    *a;
+ void           *u;
+} Value;
+
+typedef struct Object
+{
+ 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 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)))
+#define s_svalue(i)	(svalue(&s_object(i)))
+#define s_bvalue(i)	(bvalue(&s_object(i)))
+#define s_avalue(i)	(avalue(&s_object(i)))
+#define s_fvalue(i)	(fvalue(&s_object(i)))
+#define s_uvalue(i)	(uvalue(&s_object(i)))
+
+
+/* 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);
+
+#endif

+ 131 - 0
strlib.c

@@ -0,0 +1,131 @@
+/*
+** strlib.c
+** String library to LUA
+**
+** Waldemar Celes Filho
+** TeCGraf - PUC-Rio
+** 19 May 93
+*/
+
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+
+#include "lua.h"
+
+/*
+** Return the position of the first caracter of a substring into a string
+** LUA interface:
+**			n = strfind (string, substring)
+*/
+static void str_find (void)
+{
+ int n;
+ char *s1, *s2;
+ lua_Object o1 = lua_getparam (1);
+ lua_Object o2 = lua_getparam (2);
+ if (!lua_isstring(o1) || !lua_isstring(o2))
+ { lua_error ("incorrect arguments to function `strfind'"); return; }
+ s1 = lua_getstring(o1);
+ s2 = lua_getstring(o2);
+ n = strstr(s1,s2) - s1 + 1;
+ lua_pushnumber (n);
+}
+
+/*
+** Return the string length
+** LUA interface:
+**			n = strlen (string)
+*/
+static void str_len (void)
+{
+ lua_Object o = lua_getparam (1);
+ if (!lua_isstring(o))
+ { lua_error ("incorrect arguments to function `strlen'"); return; }
+ lua_pushnumber(strlen(lua_getstring(o)));
+}
+
+
+/*
+** Return the substring of a string, from start to end
+** LUA interface:
+**			substring = strsub (string, start, end)
+*/
+static void str_sub (void)
+{
+ int start, end;
+ char *s;
+ lua_Object o1 = lua_getparam (1);
+ lua_Object o2 = lua_getparam (2);
+ lua_Object o3 = lua_getparam (3);
+ if (!lua_isstring(o1) || !lua_isnumber(o2) || !lua_isnumber(o3))
+ { lua_error ("incorrect arguments to function `strsub'"); return; }
+ s = strdup (lua_getstring(o1));
+ start = lua_getnumber (o2);
+ end = lua_getnumber (o3);
+ if (end < start || start < 1 || end > strlen(s))
+  lua_pushstring ("");
+ else
+ {
+  s[end] = 0;
+  lua_pushstring (&s[start-1]);
+ }
+ free (s);
+}
+
+/*
+** Convert a string to lower case.
+** LUA interface:
+**			lowercase = strlower (string)
+*/
+static void str_lower (void)
+{
+ char *s, *c;
+ lua_Object o = lua_getparam (1);
+ if (!lua_isstring(o))
+ { lua_error ("incorrect arguments to function `strlower'"); return; }
+ c = s = strdup(lua_getstring(o));
+ while (*c != 0)
+ {
+  *c = tolower(*c);
+  c++;
+ }
+ lua_pushstring(s);
+ free(s);
+} 
+
+
+/*
+** Convert a string to upper case.
+** LUA interface:
+**			uppercase = strupper (string)
+*/
+static void str_upper (void)
+{
+ char *s, *c;
+ lua_Object o = lua_getparam (1);
+ if (!lua_isstring(o))
+ { lua_error ("incorrect arguments to function `strlower'"); return; }
+ c = s = strdup(lua_getstring(o));
+ while (*c != 0)
+ {
+  *c = toupper(*c);
+  c++;
+ }
+ lua_pushstring(s);
+ free(s);
+} 
+
+
+/*
+** Open string library
+*/
+void strlib_open (void)
+{
+ lua_register ("strfind", str_find);
+ lua_register ("strlen", str_len);
+ lua_register ("strsub", str_sub);
+ lua_register ("strlower", str_lower);
+ lua_register ("strupper", str_upper);
+}

+ 351 - 0
table.c

@@ -0,0 +1,351 @@
+/*
+** table.c
+** Module to control static tables
+** TeCGraf - PUC-Rio
+** 11 May 93
+*/
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "lua.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;
+
+#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;
+
+#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;
+
+
+/*
+** 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.
+** On error, return -1.
+*/
+int lua_findsymbol (char *s)
+{
+ int i;
+ for (i=0; i<lua_ntable; i++)
+  if (streq(s,s_name(i)))
+   return i;
+ if (lua_ntable >= MAXSYMBOL-1)
+ {
+  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);
+}
+
+
+/*
+** Mark an object if it is a string or a unmarked array.
+*/
+void lua_markobject (Object *o)
+{
+ if (tag(o) == T_STRING)
+  lua_markstring (svalue(o)) = 1;
+ else if (tag(o) == T_ARRAY && markarray(avalue(o)) == 0)
+   lua_hashmark (avalue(o));
+}
+
+/*
+** Mark all strings and arrays used by any object stored at symbol table.
+*/
+static void lua_marktable (void)
+{
+ int i;
+ for (i=0; i<lua_ntable; i++)
+  lua_markobject (&s_object(i));
+} 
+
+/*
+** 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.
+*/
+int 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;
+}
+
+/*
+** Return the last file name set.
+*/
+char *lua_filename (void)
+{
+ return lua_file[lua_nfile-1];
+}
+
+/*
+** Internal function: return next global variable
+*/
+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)
+ {
+  index = 0;
+ }
+ else if (tag(o) != T_STRING) 
+ { 
+  lua_error ("incorrect argument to function `nextvar'"); 
+  return;
+ }
+ 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;
+ }
+}

+ 39 - 0
table.h

@@ -0,0 +1,39 @@
+/*
+** table.c
+** Module to control static tables
+** TeCGraf - PUC-Rio
+** 11 May 93
+*/
+
+#ifndef table_h
+#define table_h
+
+extern Symbol *lua_table;
+extern Word    lua_ntable;
+
+extern char  **lua_constant;
+extern Word    lua_nconstant;
+
+extern char  **lua_string;
+extern Word    lua_nstring;
+
+extern Hash  **lua_array;
+extern Word    lua_narray;
+
+extern char   *lua_file[];
+extern int     lua_nfile;
+
+#define lua_markstring(s)	(*((s)-1))
+
+
+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);
+
+#endif

+ 1639 - 0
y_tab.c

@@ -0,0 +1,1639 @@
+# line 2 "lua.stx"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "opcode.h"
+#include "hash.h"
+#include "inout.h"
+#include "table.h"
+#include "lua.h"
+
+#ifndef ALIGNMENT
+#define ALIGNMENT	(sizeof(void *))
+#endif
+
+#ifndef MAXCODE
+#define MAXCODE 1024
+#endif
+static long   buffer[MAXCODE];
+static Byte  *code = (Byte *)buffer;
+static long   mainbuffer[MAXCODE];
+static Byte  *maincode = (Byte *)mainbuffer;
+static Byte  *basepc;
+static Byte  *pc;
+
+#define MAXVAR 32
+static long    varbuffer[MAXVAR];
+static Byte    nvarbuffer=0;	     /* number of variables at a list */
+
+static Word    localvar[STACKGAP];
+static Byte    nlocalvar=0;	     /* number of local variables */
+static int     ntemp;		     /* number of temporary var into stack */
+static int     err;		     /* flag to indicate error */
+
+/* Internal functions */
+#define align(n)  align_n(sizeof(n))
+
+static void code_byte (Byte c)
+{
+ if (pc-basepc>MAXCODE-1)
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *pc++ = c;
+}
+
+static void code_word (Word n)
+{
+ if (pc-basepc>MAXCODE-sizeof(Word))
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *((Word *)pc) = n;
+ pc += sizeof(Word);
+}
+
+static void code_float (float n)
+{
+ if (pc-basepc>MAXCODE-sizeof(float))
+ {
+  lua_error ("code buffer overflow");
+  err = 1;
+ }
+ *((float *)pc) = n;
+ pc += sizeof(float);
+}
+
+static void incr_ntemp (void)
+{
+ if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
+  ntemp++;
+ else
+ {
+  lua_error ("stack overflow");
+  err = 1;
+ }
+}
+
+static void incr_nlocalvar (void)
+{
+ if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
+  nlocalvar++;
+ else
+ {
+  lua_error ("too many local variables or expression too complicate");
+  err = 1;
+ }
+}
+
+static void incr_nvarbuffer (void)
+{
+ if (nvarbuffer < MAXVAR-1)
+  nvarbuffer++;
+ else
+ {
+  lua_error ("variable buffer overflow");
+  err = 1;
+ }
+}
+
+static void align_n (unsigned size)
+{
+ if (size > ALIGNMENT) size = ALIGNMENT;
+ while (((pc+1-code)%size) != 0)	/* +1 to include BYTECODE */
+  code_byte (NOP);
+}
+
+static void code_number (float f)
+{ int i = f;
+  if (f == i)  /* f has an integer value */
+  {
+   if (i <= 2) code_byte(PUSH0 + i);
+   else if (i <= 255)
+   {
+    code_byte(PUSHBYTE);
+    code_byte(i);
+   }
+   else
+   {
+    align(Word);
+    code_byte(PUSHWORD);
+    code_word(i);
+   }
+  }
+  else
+  {
+   align(float);
+   code_byte(PUSHFLOAT);
+   code_float(f);
+  }
+  incr_ntemp();
+}
+
+
+# line 140 "lua.stx"
+typedef union  
+{
+ int   vInt;
+ long  vLong;
+ float vFloat;
+ Word  vWord;
+ Byte *pByte;
+} YYSTYPE;
+# 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
+#define yyclearin yychar = -1
+#define yyerrok yyerrflag = 0
+extern int yychar;
+extern int yyerrflag;
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH 150
+#endif
+YYSTYPE yylval, yyval;
+# define YYERRCODE 256
+
+# line 530 "lua.stx"
+
+
+/*
+** 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 */
+ {
+  align(Word);
+  code_byte(PUSHGLOBAL);
+  code_word(number-1);
+  incr_ntemp();
+ }
+ else if (number < 0)	/* local var */
+ {
+  number = (-number) - 1;
+  if (number < 10) code_byte(PUSHLOCAL0 + number);
+  else
+  {
+   code_byte(PUSHLOCAL);
+   code_byte(number);
+  }
+  incr_ntemp();
+ }
+ else
+ {
+  code_byte(PUSHINDEXED);
+  ntemp--;
+ }
+}
+
+static void lua_codeadjust (int n)
+{
+ code_byte(ADJUST);
+ code_byte(n + nlocalvar);
+}
+
+static void lua_codestore (int i)
+{
+ if (varbuffer[i] > 0)		/* global var */
+ {
+  align(Word);
+  code_byte(STOREGLOBAL);
+  code_word(varbuffer[i]-1);
+ }
+ else if (varbuffer[i] < 0)      /* local var */
+ {
+  int number = (-varbuffer[i]) - 1;
+  if (number < 10) code_byte(STORELOCAL0 + number);
+  else
+  {
+   code_byte(STORELOCAL);
+   code_byte(number);
+  }
+ }
+ else				  /* indexed var */
+ {
+  int j;
+  int upper=0;     	/* number of indexed variables upper */
+  int param;		/* number of itens until indexed expression */
+  for (j=i+1; j <nvarbuffer; j++)
+   if (varbuffer[j] == 0) upper++;
+  param = upper*2 + i;
+  if (param == 0)
+   code_byte(STOREINDEXED0);
+  else
+  {
+   code_byte(STOREINDEXED);
+   code_byte(param);
+  }
+ }
+}
+
+void yyerror (char *s)
+{
+ static char msg[256];
+ sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"",
+          s, lua_lasttext (), lua_linenumber, lua_filename());
+ lua_error (msg);
+ err = 1;
+}
+
+int yywrap (void)
+{
+ return 1;
+}
+
+
+/*
+** Parse LUA code and execute global statement.
+** Return 0 on success or 1 on error.
+*/
+int lua_parse (void)
+{
+ Byte *initcode = maincode;
+ err = 0;
+ if (yyparse () || (err==1)) return 1;
+ *maincode++ = HALT;
+ if (lua_execute (initcode)) return 1;
+ maincode = initcode;
+ return 0;
+}
+
+
+#if 0
+
+static void PrintCode (void)
+{
+ Byte *p = code;
+ printf ("\n\nCODE\n");
+ while (p != pc)
+ {
+  switch ((OpCode)*p)
+  {
+   case NOP:		printf ("%d    NOP\n", (p++)-code); break;
+   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:
+    			printf ("%d    PUSHWORD   %d\n", p-code, *((Word *)(p+1)));
+    			p += 1 + sizeof(Word);
+   			break;
+   case PUSHFLOAT:
+    			printf ("%d    PUSHFLOAT  %f\n", p-code, *((float *)(p+1)));
+    			p += 1 + sizeof(float);
+   			break;
+   case PUSHSTRING:
+    			printf ("%d    PUSHSTRING   %d\n", p-code, *((Word *)(p+1)));
+    			p += 1 + sizeof(Word);
+   			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:
+    			printf ("%d    PUSHGLOBAL   %d\n", p-code, *((Word *)(p+1)));
+    			p += 1 + sizeof(Word);
+   			break;
+   case PUSHINDEXED:    printf ("%d    PUSHINDEXED\n", (p++)-code); break;
+   case PUSHMARK:       printf ("%d    PUSHMARK\n", (p++)-code); break;
+   case PUSHOBJECT:     printf ("%d    PUSHOBJECT\n", (p++)-code); break;
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
+   case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
+   case STORELOCAL8: case STORELOCAL9:
+    			printf ("%d    STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0');
+    			p++;
+   			break;
+   case STORELOCAL:
+    			printf ("%d    STORELOCAK   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STOREGLOBAL:
+    			printf ("%d    STOREGLOBAL   %d\n", p-code, *((Word *)(p+1)));
+    			p += 1 + sizeof(Word);
+   			break;
+   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
+   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case STOREFIELD:     printf ("%d    STOREFIELD\n", (p++)-code); break;
+   case ADJUST:
+    			printf ("%d    ADJUST   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   case CREATEARRAY:	printf ("%d    CREATEARRAY\n", (p++)-code); break;
+   case EQOP:       	printf ("%d    EQOP\n", (p++)-code); break;
+   case LTOP:       	printf ("%d    LTOP\n", (p++)-code); break;
+   case LEOP:       	printf ("%d    LEOP\n", (p++)-code); break;
+   case ADDOP:       	printf ("%d    ADDOP\n", (p++)-code); break;
+   case SUBOP:       	printf ("%d    SUBOP\n", (p++)-code); break;
+   case MULTOP:      	printf ("%d    MULTOP\n", (p++)-code); break;
+   case DIVOP:       	printf ("%d    DIVOP\n", (p++)-code); break;
+   case CONCOP:       	printf ("%d    CONCOP\n", (p++)-code); break;
+   case MINUSOP:       	printf ("%d    MINUSOP\n", (p++)-code); break;
+   case NOTOP:       	printf ("%d    NOTOP\n", (p++)-code); break;
+   case ONTJMP:	   
+    			printf ("%d    ONTJMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case ONFJMP:	   
+    			printf ("%d    ONFJMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case JMP:	   
+    			printf ("%d    JMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case UPJMP:
+    			printf ("%d    UPJMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case IFFJMP:
+    			printf ("%d    IFFJMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case IFFUPJMP:
+    			printf ("%d    IFFUPJMP  %d\n", p-code, *((Word *)(p+1)));
+    			p += sizeof(Word) + 1;
+   			break;
+   case POP:       	printf ("%d    POP\n", (p++)-code); break;
+   case CALLFUNC:	printf ("%d    CALLFUNC\n", (p++)-code); break;
+   case RETCODE:
+    			printf ("%d    RETCODE   %d\n", p-code, *(++p));
+    			p++;
+   			break;
+   default:		printf ("%d    Cannot happen\n", (p++)-code); break;
+  }
+ }
+}
+#endif
+
+int yyexca[] ={
+-1, 1,
+	0, -1,
+	-2, 2,
+-1, 19,
+	40, 65,
+	91, 95,
+	46, 97,
+	-2, 92,
+-1, 29,
+	40, 65,
+	91, 95,
+	46, 97,
+	-2, 51,
+-1, 70,
+	275, 33,
+	276, 33,
+	61, 33,
+	277, 33,
+	62, 33,
+	60, 33,
+	278, 33,
+	279, 33,
+	280, 33,
+	43, 33,
+	45, 33,
+	42, 33,
+	47, 33,
+	-2, 68,
+-1, 71,
+	91, 95,
+	46, 97,
+	-2, 93,
+-1, 102,
+	260, 27,
+	261, 27,
+	265, 27,
+	266, 27,
+	267, 27,
+	-2, 11,
+-1, 117,
+	93, 85,
+	-2, 87,
+-1, 122,
+	267, 30,
+	-2, 29,
+-1, 145,
+	275, 33,
+	276, 33,
+	61, 33,
+	277, 33,
+	62, 33,
+	60, 33,
+	278, 33,
+	279, 33,
+	280, 33,
+	43, 33,
+	45, 33,
+	42, 33,
+	47, 33,
+	-2, 70,
+	};
+# define YYNPROD 105
+# define YYLAST 318
+int yyact[]={
+
+    54,    52,   136,    53,    13,    55,    54,    52,    14,    53,
+    15,    55,     5,   166,    18,     6,   129,    21,    47,    46,
+    48,   107,   104,    97,    47,    46,    48,    54,    52,    80,
+    53,    21,    55,    54,    52,    40,    53,     9,    55,    54,
+    52,   158,    53,   160,    55,    47,    46,    48,   159,   101,
+    81,    47,    46,    48,    10,    54,    52,   126,    53,    67,
+    55,    54,    52,    60,    53,   155,    55,   148,   149,   135,
+   147,   108,   150,    47,    46,    48,    73,    23,    75,    47,
+    46,    48,     7,    25,    38,   153,    26,   164,    27,   117,
+    61,    62,    74,    11,    76,    54,    24,   127,    65,    66,
+    55,    37,   154,   151,   103,   111,    72,    28,    93,    94,
+    82,    83,    84,    85,    86,    87,    88,    89,    90,    91,
+    92,   116,    59,    77,    54,    52,   118,    53,    99,    55,
+   110,    95,    64,    44,    70,   109,    29,    33,   105,   106,
+    42,   112,    41,   165,   139,    19,    17,   152,    79,   123,
+    43,   119,    20,   114,   113,    98,    63,   144,   143,   122,
+    68,    39,    36,   130,    35,   120,    12,     8,   102,   125,
+   128,   141,    78,    69,    70,    71,   142,   131,   132,   140,
+    22,   124,     4,     3,     2,   121,    96,   138,   146,   137,
+   134,   157,   133,   115,    16,     1,     0,     0,     0,     0,
+     0,     0,     0,   156,     0,     0,     0,     0,   161,     0,
+     0,     0,     0,   162,     0,     0,     0,   168,     0,   172,
+   145,   163,   171,     0,   174,     0,     0,     0,   169,   156,
+   167,   170,   173,    57,    58,    49,    50,    51,    56,    57,
+    58,    49,    50,    51,    56,   175,     0,     0,   100,     0,
+    45,     0,     0,     0,     0,    70,     0,     0,     0,     0,
+    57,    58,    49,    50,    51,    56,    57,    58,    49,    50,
+    51,    56,     0,     0,     0,     0,     0,    56,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,     0,    57,    58,
+    49,    50,    51,    56,     0,     0,    49,    50,    51,    56,
+    32,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     0,     0,    30,     0,    21,    31,     0,    34 };
+int yypact[]={
+
+ -1000,  -258, -1000, -1000, -1000,  -234, -1000,    34,  -254, -1000,
+ -1000, -1000, -1000,    43, -1000, -1000,    40, -1000,  -236, -1000,
+ -1000, -1000,    93,    -9, -1000,    43,    43,    43,    92, -1000,
+ -1000, -1000, -1000, -1000,    43,    43, -1000,    43,  -240,    62,
+    31,   -13,    48,    83,  -242, -1000,    43,    43,    43,    43,
+    43,    43,    43,    43,    43,    43,    43, -1000, -1000,    90,
+    13, -1000, -1000,  -248,    43,    19,   -15,  -216, -1000,    60,
+ -1000, -1000,  -249, -1000, -1000,    43,  -250,    43,    89,    61,
+ -1000, -1000,    -3,    -3,    -3,    -3,    -3,    -3,    53,    53,
+ -1000, -1000,    82, -1000, -1000, -1000,    -2, -1000,    85,    13,
+ -1000,    43, -1000, -1000,    31,    43,   -36, -1000,    56,    60,
+ -1000,  -255, -1000,    43,    43, -1000,  -269, -1000, -1000, -1000,
+    13,    34, -1000,    43, -1000,    13, -1000, -1000, -1000, -1000,
+  -193,    19,    19,   -53,    59, -1000, -1000,    -8,    58,    43,
+ -1000, -1000, -1000, -1000,  -226, -1000,  -218,  -223, -1000,    43,
+ -1000,  -269,    26, -1000, -1000, -1000,    13,  -253,    43, -1000,
+ -1000, -1000,   -42, -1000,    43,    43, -1000,    34, -1000,    13,
+ -1000, -1000, -1000, -1000,  -193, -1000 };
+int yypgo[]={
+
+     0,   195,    50,    96,    71,   135,   194,   193,   192,   190,
+   189,   187,   136,   186,   184,    82,    54,   183,   182,   180,
+   172,   170,    59,   168,   167,   166,    63,    70,   164,   162,
+   137,   161,   160,   159,   158,   157,   156,   155,   154,   153,
+   152,   150,   149,   148,    69,   147,   144,    65,   143,   142,
+   140,    76,   138 };
+int yyr1[]={
+
+     0,     1,    14,     1,     1,     1,    19,    21,    17,    23,
+    23,    24,    15,    16,    16,    25,    28,    25,    29,    25,
+    25,    25,    25,    27,    27,    27,    32,    33,    22,    34,
+    35,    34,     2,    26,     3,     3,     3,     3,     3,     3,
+     3,     3,     3,     3,     3,     3,     3,     3,    36,     3,
+     3,     3,     3,     3,     3,     3,     3,    38,     3,    39,
+     3,    37,    37,    41,    30,    40,     4,     4,     5,    42,
+     5,    20,    20,    43,    43,    13,    13,     7,     7,     8,
+     8,     9,     9,    45,    44,    10,    10,    46,    11,    48,
+    11,    47,     6,     6,    12,    49,    12,    50,    12,    31,
+    31,    51,    52,    51,    18 };
+int yyr2[]={
+
+     0,     0,     1,     9,     4,     4,     1,     1,    19,     0,
+     6,     1,     4,     0,     2,    17,     1,    17,     1,    13,
+     7,     3,     4,     0,     4,    15,     1,     1,     9,     0,
+     1,     9,     1,     3,     7,     7,     7,     7,     7,     7,
+     7,     7,     7,     7,     7,     7,     5,     5,     1,     9,
+     9,     3,     3,     3,     3,     3,     5,     1,    11,     1,
+    11,     1,     2,     1,    11,     3,     1,     3,     3,     1,
+     9,     0,     2,     3,     7,     1,     3,     7,     7,     1,
+     3,     3,     7,     1,     9,     1,     3,     1,     5,     1,
+     9,     3,     3,     7,     3,     1,    11,     1,     9,     5,
+     9,     1,     1,     6,     3 };
+int yychk[]={
+
+ -1000,    -1,   -14,   -17,   -18,   270,   273,   -15,   -24,   271,
+   -16,    59,   -25,   258,   262,   264,    -6,   -30,   268,   -12,
+   -40,   271,   -19,   -26,    -3,    40,    43,    45,    64,   -12,
+   269,   272,   257,   -30,   274,   -28,   -29,    61,    44,   -31,
+   271,   -49,   -50,   -41,    40,   259,    61,    60,    62,   277,
+   278,   279,    43,    45,    42,    47,   280,   275,   276,    -3,
+   -26,   -26,   -26,   -36,    40,   -26,   -26,   -22,   -32,    -5,
+    -3,   -12,    44,   -51,    61,    91,    46,    40,   -20,   -43,
+   271,    -2,   -26,   -26,   -26,   -26,   -26,   -26,   -26,   -26,
+   -26,   -26,   -26,    -2,    -2,    41,   -13,   271,   -37,   -26,
+   263,   265,   -23,    44,   271,   -52,   -26,   271,    -4,    -5,
+    41,    44,   -22,   -38,   -39,    -7,   123,    91,    41,    -2,
+   -26,   -15,   -33,   -42,   -51,   -26,    93,    41,   -21,   271,
+    -2,   -26,   -26,    -8,    -9,   -44,   271,   -10,   -11,   -46,
+   -22,    -2,   -16,   -34,   -35,    -3,   -22,   -27,   260,   261,
+   125,    44,   -45,    93,    44,   -47,   -26,    -2,   267,   266,
+   266,   -22,   -26,   -44,    61,   -48,   266,    -4,   259,   -26,
+   -47,   -16,    -2,   -22,    -2,   -27 };
+int yydef[]={
+
+     1,    -2,    11,     4,     5,     0,   104,    13,     0,     6,
+     3,    14,    12,     0,    16,    18,     0,    21,     0,    -2,
+    63,    94,     0,     0,    33,     0,     0,     0,    48,    -2,
+    52,    53,    54,    55,     0,     0,    26,     0,     0,    22,
+   101,     0,     0,     0,    71,    32,     0,     0,     0,     0,
+     0,     0,     0,     0,     0,     0,     0,    32,    32,    33,
+     0,    46,    47,    75,    61,    56,     0,     0,     9,    20,
+    -2,    -2,     0,    99,   102,     0,     0,    66,     0,    72,
+    73,    26,    35,    36,    37,    38,    39,    40,    41,    42,
+    43,    44,    45,    57,    59,    34,     0,    76,     0,    62,
+    32,     0,    -2,    69,   101,     0,     0,    98,     0,    67,
+     7,     0,    32,     0,     0,    49,    79,    -2,    50,    26,
+    32,    13,    -2,     0,   100,   103,    96,    64,    26,    74,
+    23,    58,    60,     0,    80,    81,    83,     0,    86,     0,
+    32,    19,    10,    28,     0,    -2,     0,     0,    26,     0,
+    77,     0,     0,    78,    89,    88,    91,     0,    66,     8,
+    15,    24,     0,    82,     0,     0,    17,    13,    32,    84,
+    90,    31,    26,    32,    23,    25 };
+typedef struct { char *t_name; int t_val; } yytoktype;
+#ifndef YYDEBUG
+#	define YYDEBUG	0	/* don't allow debugging */
+#endif
+
+#if YYDEBUG
+
+yytoktype yytoks[] =
+{
+	"NIL",	257,
+	"IF",	258,
+	"THEN",	259,
+	"ELSE",	260,
+	"ELSEIF",	261,
+	"WHILE",	262,
+	"DO",	263,
+	"REPEAT",	264,
+	"UNTIL",	265,
+	"END",	266,
+	"RETURN",	267,
+	"LOCAL",	268,
+	"NUMBER",	269,
+	"FUNCTION",	270,
+	"NAME",	271,
+	"STRING",	272,
+	"DEBUG",	273,
+	"NOT",	274,
+	"AND",	275,
+	"OR",	276,
+	"=",	61,
+	"NE",	277,
+	">",	62,
+	"<",	60,
+	"LE",	278,
+	"GE",	279,
+	"CONC",	280,
+	"+",	43,
+	"-",	45,
+	"*",	42,
+	"/",	47,
+	"%",	37,
+	"UNARY",	281,
+	"-unknown-",	-1	/* ends search */
+};
+
+char * yyreds[] =
+{
+	"-no such reduction-",
+	"functionlist : /* empty */",
+	"functionlist : functionlist",
+	"functionlist : functionlist stat sc",
+	"functionlist : functionlist function",
+	"functionlist : functionlist setdebug",
+	"function : FUNCTION NAME",
+	"function : FUNCTION NAME '(' parlist ')'",
+	"function : FUNCTION NAME '(' parlist ')' block END",
+	"statlist : /* empty */",
+	"statlist : statlist stat sc",
+	"stat : /* empty */",
+	"stat : stat1",
+	"sc : /* empty */",
+	"sc : ';'",
+	"stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END",
+	"stat1 : WHILE",
+	"stat1 : WHILE expr1 DO PrepJump block PrepJump END",
+	"stat1 : REPEAT",
+	"stat1 : REPEAT block UNTIL expr1 PrepJump",
+	"stat1 : varlist1 '=' exprlist1",
+	"stat1 : functioncall",
+	"stat1 : LOCAL declist",
+	"elsepart : /* empty */",
+	"elsepart : ELSE block",
+	"elsepart : ELSEIF expr1 THEN PrepJump block PrepJump elsepart",
+	"block : /* empty */",
+	"block : statlist",
+	"block : statlist ret",
+	"ret : /* empty */",
+	"ret : /* empty */",
+	"ret : RETURN exprlist sc",
+	"PrepJump : /* empty */",
+	"expr1 : expr",
+	"expr : '(' expr ')'",
+	"expr : expr1 '=' expr1",
+	"expr : expr1 '<' expr1",
+	"expr : expr1 '>' expr1",
+	"expr : expr1 NE expr1",
+	"expr : expr1 LE expr1",
+	"expr : expr1 GE expr1",
+	"expr : expr1 '+' expr1",
+	"expr : expr1 '-' expr1",
+	"expr : expr1 '*' expr1",
+	"expr : expr1 '/' expr1",
+	"expr : expr1 CONC expr1",
+	"expr : '+' expr1",
+	"expr : '-' expr1",
+	"expr : '@'",
+	"expr : '@' objectname fieldlist",
+	"expr : '@' '(' dimension ')'",
+	"expr : var",
+	"expr : NUMBER",
+	"expr : STRING",
+	"expr : NIL",
+	"expr : functioncall",
+	"expr : NOT expr1",
+	"expr : expr1 AND PrepJump",
+	"expr : expr1 AND PrepJump expr1",
+	"expr : expr1 OR PrepJump",
+	"expr : expr1 OR PrepJump expr1",
+	"dimension : /* empty */",
+	"dimension : expr1",
+	"functioncall : functionvalue",
+	"functioncall : functionvalue '(' exprlist ')'",
+	"functionvalue : var",
+	"exprlist : /* empty */",
+	"exprlist : exprlist1",
+	"exprlist1 : expr",
+	"exprlist1 : exprlist1 ','",
+	"exprlist1 : exprlist1 ',' expr",
+	"parlist : /* empty */",
+	"parlist : parlist1",
+	"parlist1 : NAME",
+	"parlist1 : parlist1 ',' NAME",
+	"objectname : /* empty */",
+	"objectname : NAME",
+	"fieldlist : '{' ffieldlist '}'",
+	"fieldlist : '[' lfieldlist ']'",
+	"ffieldlist : /* empty */",
+	"ffieldlist : ffieldlist1",
+	"ffieldlist1 : ffield",
+	"ffieldlist1 : ffieldlist1 ',' ffield",
+	"ffield : NAME",
+	"ffield : NAME '=' expr1",
+	"lfieldlist : /* empty */",
+	"lfieldlist : lfieldlist1",
+	"lfieldlist1 : /* empty */",
+	"lfieldlist1 : lfield",
+	"lfieldlist1 : lfieldlist1 ','",
+	"lfieldlist1 : lfieldlist1 ',' lfield",
+	"lfield : expr1",
+	"varlist1 : var",
+	"varlist1 : varlist1 ',' var",
+	"var : NAME",
+	"var : var",
+	"var : var '[' expr1 ']'",
+	"var : var",
+	"var : var '.' NAME",
+	"declist : NAME init",
+	"declist : declist ',' NAME init",
+	"init : /* empty */",
+	"init : '='",
+	"init : '=' expr1",
+	"setdebug : DEBUG",
+};
+#endif /* YYDEBUG */
+#line 1 "/usr/lib/yaccpar"
+/*	@(#)yaccpar 1.10 89/04/04 SMI; from S5R3 1.10	*/
+
+/*
+** Skeleton parser driver for yacc output
+*/
+
+/*
+** yacc user known macros and defines
+*/
+#define YYERROR		goto yyerrlab
+#define YYACCEPT	{ free(yys); free(yyv); return(0); }
+#define YYABORT		{ free(yys); free(yyv); return(1); }
+#define YYBACKUP( newtoken, newvalue )\
+{\
+	if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\
+	{\
+		yyerror( "syntax error - cannot backup" );\
+		goto yyerrlab;\
+	}\
+	yychar = newtoken;\
+	yystate = *yyps;\
+	yylval = newvalue;\
+	goto yynewstate;\
+}
+#define YYRECOVERING()	(!!yyerrflag)
+#ifndef YYDEBUG
+#	define YYDEBUG	1	/* make debugging available */
+#endif
+
+/*
+** user known globals
+*/
+int yydebug;			/* set to 1 to get debugging */
+
+/*
+** driver internal defines
+*/
+#define YYFLAG		(-1000)
+
+/*
+** static variables used by the parser
+*/
+static YYSTYPE *yyv;			/* value stack */
+static int *yys;			/* state stack */
+
+static YYSTYPE *yypv;			/* top of value stack */
+static int *yyps;			/* top of state stack */
+
+static int yystate;			/* current state */
+static int yytmp;			/* extra var (lasts between blocks) */
+
+int yynerrs;			/* number of errors */
+
+int yyerrflag;			/* error recovery flag */
+int yychar;			/* current input token number */
+
+
+/*
+** yyparse - return 0 if worked, 1 if syntax error not recovered from
+*/
+int
+yyparse()
+{
+	register YYSTYPE *yypvt;	/* top of value stack for $vars */
+	unsigned yymaxdepth = YYMAXDEPTH;
+
+	/*
+	** Initialize externals - yyparse may be called more than once
+	*/
+	yyv = (YYSTYPE*)malloc(yymaxdepth*sizeof(YYSTYPE));
+	yys = (int*)malloc(yymaxdepth*sizeof(int));
+	if (!yyv || !yys)
+	{
+		yyerror( "out of memory" );
+		return(1);
+	}
+	yypv = &yyv[-1];
+	yyps = &yys[-1];
+	yystate = 0;
+	yytmp = 0;
+	yynerrs = 0;
+	yyerrflag = 0;
+	yychar = -1;
+
+	goto yystack;
+	{
+		register YYSTYPE *yy_pv;	/* top of value stack */
+		register int *yy_ps;		/* top of state stack */
+		register int yy_state;		/* current state */
+		register int  yy_n;		/* internal state number info */
+
+		/*
+		** get globals into registers.
+		** branch to here only if YYBACKUP was called.
+		*/
+	yynewstate:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+		goto yy_newstate;
+
+		/*
+		** get globals into registers.
+		** either we just started, or we just finished a reduction
+		*/
+	yystack:
+		yy_pv = yypv;
+		yy_ps = yyps;
+		yy_state = yystate;
+
+		/*
+		** top of for (;;) loop while no reductions done
+		*/
+	yy_stack:
+		/*
+		** put a state and value onto the stacks
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, look up token value in list of value vs.
+		** name pairs.  0 and negative (-1) are special values.
+		** Note: linear search is used since time is not a real
+		** consideration while debugging.
+		*/
+		if ( yydebug )
+		{
+			register int yy_i;
+
+			(void)printf( "State %d, token ", yy_state );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif /* YYDEBUG */
+		if ( ++yy_ps >= &yys[ yymaxdepth ] )	/* room on stack? */
+		{
+			/*
+			** reallocate and recover.  Note that pointers
+			** have to be reset, or bad things will happen
+			*/
+			int yyps_index = (yy_ps - yys);
+			int yypv_index = (yy_pv - yyv);
+			int yypvt_index = (yypvt - yyv);
+			yymaxdepth += YYMAXDEPTH;
+			yyv = (YYSTYPE*)realloc((char*)yyv,
+				yymaxdepth * sizeof(YYSTYPE));
+			yys = (int*)realloc((char*)yys,
+				yymaxdepth * sizeof(int));
+			if (!yyv || !yys)
+			{
+				yyerror( "yacc stack overflow" );
+				return(1);
+			}
+			yy_ps = yys + yyps_index;
+			yy_pv = yyv + yypv_index;
+			yypvt = yyv + yypvt_index;
+		}
+		*yy_ps = yy_state;
+		*++yy_pv = yyval;
+
+		/*
+		** we have a new state - find out what to do
+		*/
+	yy_newstate:
+		if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG )
+			goto yydefault;		/* simple state */
+#if YYDEBUG
+		/*
+		** if debugging, need to mark whether new token grabbed
+		*/
+		yytmp = yychar < 0;
+#endif
+		if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+			yychar = 0;		/* reached EOF */
+#if YYDEBUG
+		if ( yydebug && yytmp )
+		{
+			register int yy_i;
+
+			(void)printf( "Received token " );
+			if ( yychar == 0 )
+				(void)printf( "end-of-file\n" );
+			else if ( yychar < 0 )
+				(void)printf( "-none-\n" );
+			else
+			{
+				for ( yy_i = 0; yytoks[yy_i].t_val >= 0;
+					yy_i++ )
+				{
+					if ( yytoks[yy_i].t_val == yychar )
+						break;
+				}
+				(void)printf( "%s\n", yytoks[yy_i].t_name );
+			}
+		}
+#endif /* YYDEBUG */
+		if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) )
+			goto yydefault;
+		if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar )	/*valid shift*/
+		{
+			yychar = -1;
+			yyval = yylval;
+			yy_state = yy_n;
+			if ( yyerrflag > 0 )
+				yyerrflag--;
+			goto yy_stack;
+		}
+
+	yydefault:
+		if ( ( yy_n = yydef[ yy_state ] ) == -2 )
+		{
+#if YYDEBUG
+			yytmp = yychar < 0;
+#endif
+			if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) )
+				yychar = 0;		/* reached EOF */
+#if YYDEBUG
+			if ( yydebug && yytmp )
+			{
+				register int yy_i;
+
+				(void)printf( "Received token " );
+				if ( yychar == 0 )
+					(void)printf( "end-of-file\n" );
+				else if ( yychar < 0 )
+					(void)printf( "-none-\n" );
+				else
+				{
+					for ( yy_i = 0;
+						yytoks[yy_i].t_val >= 0;
+						yy_i++ )
+					{
+						if ( yytoks[yy_i].t_val
+							== yychar )
+						{
+							break;
+						}
+					}
+					(void)printf( "%s\n", yytoks[yy_i].t_name );
+				}
+			}
+#endif /* YYDEBUG */
+			/*
+			** look through exception table
+			*/
+			{
+				register int *yyxi = yyexca;
+
+				while ( ( *yyxi != -1 ) ||
+					( yyxi[1] != yy_state ) )
+				{
+					yyxi += 2;
+				}
+				while ( ( *(yyxi += 2) >= 0 ) &&
+					( *yyxi != yychar ) )
+					;
+				if ( ( yy_n = yyxi[1] ) < 0 )
+					YYACCEPT;
+			}
+		}
+
+		/*
+		** check for syntax error
+		*/
+		if ( yy_n == 0 )	/* have an error */
+		{
+			/* no worry about speed here! */
+			switch ( yyerrflag )
+			{
+			case 0:		/* new error */
+				yyerror( "syntax error" );
+				goto skip_init;
+			yyerrlab:
+				/*
+				** get globals into registers.
+				** we have a user generated syntax type error
+				*/
+				yy_pv = yypv;
+				yy_ps = yyps;
+				yy_state = yystate;
+				yynerrs++;
+			skip_init:
+			case 1:
+			case 2:		/* incompletely recovered error */
+					/* try again... */
+				yyerrflag = 3;
+				/*
+				** find state where "error" is a legal
+				** shift action
+				*/
+				while ( yy_ps >= yys )
+				{
+					yy_n = yypact[ *yy_ps ] + YYERRCODE;
+					if ( yy_n >= 0 && yy_n < YYLAST &&
+						yychk[yyact[yy_n]] == YYERRCODE)					{
+						/*
+						** simulate shift of "error"
+						*/
+						yy_state = yyact[ yy_n ];
+						goto yy_stack;
+					}
+					/*
+					** current state has no shift on
+					** "error", pop stack
+					*/
+#if YYDEBUG
+#	define _POP_ "Error recovery pops state %d, uncovers state %d\n"
+					if ( yydebug )
+						(void)printf( _POP_, *yy_ps,
+							yy_ps[-1] );
+#	undef _POP_
+#endif
+					yy_ps--;
+					yy_pv--;
+				}
+				/*
+				** there is no state on stack with "error" as
+				** a valid shift.  give up.
+				*/
+				YYABORT;
+			case 3:		/* no shift yet; eat a token */
+#if YYDEBUG
+				/*
+				** if debugging, look up token in list of
+				** pairs.  0 and negative shouldn't occur,
+				** but since timing doesn't matter when
+				** debugging, it doesn't hurt to leave the
+				** tests here.
+				*/
+				if ( yydebug )
+				{
+					register int yy_i;
+
+					(void)printf( "Error recovery discards " );
+					if ( yychar == 0 )
+						(void)printf( "token end-of-file\n" );
+					else if ( yychar < 0 )
+						(void)printf( "token -none-\n" );
+					else
+					{
+						for ( yy_i = 0;
+							yytoks[yy_i].t_val >= 0;
+							yy_i++ )
+						{
+							if ( yytoks[yy_i].t_val
+								== yychar )
+							{
+								break;
+							}
+						}
+						(void)printf( "token %s\n",
+							yytoks[yy_i].t_name );
+					}
+				}
+#endif /* YYDEBUG */
+				if ( yychar == 0 )	/* reached EOF. quit */
+					YYABORT;
+				yychar = -1;
+				goto yy_newstate;
+			}
+		}/* end if ( yy_n == 0 ) */
+		/*
+		** reduction by production yy_n
+		** put stack tops, etc. so things right after switch
+		*/
+#if YYDEBUG
+		/*
+		** if debugging, print the string that is the user's
+		** specification of the reduction which is just about
+		** to be done.
+		*/
+		if ( yydebug )
+			(void)printf( "Reduce by (%d) \"%s\"\n",
+				yy_n, yyreds[ yy_n ] );
+#endif
+		yytmp = yy_n;			/* value to switch over */
+		yypvt = yy_pv;			/* $vars top of value stack */
+		/*
+		** Look in goto table for next state
+		** Sorry about using yy_state here as temporary
+		** register variable, but why not, if it works...
+		** If yyr2[ yy_n ] doesn't have the low order bit
+		** set, then there is no action to be done for
+		** this reduction.  So, no saving & unsaving of
+		** registers done.  The only difference between the
+		** code just after the if and the body of the if is
+		** the goto yy_stack in the body.  This way the test
+		** can be made before the choice of what to do is needed.
+		*/
+		{
+			/* length of production doubled with extra bit */
+			register int yy_len = yyr2[ yy_n ];
+
+			if ( !( yy_len & 01 ) )
+			{
+				yy_len >>= 1;
+				yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+				yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+					*( yy_ps -= yy_len ) + 1;
+				if ( yy_state >= YYLAST ||
+					yychk[ yy_state =
+					yyact[ yy_state ] ] != -yy_n )
+				{
+					yy_state = yyact[ yypgo[ yy_n ] ];
+				}
+				goto yy_stack;
+			}
+			yy_len >>= 1;
+			yyval = ( yy_pv -= yy_len )[1];	/* $$ = $1 */
+			yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] +
+				*( yy_ps -= yy_len ) + 1;
+			if ( yy_state >= YYLAST ||
+				yychk[ yy_state = yyact[ yy_state ] ] != -yy_n )
+			{
+				yy_state = yyact[ yypgo[ yy_n ] ];
+			}
+		}
+					/* save until reenter driver code */
+		yystate = yy_state;
+		yyps = yy_ps;
+		yypv = yy_pv;
+	}
+	/*
+	** code supplied by user is placed in this switch
+	*/
+	switch( yytmp )
+	{
+		
+case 2:
+# line 179 "lua.stx"
+{pc=basepc=maincode; nlocalvar=0;} break;
+case 3:
+# line 179 "lua.stx"
+{maincode=pc;} break;
+case 6:
+# line 184 "lua.stx"
+{pc=basepc=code; nlocalvar=0;} break;
+case 7:
+# line 185 "lua.stx"
+{
+	        if (lua_debug)
+		{
+		 align(Word);
+	         code_byte(SETFUNCTION); 
+                 code_word(yypvt[-5].vWord);
+		 code_word(yypvt[-4].vWord);
+		}
+	        lua_codeadjust (0);
+	       } break;
+case 8:
+# line 197 "lua.stx"
+{ 
+                if (lua_debug) code_byte(RESET); 
+	        code_byte(RETCODE); code_byte(nlocalvar);
+	        s_tag(yypvt[-7].vWord) = T_FUNCTION;
+	        s_bvalue(yypvt[-7].vWord) = calloc (pc-code, sizeof(Byte));
+	        memcpy (s_bvalue(yypvt[-7].vWord), code, (pc-code)*sizeof(Byte));
+	       } break;
+case 11:
+# line 210 "lua.stx"
+{
+            ntemp = 0; 
+            if (lua_debug)
+            {
+             align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+            }
+	   } break;
+case 15:
+# line 223 "lua.stx"
+{
+        {
+	 Byte *elseinit = yypvt[-2].pByte + sizeof(Word)+1;
+	 if (pc - elseinit == 0)		/* no else */
+	 {
+	  pc -= sizeof(Word)+1;
+	 /* if (*(pc-1) == NOP) --pc; */
+	  elseinit = pc;
+	 }
+	 else
+	 {
+	  *(yypvt[-2].pByte) = JMP;
+	  *((Word *)(yypvt[-2].pByte+1)) = pc - elseinit;
+	 }
+	 *(yypvt[-4].pByte) = IFFJMP;
+	 *((Word *)(yypvt[-4].pByte+1)) = elseinit - (yypvt[-4].pByte + sizeof(Word)+1);
+	}
+       } break;
+case 16:
+# line 242 "lua.stx"
+{yyval.pByte = pc;} break;
+case 17:
+# line 244 "lua.stx"
+{
+        *(yypvt[-3].pByte) = IFFJMP;
+        *((Word *)(yypvt[-3].pByte+1)) = pc - (yypvt[-3].pByte + sizeof(Word)+1);
+        
+        *(yypvt[-1].pByte) = UPJMP;
+        *((Word *)(yypvt[-1].pByte+1)) = pc - yypvt[-6].pByte;
+       } break;
+case 18:
+# line 252 "lua.stx"
+{yyval.pByte = pc;} break;
+case 19:
+# line 254 "lua.stx"
+{
+        *(yypvt[-0].pByte) = IFFUPJMP;
+        *((Word *)(yypvt[-0].pByte+1)) = pc - yypvt[-4].pByte;
+       } break;
+case 20:
+# line 261 "lua.stx"
+{
+        {
+         int i;
+         if (yypvt[-0].vInt == 0 || nvarbuffer != ntemp - yypvt[-2].vInt * 2)
+	  lua_codeadjust (yypvt[-2].vInt * 2 + nvarbuffer);
+	 for (i=nvarbuffer-1; i>=0; i--)
+	  lua_codestore (i);
+	 if (yypvt[-2].vInt > 1 || (yypvt[-2].vInt == 1 && varbuffer[0] != 0))
+	  lua_codeadjust (0);
+	}
+       } break;
+case 21:
+# line 272 "lua.stx"
+{ lua_codeadjust (0); } break;
+case 25:
+# line 279 "lua.stx"
+{
+          {
+  	   Byte *elseinit = yypvt[-1].pByte + sizeof(Word)+1;
+  	   if (pc - elseinit == 0)		/* no else */
+  	   {
+  	    pc -= sizeof(Word)+1;
+  	    /* if (*(pc-1) == NOP) --pc; */
+	    elseinit = pc;
+	   }
+	   else
+	   {
+	    *(yypvt[-1].pByte) = JMP;
+	    *((Word *)(yypvt[-1].pByte+1)) = pc - elseinit;
+	   }
+	   *(yypvt[-3].pByte) = IFFJMP;
+	   *((Word *)(yypvt[-3].pByte+1)) = elseinit - (yypvt[-3].pByte + sizeof(Word)+1);
+	  }  
+         } break;
+case 26:
+# line 299 "lua.stx"
+{yyval.vInt = nlocalvar;} break;
+case 27:
+# line 299 "lua.stx"
+{ntemp = 0;} break;
+case 28:
+# line 300 "lua.stx"
+{
+	  if (nlocalvar != yypvt[-3].vInt)
+	  {
+           nlocalvar = yypvt[-3].vInt;
+	   lua_codeadjust (0);
+	  }
+         } break;
+case 30:
+# line 310 "lua.stx"
+{ if (lua_debug){align(Word);code_byte(SETLINE);code_word(lua_linenumber);}} break;
+case 31:
+# line 312 "lua.stx"
+{ 
+           if (lua_debug) code_byte(RESET); 
+           code_byte(RETCODE); code_byte(nlocalvar);
+          } break;
+case 32:
+# line 319 "lua.stx"
+{ 
+          align(Word); 
+	  yyval.pByte = pc;
+	  code_byte(0);		/* open space */
+	  code_word (0);
+         } break;
+case 33:
+# line 326 "lua.stx"
+{ if (yypvt[-0].vInt == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}} break;
+case 34:
+# line 329 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; } break;
+case 35:
+# line 330 "lua.stx"
+{ code_byte(EQOP);   yyval.vInt = 1; ntemp--;} break;
+case 36:
+# line 331 "lua.stx"
+{ code_byte(LTOP);   yyval.vInt = 1; ntemp--;} break;
+case 37:
+# line 332 "lua.stx"
+{ code_byte(LEOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+case 38:
+# line 333 "lua.stx"
+{ code_byte(EQOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+case 39:
+# line 334 "lua.stx"
+{ code_byte(LEOP);   yyval.vInt = 1; ntemp--;} break;
+case 40:
+# line 335 "lua.stx"
+{ code_byte(LTOP); code_byte(NOTOP); yyval.vInt = 1; ntemp--;} break;
+case 41:
+# line 336 "lua.stx"
+{ code_byte(ADDOP);  yyval.vInt = 1; ntemp--;} break;
+case 42:
+# line 337 "lua.stx"
+{ code_byte(SUBOP);  yyval.vInt = 1; ntemp--;} break;
+case 43:
+# line 338 "lua.stx"
+{ code_byte(MULTOP); yyval.vInt = 1; ntemp--;} break;
+case 44:
+# line 339 "lua.stx"
+{ code_byte(DIVOP);  yyval.vInt = 1; ntemp--;} break;
+case 45:
+# line 340 "lua.stx"
+{ code_byte(CONCOP);  yyval.vInt = 1; ntemp--;} break;
+case 46:
+# line 341 "lua.stx"
+{ yyval.vInt = 1; } break;
+case 47:
+# line 342 "lua.stx"
+{ code_byte(MINUSOP); yyval.vInt = 1;} break;
+case 48:
+# line 344 "lua.stx"
+{
+      code_byte(PUSHBYTE);
+      yyval.pByte = pc; code_byte(0);
+      incr_ntemp();
+      code_byte(CREATEARRAY);
+     } break;
+case 49:
+# line 351 "lua.stx"
+{
+      *(yypvt[-2].pByte) = yypvt[-0].vInt; 
+      if (yypvt[-1].vLong < 0)	/* there is no function to be called */
+      {
+       yyval.vInt = 1;
+      }
+      else
+      {
+       lua_pushvar (yypvt[-1].vLong+1);
+       code_byte(PUSHMARK);
+       incr_ntemp();
+       code_byte(PUSHOBJECT);
+       incr_ntemp();
+       code_byte(CALLFUNC); 
+       ntemp -= 4;
+       yyval.vInt = 0;
+       if (lua_debug)
+       {
+        align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+       }
+      }
+     } break;
+case 50:
+# line 374 "lua.stx"
+{ 
+      code_byte(CREATEARRAY);
+      yyval.vInt = 1;
+     } break;
+case 51:
+# line 378 "lua.stx"
+{ lua_pushvar (yypvt[-0].vLong); yyval.vInt = 1;} break;
+case 52:
+# line 379 "lua.stx"
+{ code_number(yypvt[-0].vFloat); yyval.vInt = 1; } break;
+case 53:
+# line 381 "lua.stx"
+{
+      align(Word);
+      code_byte(PUSHSTRING);
+      code_word(yypvt[-0].vWord);
+      yyval.vInt = 1;
+      incr_ntemp();
+     } break;
+case 54:
+# line 388 "lua.stx"
+{code_byte(PUSHNIL); yyval.vInt = 1; incr_ntemp();} break;
+case 55:
+# line 390 "lua.stx"
+{
+      yyval.vInt = 0;
+      if (lua_debug)
+      {
+       align(Word); code_byte(SETLINE); code_word(lua_linenumber);
+      }
+     } break;
+case 56:
+# line 397 "lua.stx"
+{ code_byte(NOTOP);  yyval.vInt = 1;} break;
+case 57:
+# line 398 "lua.stx"
+{code_byte(POP); ntemp--;} break;
+case 58:
+# line 399 "lua.stx"
+{ 
+      *(yypvt[-2].pByte) = ONFJMP;
+      *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1);
+      yyval.vInt = 1;
+     } break;
+case 59:
+# line 404 "lua.stx"
+{code_byte(POP); ntemp--;} break;
+case 60:
+# line 405 "lua.stx"
+{ 
+      *(yypvt[-2].pByte) = ONTJMP;
+      *((Word *)(yypvt[-2].pByte+1)) = pc - (yypvt[-2].pByte + sizeof(Word)+1);
+      yyval.vInt = 1;
+     } break;
+case 61:
+# line 412 "lua.stx"
+{ code_byte(PUSHNIL); incr_ntemp();} break;
+case 63:
+# line 416 "lua.stx"
+{code_byte(PUSHMARK); yyval.vInt = ntemp; incr_ntemp();} break;
+case 64:
+# line 417 "lua.stx"
+{ code_byte(CALLFUNC); ntemp = yypvt[-3].vInt-1;} break;
+case 65:
+# line 419 "lua.stx"
+{lua_pushvar (yypvt[-0].vLong); } break;
+case 66:
+# line 422 "lua.stx"
+{ yyval.vInt = 1; } break;
+case 67:
+# line 423 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
+case 68:
+# line 426 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
+case 69:
+# line 427 "lua.stx"
+{if (!yypvt[-1].vInt){lua_codeadjust (ntemp+1); incr_ntemp();}} break;
+case 70:
+# line 428 "lua.stx"
+{yyval.vInt = yypvt[-0].vInt;} break;
+case 73:
+# line 435 "lua.stx"
+{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break;
+case 74:
+# line 436 "lua.stx"
+{localvar[nlocalvar]=yypvt[-0].vWord; incr_nlocalvar();} break;
+case 75:
+# line 439 "lua.stx"
+{yyval.vLong=-1;} break;
+case 76:
+# line 440 "lua.stx"
+{yyval.vLong=yypvt[-0].vWord;} break;
+case 77:
+# line 443 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; } break;
+case 78:
+# line 444 "lua.stx"
+{ yyval.vInt = yypvt[-1].vInt; } break;
+case 79:
+# line 447 "lua.stx"
+{ yyval.vInt = 0; } break;
+case 80:
+# line 448 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
+case 81:
+# line 451 "lua.stx"
+{yyval.vInt=1;} break;
+case 82:
+# line 452 "lua.stx"
+{yyval.vInt=yypvt[-2].vInt+1;} break;
+case 83:
+# line 456 "lua.stx"
+{
+            align(Word); 
+            code_byte(PUSHSTRING);
+	    code_word(lua_findconstant (s_name(yypvt[-0].vWord)));
+            incr_ntemp();
+	   } break;
+case 84:
+# line 463 "lua.stx"
+{
+	    code_byte(STOREFIELD);
+	    ntemp-=2;
+	   } break;
+case 85:
+# line 469 "lua.stx"
+{ yyval.vInt = 0; } break;
+case 86:
+# line 470 "lua.stx"
+{ yyval.vInt = yypvt[-0].vInt; } break;
+case 87:
+# line 473 "lua.stx"
+{ code_number(1); } break;
+case 88:
+# line 473 "lua.stx"
+{yyval.vInt=1;} break;
+case 89:
+# line 474 "lua.stx"
+{ code_number(yypvt[-1].vInt+1); } break;
+case 90:
+# line 475 "lua.stx"
+{yyval.vInt=yypvt[-3].vInt+1;} break;
+case 91:
+# line 479 "lua.stx"
+{
+	    code_byte(STOREFIELD);
+	    ntemp-=2;
+	   } break;
+case 92:
+# line 486 "lua.stx"
+{
+	   nvarbuffer = 0; 
+           varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
+	   yyval.vInt = (yypvt[-0].vLong == 0) ? 1 : 0;
+	  } break;
+case 93:
+# line 492 "lua.stx"
+{ 
+           varbuffer[nvarbuffer] = yypvt[-0].vLong; incr_nvarbuffer();
+	   yyval.vInt = (yypvt[-0].vLong == 0) ? yypvt[-2].vInt + 1 : yypvt[-2].vInt;
+	  } break;
+case 94:
+# line 499 "lua.stx"
+{ 
+	   int local = lua_localname (yypvt[-0].vWord);
+	   if (local == -1)	/* global var */
+	    yyval.vLong = yypvt[-0].vWord + 1;		/* return positive value */
+           else
+	    yyval.vLong = -(local+1);		/* return negative value */
+	  } break;
+case 95:
+# line 507 "lua.stx"
+{lua_pushvar (yypvt[-0].vLong);} break;
+case 96:
+# line 508 "lua.stx"
+{
+	   yyval.vLong = 0;		/* indexed variable */
+	  } break;
+case 97:
+# line 511 "lua.stx"
+{lua_pushvar (yypvt[-0].vLong);} break;
+case 98:
+# line 512 "lua.stx"
+{
+	   align(Word);
+	   code_byte(PUSHSTRING);
+	   code_word(lua_findconstant (s_name(yypvt[-0].vWord))); incr_ntemp();
+	   yyval.vLong = 0;		/* indexed variable */
+	  } break;
+case 99:
+# line 520 "lua.stx"
+{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break;
+case 100:
+# line 521 "lua.stx"
+{localvar[nlocalvar]=yypvt[-1].vWord; incr_nlocalvar();} break;
+case 101:
+# line 524 "lua.stx"
+{ code_byte(PUSHNIL); } break;
+case 102:
+# line 525 "lua.stx"
+{ntemp = 0;} break;
+case 104:
+# line 528 "lua.stx"
+{lua_debug = yypvt[-0].vInt;} break;
+	}
+	goto yystack;		/* reset registers in driver code */
+}

+ 35 - 0
y_tab.h

@@ -0,0 +1,35 @@
+
+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