"exp" changed to "exp0" to avoid problems with math.h.

better error messages for wrong tokens

bugs

@@ -0,0 +1,43 @@
+** lua.stx / llex.c
+Tue Dec  2 10:45:48 EDT 1997
+>> BUG: "lastline" was not reset on function entry, so debug information
+>> started only in the 2nd line of a function.
+
+
+--- Version 3.1 alpha
+
+** lua.c
+Thu Jan 15 14:34:58 EDT 1998
+>> must include "stdlib.h" (for "exit()").
+
+** lbuiltin.c / lobject.h
+Thu Jan 15 14:34:58 EDT 1998
+>> MAX_WORD may be bigger than MAX_INT
+
+
+** llex.c
+Mon Jan 19 18:17:18 EDT 1998
+>> wrong line number (+1) in error report when file starts with "#..."
+
+** lstrlib.c
+Tue Jan 27 15:27:49 EDT 1998
+>> formats like "%020d" were considered too big (3 digits); moreover,
+>> some sistems limit printf to at most 500 chars, so we can limit sizes
+>> to 2 digits (99).
+
+** lapi.c
+Tue Jan 27 17:12:36 EDT 1998
+>> "lua_getstring" may create a new string, so should check GC
+
+** lstring.c / ltable.c
+Wed Jan 28 14:48:12 EDT 1998
+>> tables can become full of "emptys" slots, and keep growing without limits.
+
+** lstrlib.c
+Mon Mar  9 15:26:09 EST 1998
+>> gsub('a', '(b?)%1*' ...) loops (because the capture is empty).
+
+** lstrlib.c
+Mon May 18 19:20:00 EST 1998
+>> arguments for "format" 'x', 'X', 'o' and 'u' must be unsigned int.
+

exscript

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

hash.c

@@ -1,345 +0,0 @@
-/*
-** hash.c
-** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
-*/
-
-char *rcs_hash="$Id: hash.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
-
-#include <string.h>
-#include <stdlib.h>
-
-#include "mm.h"
-
-#include "opcode.h"
-#include "hash.h"
-#include "inout.h"
-#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 markarray(t)    ((t)->mark)
-#define ref_tag(n)	(tag(&(n)->ref))
-#define ref_nvalue(n)	(nvalue(&(n)->ref))
-#define ref_svalue(n)	(svalue(&(n)->ref))
-
-
-typedef struct ArrayList
-{
- Hash *array;
- struct ArrayList *next;
-} ArrayList;
-
-static ArrayList *listhead = NULL;
-
-static int head (Hash *t, Object *ref)		/* hash function */
-{
- if (tag(ref) == T_NUMBER) return (((int)nvalue(ref))%nhash(t));
- 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.
-*/
-static Hash *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
-*/
-static void hashdelete (Hash *h)
-{
- int i;
- for (i=0; i<nhash(h); i++)
-  freelist (list(h,i));
- free (nodelist(h));
- free(h);
-}
-
-
-/*
-** Mark a hash and check its elements 
-*/
-void lua_hashmark (Hash *h)
-{
- if (markarray(h) == 0)
- {
-  int i;
-  markarray(h) = 1;
-  for (i=0; i<nhash(h); i++)
-  {
-   Node *n;
-   for (n = list(h,i); n != NULL; n = n->next)
-   {
-    lua_markobject(&n->ref);
-    lua_markobject(&n->val);
-   }
-  }
- } 
-}
- 
-/*
-** Garbage collection to arrays
-** Delete all unmarked arrays.
-*/
-void lua_hashcollector (void)
-{
- ArrayList *curr = listhead, *prev = NULL;
- while (curr != NULL)
- {
-  ArrayList *next = curr->next;
-  if (markarray(curr->array) != 1)
-  {
-   if (prev == NULL) listhead = next;
-   else              prev->next = next;
-   hashdelete(curr->array);
-   free(curr);
-  }
-  else
-  {
-   markarray(curr->array) = 0;
-   prev = curr;
-  }
-  curr = next;
- }
-}
-
-
-/*
-** Create a new array
-** This function insert the new array at array list. It also
-** execute garbage collection if the number of array created
-** exceed a pre-defined range.
-*/
-Hash *lua_createarray (int nhash)
-{
- ArrayList *new = new(ArrayList);
- if (new == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
- new->array = hashcreate(nhash);
- if (new->array == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
-
- if (lua_nentity == lua_block)
-  lua_pack(); 
-
- lua_nentity++;
- new->next = listhead;
- listhead = new;
- return new->array;
-}
-
-
-/*
-** If the hash node is present, return its pointer, otherwise create a new
-** node for the given reference and also return its pointer.
-** 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);
-}
-
-
-/*
-** 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.
-*/
-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)
-   {
-    if (tag(&list(a,i)->val) != T_NIL)
-    {
-     lua_pushobject (&list(a,i)->ref);
-     lua_pushobject (&list(a,i)->val);
-     return;
-    }
-    else
-    {
-     Node *next = list(a,i)->next;
-     while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
-     if (next != NULL)
-     {
-      lua_pushobject (&next->ref);
-      lua_pushobject (&next->val);
-      return;
-     }
-    }
-   }
-  }
- }
- 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");
-  }
- }
-}
-

hash.h

@@ -1,32 +0,0 @@
-/*
-** hash.h
-** hash manager for lua
-** Luiz Henrique de Figueiredo - 17 Aug 90
-** $Id: hash.h,v 1.1 1993/12/17 18:41:19 celes Exp celes $
-*/
-
-#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;
-
-
-Hash    *lua_createarray (int nhash);
-void     lua_hashmark (Hash *h);
-void     lua_hashcollector (void);
-Object 	*lua_hashdefine (Hash *t, Object *ref);
-void     lua_next (void);
-
-#endif

inout.c

@@ -1,178 +0,0 @@
-/*
-** inout.c
-** Provide function to realise the input/output function and debugger 
-** facilities.
-*/
-
-char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
-
-#include <stdio.h>
-#include <string.h>
-
-#include "opcode.h"
-#include "hash.h"
-#include "inout.h"
-#include "table.h"
-#include "tree.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 get the next character from the input string
-*/
-static int stringinput (void)
-{
- st++;
- return (*(st-1));
-}
-
-/*
-** 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);
- 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)
- {
-  lua_delfile();
-  fclose (fp);
-  fp = NULL;
- }
-}
-
-/*
-** Function to open a string to be input unit
-*/
-int lua_openstring (char *s)
-{
- lua_linenumber = 1;
- lua_setinput (stringinput);
- st = s;
- {
-  char sn[64];
-  sprintf (sn, "String: %10.10s...", s);
-  if (lua_addfile (sn)) return 1;
- }
- return 0;
-}
-
-/*
-** Function to close an opened string
-*/
-void lua_closestring (void)
-{
- lua_delfile();
-}
-
-/*
-** Call user function to handle error messages, if registred. Or report error
-** using standard function (fprintf).
-*/
-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, lua_varname(funcstack[nfuncstack-1].function),
-  	 lua_file[funcstack[nfuncstack-1].file]);
-   sprintf (strchr(msg,0), "\n\tactive stack\n");
-   for (i=nfuncstack-1; i>=0; i--)
-    sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n", 
-                            lua_varname(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);
-}
-

inout.h

@@ -1,21 +0,0 @@
-/*
-** $Id: $
-*/
-
-
-#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);
-void lua_closestring  (void);
-int  lua_pushfunction (int file, int function);
-void lua_popfunction  (void);
-void lua_reportbug    (char *s);
-
-#endif

iolib.c

@@ -1,479 +0,0 @@
-/*
-** iolib.c
-** Input/output library to LUA
-*/
-
-char *rcs_iolib="$Id: iolib.c,v 1.3 1994/03/28 15:14:02 celes Exp celes $";
-
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <ctype.h>
-#include <sys/stat.h>
-#ifdef __GNUC__
-#include <floatingpoint.h>
-#endif
-
-#include "mm.h"
-
-#include "lua.h"
-
-static FILE *in=stdin, *out=stdout;
-
-/*
-** 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);
-   }
-  }
- }
-}
-
-
-/*
-** Open a file to write appended.
-** LUA interface:
-**			status = appendto (filename)
-** where:
-**			status = 2 -> success (already exist)
-**			status = 1 -> success (new file)
-**			status = 0 -> error
-*/
-static void io_appendto (void)
-{
- lua_Object o = lua_getparam (1);
- if (o == NULL)			/* restore standart output */
- {
-  if (out != stdout)
-  {
-   fclose (out);
-   out = stdout;
-  }
-  lua_pushnumber (1);
- }
- else
- {
-  if (!lua_isstring (o))
-  {
-   lua_error ("incorrect argument to function 'appendto`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   int r;
-   FILE *fp;
-   struct stat st;
-   if (stat(lua_getstring(o), &st) == -1) r = 1;
-   else                                   r = 2;
-   fp = fopen (lua_getstring(o),"a");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (r);
-   }
-  }
- }
-}
-
-
-
-/*
-** Read a variable. On error put nil on stack.
-** LUA interface:
-**			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 || !lua_isstring(o))	/* free format */
- {
-  int c;
-  char s[256];
-  while (isspace(c=fgetc(in)))
-   ;
-  if (c == '\"')
-  {
-   int c, n=0;
-   while((c = fgetc(in)) != '\"')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
-    }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else if (c == '\'')
-  {
-   int c, n=0;
-   while((c = fgetc(in)) != '\'')
-   {
-    if (c == EOF)
-    {
-     lua_pushnil ();
-     return;
-    }
-    s[n++] = c;
-   }
-   s[n] = 0;
-  }
-  else
-  {
-   char *ptr;
-   double d;
-   ungetc (c, in);
-   if (fscanf (in, "%s", s) != 1)
-   {
-    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);
-   if (fgets (s, m, in) == NULL)
-   {
-    lua_pushnil();
-    return;
-   }
-   else
-   {
-    if (s[strlen(s)-1] == '\n')
-     s[strlen(s)-1] = 0;
-   }
-   switch (tolower(t))
-   {
-    case 'i':
-    {
-     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;
-     if (fscanf (in, "%ld", &l) == EOF)
-       lua_pushnil();
-       else lua_pushnumber(l);
-    }
-    break;
-    case 'f': case 'g': case 'e':
-    {
-     float f;
-     if (fscanf (in, "%f", &f) == EOF)
-       lua_pushnil();
-       else lua_pushnumber(f);
-    }
-    break;
-    default: 
-    {
-     char s[256];
-     if (fscanf (in, "%s", s) == EOF)
-       lua_pushnil();
-       else 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 "system".
-** Return the result of execution.
-*/
-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
- {
-  int res = system(lua_getstring(o));
-  lua_pushnumber (res);
- }
- 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 ("appendto", io_appendto);
- lua_register ("read",     io_read);
- lua_register ("write",    io_write);
- lua_register ("execute",  io_execute);
- lua_register ("remove",   io_remove);
-}

lapi.c

@@ -0,0 +1,631 @@
+/*
+** $Id: lapi.c,v 1.24 1998/03/09 21:49:52 roberto Exp roberto $
+** Lua API
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+#include <string.h>
+
+#include "lapi.h"
+#include "lauxlib.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lua.h"
+#include "luadebug.h"
+#include "lvm.h"
+
+
+char lua_ident[] = "$Lua: " LUA_VERSION " " LUA_COPYRIGHT " $\n"
+                   "$Autores:  " LUA_AUTHORS " $";
+
+
+
+TObject *luaA_Address (lua_Object o)
+{
+  return Address(o);
+}
+
+
+static int normalized_type (TObject *o)
+{
+  int t = ttype(o);
+  switch (t) {
+    case LUA_T_PMARK:
+      return LUA_T_PROTO;
+    case LUA_T_CMARK:
+      return LUA_T_CPROTO;
+    case LUA_T_CLMARK:
+      return LUA_T_CLOSURE;
+    default:
+      return t;
+  }
+}
+
+
+static void set_normalized (TObject *d, TObject *s)
+{
+  d->value = s->value;
+  d->ttype = normalized_type(s);
+}
+
+
+static TObject *luaA_protovalue (TObject *o)
+{
+  return (normalized_type(o) == LUA_T_CLOSURE) ?  protovalue(o) : o;
+}
+
+
+void luaA_packresults (void)
+{
+  luaV_pack(L->Cstack.lua2C, L->Cstack.num, L->stack.top);
+  incr_top;
+}
+
+
+int luaA_passresults (void)
+{
+  luaD_checkstack(L->Cstack.num);
+  memcpy(L->stack.top, L->Cstack.lua2C+L->stack.stack,
+         L->Cstack.num*sizeof(TObject));
+  L->stack.top += L->Cstack.num;
+  return L->Cstack.num;
+}
+
+
+static void checkCparams (int nParams)
+{
+  if (L->stack.top-L->stack.stack < L->Cstack.base+nParams)
+    lua_error("API error - wrong number of arguments in C2lua stack");
+}
+
+
+static lua_Object put_luaObject (TObject *o)
+{
+  luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
+  L->stack.stack[L->Cstack.base++] = *o;
+  return L->Cstack.base;  /* this is +1 real position (see Ref) */
+}
+
+
+static lua_Object put_luaObjectonTop (void)
+{
+  luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
+  L->stack.stack[L->Cstack.base++] = *(--L->stack.top);
+  return L->Cstack.base;  /* this is +1 real position (see Ref) */
+}
+
+
+lua_Object lua_pop (void)
+{
+  checkCparams(1);
+  return put_luaObjectonTop();
+}
+
+
+/*
+** Get a parameter, returning the object handle or LUA_NOOBJECT on error.
+** 'number' must be 1 to get the first parameter.
+*/
+lua_Object lua_lua2C (int number)
+{
+  if (number <= 0 || number > L->Cstack.num) return LUA_NOOBJECT;
+  /* Ref(L->stack.stack+(L->Cstack.lua2C+number-1)) ==
+     L->stack.stack+(L->Cstack.lua2C+number-1)-L->stack.stack+1 == */
+  return L->Cstack.lua2C+number;
+}
+
+
+int lua_callfunction (lua_Object function)
+{
+  if (function == LUA_NOOBJECT)
+    return 1;
+  else {
+    luaD_openstack((L->stack.top-L->stack.stack)-L->Cstack.base);
+    set_normalized(L->stack.stack+L->Cstack.base, Address(function));
+    return luaD_protectedrun(MULT_RET);
+  }
+}
+
+
+lua_Object lua_gettagmethod (int tag, char *event)
+{
+  return put_luaObject(luaT_gettagmethod(tag, event));
+}
+
+
+lua_Object lua_settagmethod (int tag, char *event)
+{
+  checkCparams(1);
+  luaT_settagmethod(tag, event, L->stack.top-1);
+  return put_luaObjectonTop();
+}
+
+
+lua_Object lua_seterrormethod (void)
+{
+  TObject temp = L->errorim;
+  checkCparams(1);
+  L->errorim = *(--L->stack.top);
+  return put_luaObject(&temp);
+}
+
+
+lua_Object lua_gettable (void)
+{
+  checkCparams(2);
+  luaV_gettable();
+  return put_luaObjectonTop();
+}
+
+
+lua_Object lua_rawgettable (void)
+{
+  checkCparams(2);
+  if (ttype(L->stack.top-2) != LUA_T_ARRAY)
+    lua_error("indexed expression not a table in rawgettable");
+  else {
+    TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1);
+    --L->stack.top;
+    if (h != NULL)
+      *(L->stack.top-1) = *h;
+    else
+      ttype(L->stack.top-1) = LUA_T_NIL;
+  }
+  return put_luaObjectonTop();
+}
+
+
+void lua_settable (void)
+{
+  checkCparams(3);
+  luaV_settable(L->stack.top-3, 1);
+}
+
+
+void lua_rawsettable (void)
+{
+  checkCparams(3);
+  luaV_settable(L->stack.top-3, 0);
+}
+
+
+lua_Object lua_createtable (void)
+{
+  TObject o;
+  luaC_checkGC();
+  avalue(&o) = luaH_new(0);
+  ttype(&o) = LUA_T_ARRAY;
+  return put_luaObject(&o);
+}
+
+
+lua_Object lua_getglobal (char *name)
+{
+  luaD_checkstack(2);  /* may need that to call T.M. */
+  luaV_getglobal(luaS_new(name));
+  return put_luaObjectonTop();
+}
+
+
+lua_Object lua_rawgetglobal (char *name)
+{
+  TaggedString *ts = luaS_new(name);
+  return put_luaObject(&ts->u.s.globalval);
+}
+
+
+void lua_setglobal (char *name)
+{
+  checkCparams(1);
+  luaD_checkstack(2);  /* may need that to call T.M. */
+  luaV_setglobal(luaS_new(name));
+}
+
+
+void lua_rawsetglobal (char *name)
+{
+  TaggedString *ts = luaS_new(name);
+  checkCparams(1);
+  luaS_rawsetglobal(ts, --L->stack.top);
+}
+
+
+
+int lua_isnil (lua_Object o)
+{
+  return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL);
+}
+
+int lua_istable (lua_Object o)
+{
+  return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY);
+}
+
+int lua_isuserdata (lua_Object o)
+{
+  return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA);
+}
+
+int lua_iscfunction (lua_Object o)
+{
+  return (lua_tag(o) == LUA_T_CPROTO);
+}
+
+int lua_isnumber (lua_Object o)
+{
+  return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0);
+}
+
+int lua_isstring (lua_Object o)
+{
+  int t = lua_tag(o);
+  return (t == LUA_T_STRING) || (t == LUA_T_NUMBER);
+}
+
+int lua_isfunction (lua_Object o)
+{
+  int t = lua_tag(o);
+  return (t == LUA_T_PROTO) || (t == LUA_T_CPROTO);
+}
+
+
+double lua_getnumber (lua_Object object)
+{
+ if (object == LUA_NOOBJECT) return 0.0;
+ if (tonumber(Address(object))) return 0.0;
+ else return (nvalue(Address(object)));
+}
+
+char *lua_getstring (lua_Object object)
+{
+  luaC_checkGC();  /* "tostring" may create a new string */
+  if (object == LUA_NOOBJECT || tostring(Address(object)))
+    return NULL;
+  else return (svalue(Address(object)));
+}
+
+long lua_strlen (lua_Object object)
+{
+  luaC_checkGC();  /* "tostring" may create a new string */
+  if (object == LUA_NOOBJECT || tostring(Address(object)))
+    return 0L;
+  else return (tsvalue(Address(object))->u.s.len);
+}
+
+void *lua_getuserdata (lua_Object object)
+{
+  if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA)
+    return NULL;
+  else return tsvalue(Address(object))->u.d.v;
+}
+
+lua_CFunction lua_getcfunction (lua_Object object)
+{
+  if (!lua_iscfunction(object))
+    return NULL;
+  else return fvalue(luaA_protovalue(Address(object)));
+}
+
+
+void lua_pushnil (void)
+{
+  ttype(L->stack.top) = LUA_T_NIL;
+  incr_top;
+}
+
+void lua_pushnumber (double n)
+{
+  ttype(L->stack.top) = LUA_T_NUMBER;
+  nvalue(L->stack.top) = n;
+  incr_top;
+}
+
+void lua_pushlstring (char *s, long len)
+{
+  tsvalue(L->stack.top) = luaS_newlstr(s, len);
+  ttype(L->stack.top) = LUA_T_STRING;
+  incr_top;
+  luaC_checkGC();
+}
+
+void lua_pushstring (char *s)
+{
+  if (s == NULL)
+    lua_pushnil();
+  else
+    lua_pushlstring(s, strlen(s));
+}
+
+void lua_pushcclosure (lua_CFunction fn, int n)
+{
+  if (fn == NULL)
+    lua_error("API error - attempt to push a NULL Cfunction");
+  checkCparams(n);
+  ttype(L->stack.top) = LUA_T_CPROTO;
+  fvalue(L->stack.top) = fn;
+  incr_top;
+  luaV_closure(n);
+  luaC_checkGC();
+}
+
+void lua_pushusertag (void *u, int tag)
+{
+  if (tag < 0 && tag != LUA_ANYTAG)
+    luaT_realtag(tag);  /* error if tag is not valid */
+  tsvalue(L->stack.top) = luaS_createudata(u, tag);
+  ttype(L->stack.top) = LUA_T_USERDATA;
+  incr_top;
+  luaC_checkGC();
+}
+
+void luaA_pushobject (TObject *o)
+{
+  *L->stack.top = *o;
+  incr_top;
+}
+
+void lua_pushobject (lua_Object o)
+{
+  if (o == LUA_NOOBJECT)
+    lua_error("API error - attempt to push a NOOBJECT");
+  else {
+    set_normalized(L->stack.top, Address(o));
+    incr_top;
+  }
+}
+
+
+int lua_tag (lua_Object lo)
+{
+  if (lo == LUA_NOOBJECT)
+     return LUA_T_NIL;
+  else {
+    TObject *o = Address(lo);
+    int t;
+    switch (t = ttype(o)) {
+      case LUA_T_USERDATA:
+        return o->value.ts->u.d.tag;
+      case LUA_T_ARRAY:
+        return o->value.a->htag;
+      case LUA_T_PMARK:
+        return LUA_T_PROTO;
+      case LUA_T_CMARK:
+        return LUA_T_CPROTO;
+      case LUA_T_CLOSURE: case LUA_T_CLMARK:
+        return o->value.cl->consts[0].ttype;
+#ifdef DEBUG
+      case LUA_T_LINE:
+        LUA_INTERNALERROR("invalid type");
+#endif
+      default:
+        return t;
+    }
+  }
+}
+
+
+void lua_settag (int tag)
+{
+  checkCparams(1);
+  luaT_realtag(tag);
+  switch (ttype(L->stack.top-1)) {
+    case LUA_T_ARRAY:
+      (L->stack.top-1)->value.a->htag = tag;
+      break;
+    case LUA_T_USERDATA:
+      (L->stack.top-1)->value.ts->u.d.tag = tag;
+      break;
+    default:
+      luaL_verror("cannot change the tag of a %.20s",
+                  luaO_typenames[-ttype((L->stack.top-1))]);
+  }
+  L->stack.top--;
+}
+
+
+/*
+** =======================================================
+** Debug interface
+** =======================================================
+*/
+
+
+/* Hooks */
+lua_CHFunction lua_callhook = NULL;
+lua_LHFunction lua_linehook = NULL;
+
+
+lua_Function lua_stackedfunction (int level)
+{
+  StkId i;
+  for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--) {
+    int t = L->stack.stack[i].ttype;
+    if (t == LUA_T_CLMARK || t == LUA_T_PMARK || t == LUA_T_CMARK)
+      if (level-- == 0)
+        return Ref(L->stack.stack+i);
+  }
+  return LUA_NOOBJECT;
+}
+
+
+int lua_currentline (lua_Function func)
+{
+  TObject *f = Address(func);
+  return (f+1 < L->stack.top && (f+1)->ttype == LUA_T_LINE) ?
+             (f+1)->value.i : -1;
+}
+
+
+lua_Object lua_getlocal (lua_Function func, int local_number, char **name)
+{
+  /* check whether func is a Lua function */
+  if (lua_tag(func) != LUA_T_PROTO)
+    return LUA_NOOBJECT;
+  else {
+    TObject *f = Address(func);
+    TProtoFunc *fp = luaA_protovalue(f)->value.tf;
+    *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
+    if (*name) {
+      /* if "*name", there must be a LUA_T_LINE */
+      /* therefore, f+2 points to function base */
+      return Ref((f+2)+(local_number-1));
+    }
+    else
+      return LUA_NOOBJECT;
+  }
+}
+
+
+int lua_setlocal (lua_Function func, int local_number)
+{
+  /* check whether func is a Lua function */
+  if (lua_tag(func) != LUA_T_PROTO)
+    return 0;
+  else {
+    TObject *f = Address(func);
+    TProtoFunc *fp = luaA_protovalue(f)->value.tf;
+    char *name = luaF_getlocalname(fp, local_number, lua_currentline(func));
+    checkCparams(1);
+    --L->stack.top;
+    if (name) {
+      /* if "name", there must be a LUA_T_LINE */
+      /* therefore, f+2 points to function base */
+      *((f+2)+(local_number-1)) = *L->stack.top;
+      return 1;
+    }
+    else
+      return 0;
+  }
+}
+
+
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
+{
+  if (!lua_isfunction(func))
+    lua_error("API - `funcinfo' called with a non-function value");
+  else {
+    TObject *f = luaA_protovalue(Address(func));
+    if (normalized_type(f) == LUA_T_PROTO) {
+      *filename = tfvalue(f)->fileName->str;
+      *linedefined = tfvalue(f)->lineDefined;
+    }
+    else {
+      *filename = "(C)";
+      *linedefined = -1;
+    }
+  }
+}
+
+
+static int checkfunc (TObject *o)
+{
+  return luaO_equalObj(o, L->stack.top);
+}
+
+
+char *lua_getobjname (lua_Object o, char **name)
+{ /* try to find a name for given function */
+  set_normalized(L->stack.top, Address(o)); /* to be accessed by "checkfunc */
+  if ((*name = luaT_travtagmethods(checkfunc)) != NULL)
+    return "tag-method";
+  else if ((*name = luaS_travsymbol(checkfunc)) != NULL)
+    return "global";
+  else return "";
+}
+
+/*
+** =======================================================
+** BLOCK mechanism
+** =======================================================
+*/
+
+
+void lua_beginblock (void)
+{
+  if (L->numCblocks >= MAX_C_BLOCKS)
+    lua_error("too many nested blocks");
+  L->Cblocks[L->numCblocks] = L->Cstack;
+  L->numCblocks++;
+}
+
+void lua_endblock (void)
+{
+  --L->numCblocks;
+  L->Cstack = L->Cblocks[L->numCblocks];
+  luaD_adjusttop(L->Cstack.base);
+}
+
+
+
+int lua_ref (int lock)
+{
+  int ref;
+  checkCparams(1);
+  ref = luaC_ref(L->stack.top-1, lock);
+  L->stack.top--;
+  return ref;
+}
+
+
+
+lua_Object lua_getref (int ref)
+{
+  TObject *o = luaC_getref(ref);
+  return (o ? put_luaObject(o) : LUA_NOOBJECT);
+}
+
+
+/*
+** =======================================================
+** Derived functions
+** =======================================================
+*/
+int (lua_call) (char *name) { return lua_call(name); }
+
+void (lua_pushref) (int ref) { lua_pushref(ref); }
+
+int (lua_refobject) (lua_Object o, int l) { return lua_refobject(o, l); }
+
+void (lua_register) (char *n, lua_CFunction f) { lua_register(n, f); }
+
+void (lua_pushuserdata) (void *u) { lua_pushuserdata(u); }
+
+void (lua_pushcfunction) (lua_CFunction f) { lua_pushcfunction(f); }
+
+int (lua_clonetag) (int t) { return lua_clonetag(t); }
+
+
+
+
+#ifdef LUA_COMPAT2_5
+/*
+** API: set a function as a fallback
+*/
+
+static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults)
+{
+  StkId base = (L->stack.top-L->stack.stack)-nParams;
+  luaD_openstack(nParams);
+  L->stack.stack[base].ttype = LUA_T_CPROTO;
+  L->stack.stack[base].value.f = f;
+  luaD_call(base+1, nResults);
+}
+
+lua_Object lua_setfallback (char *name, lua_CFunction fallback)
+{
+  lua_pushstring(name);
+  lua_pushcfunction(fallback);
+  do_unprotectedrun(luaT_setfallback, 2, 1);
+  return put_luaObjectonTop();
+}
+#endif
+

lapi.h

@@ -0,0 +1,20 @@
+/*
+** $Id: lapi.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
+** Auxiliary functions from Lua API
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lapi_h
+#define lapi_h
+
+
+#include "lua.h"
+#include "lobject.h"
+
+
+TObject *luaA_Address (lua_Object o);
+void luaA_pushobject (TObject *o);
+void luaA_packresults (void);
+int luaA_passresults (void);
+
+#endif

lauxlib.c

@@ -0,0 +1,111 @@
+/*
+** $Id: lauxlib.c,v 1.11 1998/06/18 16:57:03 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <string.h>
+
+/* Please Notice: This file uses only the official API of Lua
+** Any function declared here could be written as an application
+** function. With care, these functions can be used by other libraries.
+*/
+#include "lauxlib.h"
+#include "lua.h"
+#include "luadebug.h"
+
+
+
+int luaL_findstring (char *name, char *list[]) {
+  int i;
+  for (i=0; list[i]; i++)
+    if (strcmp(list[i], name) == 0)
+      return i;
+  return -1;  /* name not found */
+}
+
+void luaL_argerror (int numarg, char *extramsg)
+{
+  char *funcname;
+  lua_getobjname(lua_stackedfunction(0), &funcname);
+  if (funcname == NULL)
+    funcname = "???";
+  if (extramsg == NULL)
+    luaL_verror("bad argument #%d to function `%.50s'", numarg, funcname);
+  else
+    luaL_verror("bad argument #%d to function `%.50s' (%.100s)",
+                    numarg, funcname, extramsg);
+}
+
+char *luaL_check_lstr (int numArg, long *len)
+{
+  lua_Object o = lua_getparam(numArg);
+  luaL_arg_check(lua_isstring(o), numArg, "string expected");
+  if (len) *len = lua_strlen(o);
+  return lua_getstring(o);
+}
+
+char *luaL_opt_lstr (int numArg, char *def, long *len)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              luaL_check_lstr(numArg, len);
+}
+
+double luaL_check_number (int numArg)
+{
+  lua_Object o = lua_getparam(numArg);
+  luaL_arg_check(lua_isnumber(o), numArg, "number expected");
+  return lua_getnumber(o);
+}
+
+
+double luaL_opt_number (int numArg, double def)
+{
+  return (lua_getparam(numArg) == LUA_NOOBJECT) ? def :
+                              luaL_check_number(numArg);
+}  
+
+
+lua_Object luaL_tablearg (int arg)
+{
+  lua_Object o = lua_getparam(arg);
+  luaL_arg_check(lua_istable(o), arg, "table expected");
+  return o;
+}
+
+lua_Object luaL_functionarg (int arg)
+{
+  lua_Object o = lua_getparam(arg);
+  luaL_arg_check(lua_isfunction(o), arg, "function expected");
+  return o;
+}
+
+lua_Object luaL_nonnullarg (int numArg)
+{
+  lua_Object o = lua_getparam(numArg);
+  luaL_arg_check(o != LUA_NOOBJECT, numArg, "value expected");
+  return o;
+}
+
+void luaL_openlib (struct luaL_reg *l, int n)
+{
+  int i;
+  lua_open();  /* make sure lua is already open */
+  for (i=0; i<n; i++)
+    lua_register(l[i].name, l[i].func);
+}
+
+
+void luaL_verror (char *fmt, ...)
+{
+  char buff[500];
+  va_list argp;
+  va_start(argp, fmt);
+  vsprintf(buff, fmt, argp);
+  va_end(argp);
+  lua_error(buff);
+}
+

lauxlib.h

@@ -0,0 +1,47 @@
+/*
+** $Id: lauxlib.h,v 1.8 1998/06/18 16:57:03 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef auxlib_h
+#define auxlib_h
+
+
+#include "lua.h"
+
+
+struct luaL_reg {
+  char *name;
+  lua_CFunction func;
+};
+
+
+#define luaL_arg_check(cond,numarg,extramsg) if (!(cond)) \
+                                               luaL_argerror(numarg,extramsg)
+
+void luaL_openlib (struct luaL_reg *l, int n);
+void luaL_argerror (int numarg, char *extramsg);
+#define luaL_check_string(n)  (luaL_check_lstr((n), NULL))
+char *luaL_check_lstr (int numArg, long *len);
+#define luaL_opt_string(n, d) (luaL_opt_lstr((n), (d), NULL))
+char *luaL_opt_lstr (int numArg, char *def, long *len);
+double luaL_check_number (int numArg);
+double luaL_opt_number (int numArg, double def);
+lua_Object luaL_functionarg (int arg);
+lua_Object luaL_tablearg (int arg);
+lua_Object luaL_nonnullarg (int numArg);
+void luaL_verror (char *fmt, ...);
+char *luaL_openspace (int size);
+void luaL_resetbuffer (void);
+void luaL_addchar (int c);
+int luaL_getsize (void);
+void luaL_addsize (int n);
+int luaL_newbuffer (int size);
+void luaL_oldbuffer (int old);
+char *luaL_buffer (void);
+int luaL_findstring (char *name, char *list[]);
+
+
+#endif

lbuffer.c

@@ -0,0 +1,85 @@
+/*
+** $Id: lbuffer.c,v 1.3 1998/06/02 20:37:04 roberto Exp roberto $
+** Auxiliary functions for building Lua libraries
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdio.h>
+
+#include "lauxlib.h"
+#include "lmem.h"
+#include "lstate.h"
+
+
+/*-------------------------------------------------------
+**  Auxiliary buffer
+-------------------------------------------------------*/
+
+#define BUFF_STEP	32
+
+#define openspace(size)  if (L->Mbuffnext+(size) > L->Mbuffsize) Openspace(size)
+
+static void Openspace (int size)
+{
+  lua_State *l = L;  /* to optimize */
+  int base = l->Mbuffbase-l->Mbuffer;
+  l->Mbuffsize *= 2;
+  if (l->Mbuffnext+size > l->Mbuffsize)  /* still not big enough? */
+    l->Mbuffsize = l->Mbuffnext+size;
+  l->Mbuffer = luaM_realloc(l->Mbuffer, l->Mbuffsize);
+  l->Mbuffbase = l->Mbuffer+base;
+}
+
+
+char *luaL_openspace (int size)
+{
+  openspace(size);
+  return L->Mbuffer+L->Mbuffnext;
+}
+
+
+void luaL_addchar (int c)
+{
+  openspace(BUFF_STEP);
+  L->Mbuffer[L->Mbuffnext++] = c;
+}
+
+
+void luaL_resetbuffer (void)
+{
+  L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
+}
+
+
+void luaL_addsize (int n)
+{
+  L->Mbuffnext += n;
+}
+
+int luaL_getsize (void)
+{
+  return L->Mbuffnext-(L->Mbuffbase-L->Mbuffer);
+}
+
+int luaL_newbuffer (int size)
+{
+  int old = L->Mbuffbase-L->Mbuffer;
+  openspace(size);
+  L->Mbuffbase = L->Mbuffer+L->Mbuffnext;
+  return old;
+}
+
+
+void luaL_oldbuffer (int old)
+{
+  L->Mbuffnext = L->Mbuffbase-L->Mbuffer;
+  L->Mbuffbase = L->Mbuffer+old;
+}
+
+
+char *luaL_buffer (void)
+{
+  return L->Mbuffbase;
+}
+

lbuiltin.c

@@ -0,0 +1,526 @@
+/*
+** $Id: lbuiltin.c,v 1.31 1998/06/19 18:47:06 roberto Exp roberto $
+** Built-in functions
+** See Copyright Notice in lua.h
+*/
+
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lapi.h"
+#include "lauxlib.h"
+#include "lbuiltin.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lua.h"
+#include "lundump.h"
+
+
+
+static void pushstring (TaggedString *s)
+{
+  TObject o;
+  o.ttype = LUA_T_STRING;
+  o.value.ts = s;
+  luaA_pushobject(&o);
+}
+
+
+static void nextvar (void)
+{
+  TObject *o = luaA_Address(luaL_nonnullarg(1));
+  TaggedString *g;
+  if (ttype(o) == LUA_T_NIL)
+    g = (TaggedString *)L->rootglobal.next;
+  else {
+    luaL_arg_check(ttype(o) == LUA_T_STRING, 1, "variable name expected");
+    g = tsvalue(o);
+    /* check whether name is in global var list */
+    luaL_arg_check((GCnode *)g != g->head.next, 1, "variable name expected");
+    g = (TaggedString *)g->head.next;
+  }
+  while (g && g->u.s.globalval.ttype == LUA_T_NIL)  /* skip globals with nil */
+    g = (TaggedString *)g->head.next;
+  if (g) {
+    pushstring(g);
+    luaA_pushobject(&g->u.s.globalval);
+  }
+  else lua_pushnil();
+}
+
+
+static void foreachvar (void)
+{
+  TObject f = *luaA_Address(luaL_functionarg(1));
+  GCnode *g;
+  StkId name = L->Cstack.base++;  /* place to keep var name (to avoid GC) */
+  ttype(L->stack.stack+name) = LUA_T_NIL;
+  L->stack.top++;
+  for (g = L->rootglobal.next; g; g = g->next) {
+    TaggedString *s = (TaggedString *)g;
+    if (s->u.s.globalval.ttype != LUA_T_NIL) {
+      ttype(L->stack.stack+name) = LUA_T_STRING;
+      tsvalue(L->stack.stack+name) = s;  /* keep s on stack to avoid GC */
+      luaA_pushobject(&f);
+      pushstring(s);
+      luaA_pushobject(&s->u.s.globalval);
+      luaD_call((L->stack.top-L->stack.stack)-2, 1);
+      if (ttype(L->stack.top-1) != LUA_T_NIL)
+        return;
+      L->stack.top--;
+    }
+  }
+}
+
+
+static void next (void)
+{
+  lua_Object o = luaL_tablearg(1);
+  lua_Object r = luaL_nonnullarg(2);
+  Node *n = luaH_next(luaA_Address(o), luaA_Address(r));
+  if (n) {
+    luaA_pushobject(&n->ref);
+    luaA_pushobject(&n->val);
+  }
+  else lua_pushnil();
+}
+
+
+static void foreach (void)
+{
+  TObject t = *luaA_Address(luaL_tablearg(1));
+  TObject f = *luaA_Address(luaL_functionarg(2));
+  int i;
+  for (i=0; i<avalue(&t)->nhash; i++) {
+    Node *nd = &(avalue(&t)->node[i]);
+    if (ttype(ref(nd)) != LUA_T_NIL && ttype(val(nd)) != LUA_T_NIL) {
+      luaA_pushobject(&f);
+      luaA_pushobject(ref(nd));
+      luaA_pushobject(val(nd));
+      luaD_call((L->stack.top-L->stack.stack)-2, 1);
+      if (ttype(L->stack.top-1) != LUA_T_NIL)
+        return;
+      L->stack.top--;
+    }
+  }
+}
+
+
+static void internaldostring (void)
+{
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  if (*s == ID_CHUNK)
+    lua_error("`dostring' cannot run pre-compiled code");
+  if (lua_dobuffer(s, l, luaL_opt_string(2, NULL)) == 0)
+    if (luaA_passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
+}
+
+
+static void internaldofile (void)
+{
+  char *fname = luaL_opt_string(1, NULL);
+  if (lua_dofile(fname) == 0)
+    if (luaA_passresults() == 0)
+      lua_pushuserdata(NULL);  /* at least one result to signal no errors */
+}
+
+
+static void to_string (void) {
+  lua_Object obj = lua_getparam(1);
+  char *buff = luaL_openspace(30);
+  TObject *o = luaA_Address(obj);
+  switch (ttype(o)) {
+    case LUA_T_NUMBER:
+      lua_pushstring(lua_getstring(obj));
+      return;
+    case LUA_T_STRING:
+      lua_pushobject(obj);
+      return;
+    case LUA_T_ARRAY: {
+      sprintf(buff, "table: %p", (void *)o->value.a);
+      break;
+    }
+    case LUA_T_CLOSURE: {
+      sprintf(buff, "function: %p", (void *)o->value.cl);
+      break;
+    }
+    case LUA_T_PROTO: {
+      sprintf(buff, "function: %p", (void *)o->value.tf);
+      break;
+    }
+    case LUA_T_CPROTO: {
+      sprintf(buff, "function: %p", (void *)o->value.f);
+      break;
+    }
+    case LUA_T_USERDATA: {
+      sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
+      break;
+    }
+    case LUA_T_NIL:
+      lua_pushstring("nil");
+      return;
+    default:
+      LUA_INTERNALERROR("invalid type");
+  }
+  lua_pushstring(buff);
+}
+
+
+static void luaI_print (void) {
+  TaggedString *ts = luaS_new("tostring");
+  lua_Object obj;
+  int i = 1;
+  while ((obj = lua_getparam(i++)) != LUA_NOOBJECT) {
+    luaA_pushobject(&ts->u.s.globalval);
+    lua_pushobject(obj);
+    luaD_call((L->stack.top-L->stack.stack)-1, 1);
+    if (ttype(L->stack.top-1) != LUA_T_STRING)
+      lua_error("`tostring' must return a string to `print'");
+    printf("%s\t", svalue(L->stack.top-1));
+    L->stack.top--;
+  }
+  printf("\n");
+}
+
+
+static void luaI_type (void)
+{
+  lua_Object o = luaL_nonnullarg(1);
+  lua_pushstring(luaO_typenames[-ttype(luaA_Address(o))]);
+  lua_pushnumber(lua_tag(o));
+}
+
+
+static void tonumber (void)
+{
+  int base = luaL_opt_number(2, 10);
+  if (base == 10) {  /* standard conversion */
+    lua_Object o = lua_getparam(1);
+    if (lua_isnumber(o))
+      lua_pushnumber(lua_getnumber(o));
+  }
+  else {
+    char *s = luaL_check_string(1);
+    unsigned long n;
+    luaL_arg_check(0 <= base && base <= 36, 2, "base out of range");
+    n = strtol(s, &s, base);
+    while (isspace(*s)) s++;  /* skip trailing spaces */
+    if (*s) lua_pushnil();  /* invalid format: return nil */
+    else lua_pushnumber(n);
+  }
+}
+
+
+static void luaI_error (void)
+{
+  lua_error(lua_getstring(lua_getparam(1)));
+}
+
+
+static void luaI_assert (void)
+{
+  lua_Object p = lua_getparam(1);
+  if (p == LUA_NOOBJECT || lua_isnil(p))
+    luaL_verror("assertion failed!  %.100s", luaL_opt_string(2, ""));
+}
+
+
+static void setglobal (void)
+{
+  char *n = luaL_check_string(1);
+  lua_Object value = luaL_nonnullarg(2);
+  lua_pushobject(value);
+  lua_setglobal(n);
+  lua_pushobject(value);  /* return given value */
+}
+
+static void rawsetglobal (void)
+{
+  char *n = luaL_check_string(1);
+  lua_Object value = luaL_nonnullarg(2);
+  lua_pushobject(value);
+  lua_rawsetglobal(n);
+  lua_pushobject(value);  /* return given value */
+}
+
+static void getglobal (void)
+{
+  lua_pushobject(lua_getglobal(luaL_check_string(1)));
+}
+
+static void rawgetglobal (void)
+{
+  lua_pushobject(lua_rawgetglobal(luaL_check_string(1)));
+}
+
+static void luatag (void)
+{
+  lua_pushnumber(lua_tag(lua_getparam(1)));
+}
+
+
+static int getnarg (lua_Object table)
+{
+  lua_Object temp;
+  /* temp = table.n */
+  lua_pushobject(table); lua_pushstring("n"); temp = lua_rawgettable();
+  return (lua_isnumber(temp) ? lua_getnumber(temp) : MAX_INT);
+}
+
+static void luaI_call (void)
+{
+  lua_Object f = luaL_nonnullarg(1);
+  lua_Object arg = luaL_tablearg(2);
+  char *options = luaL_opt_string(3, "");
+  lua_Object err = lua_getparam(4);
+  int narg = getnarg(arg);
+  int i, status;
+  if (err != LUA_NOOBJECT) {  /* set new error method */
+    lua_pushobject(err);
+    err = lua_seterrormethod();
+  }
+  /* push arg[1...n] */
+  for (i=0; i<narg; i++) {
+    lua_Object temp;
+    /* temp = arg[i+1] */
+    lua_pushobject(arg); lua_pushnumber(i+1); temp = lua_rawgettable();
+    if (narg == MAX_INT && lua_isnil(temp))
+      break;
+    lua_pushobject(temp);
+  }
+  status = lua_callfunction(f);
+  if (err != LUA_NOOBJECT) {  /* restore old error method */
+    lua_pushobject(err);
+    lua_seterrormethod();
+  }
+  if (status != 0) {  /* error in call? */
+    if (strchr(options, 'x')) {
+      lua_pushnil();
+      return;  /* return nil to signal the error */
+    }
+    else
+      lua_error(NULL);
+  }
+  else { /* no errors */
+    if (strchr(options, 'p'))
+      luaA_packresults();
+    else
+      luaA_passresults();
+  }
+}
+
+
+static void settag (void)
+{
+  lua_Object o = luaL_tablearg(1);
+  lua_pushobject(o);
+  lua_settag(luaL_check_number(2));
+  lua_pushobject(o);  /* returns first argument */
+}
+
+
+static void newtag (void)
+{
+  lua_pushnumber(lua_newtag());
+}
+
+
+static void copytagmethods (void)
+{
+  lua_pushnumber(lua_copytagmethods(luaL_check_number(1),
+                                    luaL_check_number(2)));
+}
+
+
+static void rawgettable (void)
+{
+  lua_pushobject(luaL_nonnullarg(1));
+  lua_pushobject(luaL_nonnullarg(2));
+  lua_pushobject(lua_rawgettable());
+}
+
+
+static void rawsettable (void)
+{
+  lua_pushobject(luaL_nonnullarg(1));
+  lua_pushobject(luaL_nonnullarg(2));
+  lua_pushobject(luaL_nonnullarg(3));
+  lua_rawsettable();
+}
+
+
+static void settagmethod (void)
+{
+  lua_Object nf = luaL_nonnullarg(3);
+  lua_pushobject(nf);
+  lua_pushobject(lua_settagmethod((int)luaL_check_number(1),
+                                  luaL_check_string(2)));
+}
+
+
+static void gettagmethod (void)
+{
+  lua_pushobject(lua_gettagmethod((int)luaL_check_number(1),
+                                  luaL_check_string(2)));
+}
+
+
+static void seterrormethod (void)
+{
+  lua_Object nf = luaL_functionarg(1);
+  lua_pushobject(nf);
+  lua_pushobject(lua_seterrormethod());
+}
+
+
+static void luaI_collectgarbage (void)
+{
+  lua_pushnumber(lua_collectgarbage(luaL_opt_number(1, 0)));
+}
+
+
+/*
+** =======================================================
+** some DEBUG functions
+** =======================================================
+*/
+#ifdef DEBUG
+
+static void mem_query (void)
+{
+  lua_pushnumber(totalmem);
+  lua_pushnumber(numblocks);
+}
+
+
+static void countlist (void)
+{
+  char *s = luaL_check_string(1);
+  GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
+              (s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
+  int i=0;
+  while (l) {
+    i++;
+    l = l->next;
+  }
+  lua_pushnumber(i);
+}
+
+
+static void testC (void)
+{
+#define getnum(s)	((*s++) - '0')
+#define getname(s)	(nome[0] = *s++, nome)
+
+  static int locks[10];
+  lua_Object reg[10];
+  char nome[2];
+  char *s = luaL_check_string(1);
+  nome[1] = 0;
+  while (1) {
+    switch (*s++) {
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+        lua_pushnumber(*(s-1) - '0');
+        break;
+
+      case 'c': reg[getnum(s)] = lua_createtable(); break;
+      case 'C': { lua_CFunction f = lua_getcfunction(lua_getglobal(getname(s)));
+                  lua_pushcclosure(f, getnum(s));
+                  break;
+                }
+      case 'P': reg[getnum(s)] = lua_pop(); break;
+      case 'g': { int n=getnum(s); reg[n]=lua_getglobal(getname(s)); break; }
+      case 'G': { int n = getnum(s);
+                  reg[n] = lua_rawgetglobal(getname(s));
+                  break;
+                }
+      case 'l': locks[getnum(s)] = lua_ref(1); break;
+      case 'L': locks[getnum(s)] = lua_ref(0); break;
+      case 'r': { int n=getnum(s); reg[n]=lua_getref(locks[getnum(s)]); break; }
+      case 'u': lua_unref(locks[getnum(s)]); break;
+      case 'p': { int n = getnum(s); reg[n] = lua_getparam(getnum(s)); break; }
+      case '=': lua_setglobal(getname(s)); break;
+      case 's': lua_pushstring(getname(s)); break;
+      case 'o': lua_pushobject(reg[getnum(s)]); break;
+      case 'f': (lua_call)(getname(s)); break;
+      case 'i': reg[getnum(s)] = lua_gettable(); break;
+      case 'I': reg[getnum(s)] = lua_rawgettable(); break;
+      case 't': lua_settable(); break;
+      case 'T': lua_rawsettable(); break;
+      default: luaL_verror("unknown command in `testC': %c", *(s-1));
+    }
+  if (*s == 0) return;
+  if (*s++ != ' ') lua_error("missing ` ' between commands in `testC'");
+  }
+}
+
+#endif
+
+
+/*
+** Internal functions
+*/
+static struct luaL_reg int_funcs[] = {
+#ifdef LUA_COMPAT2_5
+  {"setfallback", luaT_setfallback},
+#endif
+#ifdef DEBUG
+  {"testC", testC},
+  {"totalmem", mem_query},
+  {"count", countlist},
+#endif
+  {"assert", luaI_assert},
+  {"call", luaI_call},
+  {"collectgarbage", luaI_collectgarbage},
+  {"dofile", internaldofile},
+  {"copytagmethods", copytagmethods},
+  {"dostring", internaldostring},
+  {"error", luaI_error},
+  {"foreach", foreach},
+  {"foreachvar", foreachvar},
+  {"getglobal", getglobal},
+  {"newtag", newtag},
+  {"next", next},
+  {"nextvar", nextvar},
+  {"print", luaI_print},
+  {"rawgetglobal", rawgetglobal},
+  {"rawgettable", rawgettable},
+  {"rawsetglobal", rawsetglobal},
+  {"rawsettable", rawsettable},
+  {"seterrormethod", seterrormethod},
+  {"setglobal", setglobal},
+  {"settagmethod", settagmethod},
+  {"gettagmethod", gettagmethod},
+  {"settag", settag},
+  {"tonumber", tonumber},
+  {"tostring", to_string},
+  {"tag", luatag},
+  {"type", luaI_type}
+};
+
+
+#define INTFUNCSIZE (sizeof(int_funcs)/sizeof(int_funcs[0]))
+
+
+void luaB_predefine (void)
+{
+  /* pre-register mem error messages, to avoid loop when error arises */
+  luaS_newfixedstring(tableEM);
+  luaS_newfixedstring(memEM);
+  luaL_openlib(int_funcs, (sizeof(int_funcs)/sizeof(int_funcs[0])));
+  lua_pushstring(LUA_VERSION);
+  lua_setglobal("_VERSION");
+}
+

lbuiltin.h

@@ -0,0 +1,14 @@
+/*
+** $Id: $
+** Built-in functions
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lbuiltin_h
+#define lbuiltin_h
+
+
+void luaB_predefine (void);
+
+
+#endif

ldo.c

@@ -0,0 +1,427 @@
+/*
+** $Id: ldo.c,v 1.26 1998/06/15 21:34:14 roberto Exp roberto $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+
+#include <setjmp.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "ltm.h"
+#include "lua.h"
+#include "luadebug.h"
+#include "lundump.h"
+#include "lvm.h"
+#include "lzio.h"
+
+
+
+#ifndef STACK_LIMIT
+#define STACK_LIMIT     6000
+#endif
+
+
+
+/*
+** Error messages
+*/
+
+static void stderrorim (void)
+{
+  fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1)));
+}
+
+
+
+#define STACK_UNIT	128
+
+
+void luaD_init (void)
+{
+  L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
+  L->stack.top = L->stack.stack;
+  L->stack.last = L->stack.stack+(STACK_UNIT-1);
+  ttype(&L->errorim) = LUA_T_CPROTO;
+  fvalue(&L->errorim) = stderrorim;
+}
+
+
+void luaD_checkstack (int n)
+{
+  struct Stack *S = &L->stack;
+  if (S->last-S->top <= n) {
+    StkId top = S->top-S->stack;
+    int stacksize = (S->last-S->stack)+1+STACK_UNIT+n;
+    S->stack = luaM_reallocvector(S->stack, stacksize, TObject);
+    S->last = S->stack+(stacksize-1);
+    S->top = S->stack + top;
+    if (stacksize >= STACK_LIMIT) {  /* stack overflow? */
+      if (lua_stackedfunction(100) == LUA_NOOBJECT)  /* 100 funcs on stack? */
+        lua_error("Lua2C - C2Lua overflow"); /* doesn't look like a rec. loop */
+      else
+        lua_error("stack size overflow");
+    }
+  }
+}
+
+
+/*
+** Adjust stack. Set top to the given value, pushing NILs if needed.
+*/
+void luaD_adjusttop (StkId newtop)
+{
+  int diff = newtop-(L->stack.top-L->stack.stack);
+  if (diff <= 0)
+    L->stack.top += diff;
+  else {
+    luaD_checkstack(diff);
+    while (diff--)
+      ttype(L->stack.top++) = LUA_T_NIL;
+  }
+}
+
+
+/*
+** Open a hole below "nelems" from the L->stack.top.
+*/
+void luaD_openstack (int nelems)
+{
+  luaO_memup(L->stack.top-nelems+1, L->stack.top-nelems,
+             nelems*sizeof(TObject));
+  incr_top;
+}
+
+
+void luaD_lineHook (int line)
+{
+  struct C_Lua_Stack oldCLS = L->Cstack;
+  StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
+  L->Cstack.num = 0;
+  (*lua_linehook)(line);
+  L->stack.top = L->stack.stack+old_top;
+  L->Cstack = oldCLS;
+}
+
+
+void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn)
+{
+  struct C_Lua_Stack oldCLS = L->Cstack;
+  StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
+  L->Cstack.num = 0;
+  if (isreturn)
+    (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
+  else {
+    TObject *f = L->stack.stack+base-1;
+    if (tf)
+      (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
+    else
+      (*lua_callhook)(Ref(f), "(C)", -1);
+  }
+  L->stack.top = L->stack.stack+old_top;
+  L->Cstack = oldCLS;
+}
+
+
+/*
+** Call a C function.
+** Cstack.num is the number of arguments; Cstack.lua2C points to the
+** first argument. Returns an index to the first result from C.
+*/
+static StkId callC (lua_CFunction f, StkId base)
+{
+  struct C_Lua_Stack *CS = &L->Cstack;
+  struct C_Lua_Stack oldCLS = *CS;
+  StkId firstResult;
+  int numarg = (L->stack.top-L->stack.stack) - base;
+  CS->num = numarg;
+  CS->lua2C = base;
+  CS->base = base+numarg;  /* == top-stack */
+  if (lua_callhook)
+    luaD_callHook(base, NULL, 0);
+  (*f)();  /* do the actual call */
+  if (lua_callhook)  /* func may have changed lua_callhook */
+    luaD_callHook(base, NULL, 1);
+  firstResult = CS->base;
+  *CS = oldCLS;
+  return firstResult;
+}
+
+
+static StkId callCclosure (struct Closure *cl, lua_CFunction f, StkId base)
+{
+  TObject *pbase;
+  int nup = cl->nelems;  /* number of upvalues */
+  luaD_checkstack(nup);
+  pbase = L->stack.stack+base;  /* care: previous call may change this */
+  /* open space for upvalues as extra arguments */
+  luaO_memup(pbase+nup, pbase, (L->stack.top-pbase)*sizeof(TObject));
+  /* copy upvalues into stack */
+  memcpy(pbase, cl->consts+1, nup*sizeof(TObject));
+  L->stack.top += nup;
+  return callC(f, base);
+}
+
+
+void luaD_callTM (TObject *f, int nParams, int nResults)
+{
+  luaD_openstack(nParams);
+  *(L->stack.top-nParams-1) = *f;
+  luaD_call((L->stack.top-L->stack.stack)-nParams, nResults);
+}
+
+
+/*
+** Call a function (C or Lua). The parameters must be on the L->stack.stack,
+** between [L->stack.stack+base,L->stack.top). The function to be called is at L->stack.stack+base-1.
+** When returns, the results are on the L->stack.stack, between [L->stack.stack+base-1,L->stack.top).
+** The number of results is nResults, unless nResults=MULT_RET.
+*/
+void luaD_call (StkId base, int nResults)
+{
+  StkId firstResult;
+  TObject *func = L->stack.stack+base-1;
+  int i;
+  switch (ttype(func)) {
+    case LUA_T_CPROTO:
+      ttype(func) = LUA_T_CMARK;
+      firstResult = callC(fvalue(func), base);
+      break;
+    case LUA_T_PROTO:
+      ttype(func) = LUA_T_PMARK;
+      firstResult = luaV_execute(NULL, tfvalue(func), base);
+      break;
+    case LUA_T_CLOSURE: {
+      Closure *c = clvalue(func);
+      TObject *proto = &(c->consts[0]);
+      ttype(func) = LUA_T_CLMARK;
+      firstResult = (ttype(proto) == LUA_T_CPROTO) ?
+                       callCclosure(c, fvalue(proto), base) :
+                       luaV_execute(c, tfvalue(proto), base);
+      break;
+    }
+    default: { /* func is not a function */
+      /* Check the tag method for invalid functions */
+      TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
+      if (ttype(im) == LUA_T_NIL)
+        lua_error("call expression not a function");
+      luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults);
+      return;
+    }
+  }
+  /* adjust the number of results */
+  if (nResults != MULT_RET)
+    luaD_adjusttop(firstResult+nResults);
+  /* move results to base-1 (to erase parameters and function) */
+  base--;
+  nResults = L->stack.top - (L->stack.stack+firstResult);  /* actual number of results */
+  for (i=0; i<nResults; i++)
+    *(L->stack.stack+base+i) = *(L->stack.stack+firstResult+i);
+  L->stack.top -= firstResult-base;
+}
+
+
+
+/*
+** Traverse all objects on L->stack.stack
+*/
+void luaD_travstack (int (*fn)(TObject *))
+{
+  StkId i;
+  for (i = (L->stack.top-1)-L->stack.stack; i>=0; i--)
+    fn(L->stack.stack+i);
+}
+
+
+
+static void message (char *s)
+{
+  TObject im = L->errorim;
+  if (ttype(&im) != LUA_T_NIL) {
+    lua_pushstring(s);
+    luaD_callTM(&im, 1, 0);
+  }
+}
+
+/*
+** Reports an error, and jumps up to the available recover label
+*/
+void lua_error (char *s)
+{
+  if (s) message(s);
+  if (L->errorJmp)
+    longjmp(*((jmp_buf *)L->errorJmp), 1);
+  else {
+    fprintf (stderr, "lua: exit(1). Unable to recover\n");
+    exit(1);
+  }
+}
+
+/*
+** Call the function at L->Cstack.base, and incorporate results on
+** the Lua2C structure.
+*/
+static void do_callinc (int nResults)
+{
+  StkId base = L->Cstack.base;
+  luaD_call(base+1, nResults);
+  L->Cstack.lua2C = base;  /* position of the luaM_new results */
+  L->Cstack.num = (L->stack.top-L->stack.stack) - base;  /* number of results */
+  L->Cstack.base = base + L->Cstack.num;  /* incorporate results on L->stack.stack */
+}
+
+
+/*
+** Execute a protected call. Assumes that function is at L->Cstack.base and
+** parameters are on top of it. Leave nResults on the stack.
+*/
+int luaD_protectedrun (int nResults)
+{
+  jmp_buf myErrorJmp;
+  int status;
+  volatile struct C_Lua_Stack oldCLS = L->Cstack;
+  jmp_buf *volatile oldErr = L->errorJmp;
+  L->errorJmp = &myErrorJmp;
+  if (setjmp(myErrorJmp) == 0) {
+    do_callinc(nResults);
+    status = 0;
+  }
+  else { /* an error occurred: restore L->Cstack and L->stack.top */
+    L->Cstack = oldCLS;
+    L->stack.top = L->stack.stack+L->Cstack.base;
+    status = 1;
+  }
+  L->errorJmp = oldErr;
+  return status;
+}
+
+
+/*
+** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load
+*/
+static int protectedparser (ZIO *z, int bin)
+{
+  volatile int status;
+  TProtoFunc *volatile tf;
+  jmp_buf myErrorJmp;
+  jmp_buf *volatile oldErr = L->errorJmp;
+  L->errorJmp = &myErrorJmp;
+  if (setjmp(myErrorJmp) == 0) {
+    tf = bin ? luaU_undump1(z) : luaY_parser(z);
+    status = 0;
+  }
+  else {
+    tf = NULL;
+    status = 1;
+  }
+  L->errorJmp = oldErr;
+  if (status) return 1;  /* error code */
+  if (tf == NULL) return 2;  /* 'natural' end */
+  luaD_adjusttop(L->Cstack.base+1);  /* one slot for the pseudo-function */
+  L->stack.stack[L->Cstack.base].ttype = LUA_T_PROTO;
+  L->stack.stack[L->Cstack.base].value.tf = tf;
+  luaV_closure(0);
+  return 0;
+}
+
+
+static int do_main (ZIO *z, int bin)
+{
+  int status;
+  do {
+    long old_blocks = (luaC_checkGC(), L->nblocks);
+    status = protectedparser(z, bin);
+    if (status == 1) return 1;  /* error */
+    else if (status == 2) return 0;  /* 'natural' end */
+    else {
+      unsigned long newelems2 = 2*(L->nblocks-old_blocks);
+      L->GCthreshold += newelems2;
+      status = luaD_protectedrun(MULT_RET);
+      L->GCthreshold -= newelems2;
+    }
+  } while (bin && status == 0);
+  return status;
+}
+
+
+void luaD_gcIM (TObject *o)
+{
+  TObject *im = luaT_getimbyObj(o, IM_GC);
+  if (ttype(im) != LUA_T_NIL) {
+    *L->stack.top = *o;
+    incr_top;
+    luaD_callTM(im, 1, 0);
+  }
+}
+
+
+int lua_dofile (char *filename)
+{
+  ZIO z;
+  int status;
+  int c;
+  int bin;
+  FILE *f = (filename == NULL) ? stdin : fopen(filename, "r");
+  if (f == NULL)
+    return 2;
+  if (filename == NULL)
+    filename = "(stdin)";
+  c = fgetc(f);
+  ungetc(c, f);
+  bin = (c == ID_CHUNK);
+  if (bin)
+    f = freopen(filename, "rb", f);  /* set binary mode */
+  luaZ_Fopen(&z, f, filename);
+  status = do_main(&z, bin);
+  if (f != stdin)
+    fclose(f);
+  return status;
+}
+
+
+#define SIZE_PREF 20  /* size of string prefix to appear in error messages */
+#define SSIZE_PREF "20"
+
+
+static void build_name (char *str, char *name) {
+  if (str == NULL || *str == ID_CHUNK)
+    strcpy(name, "(buffer)");
+  else {
+    char *temp;
+    sprintf(name, "(dostring) >> \"%." SSIZE_PREF "s\"", str);
+    temp = strchr(name, '\n');
+    if (temp) {  /* end string after first line */
+     *temp = '"';
+     *(temp+1) = 0;
+    }
+  }
+}
+
+
+int lua_dostring (char *str) {
+  return lua_dobuffer(str, strlen(str), NULL);
+}
+
+
+int lua_dobuffer (char *buff, int size, char *name) {
+  char newname[SIZE_PREF+25];
+  ZIO z;
+  int status;
+  if (name==NULL) {
+    build_name(buff, newname);
+    name = newname;
+  }
+  luaZ_mopen(&z, buff, size, name);
+  status = do_main(&z, buff[0]==ID_CHUNK);
+  return status;
+}
+

ldo.h

@@ -0,0 +1,46 @@
+/*
+** $Id: ldo.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
+** Stack and Call structure of Lua
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ldo_h
+#define ldo_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+
+
+#define MULT_RET        255
+
+
+
+/*
+** macro to increment stack top.
+** There must be always an empty slot at the L->stack.top
+*/
+#define incr_top { if (L->stack.top >= L->stack.last) luaD_checkstack(1); \
+                   L->stack.top++; }
+
+
+/* macros to convert from lua_Object to (TObject *) and back */
+
+#define Address(lo)     ((lo)+L->stack.stack-1)
+#define Ref(st)         ((st)-L->stack.stack+1)
+
+
+void luaD_init (void);
+void luaD_adjusttop (StkId newtop);
+void luaD_openstack (int nelems);
+void luaD_lineHook (int line);
+void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn);
+void luaD_call (StkId base, int nResults);
+void luaD_callTM (TObject *f, int nParams, int nResults);
+int luaD_protectedrun (int nResults);
+void luaD_gcIM (TObject *o);
+void luaD_travstack (int (*fn)(TObject *));
+void luaD_checkstack (int n);
+
+
+#endif

lex.c

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

lfunc.c

@@ -0,0 +1,98 @@
+/*
+** $Id: lfunc.c,v 1.8 1997/12/15 16:17:20 roberto Exp roberto $
+** Auxiliary functions to manipulate prototypes and closures
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+
+#include "lfunc.h"
+#include "lmem.h"
+#include "lstate.h"
+
+#define gcsizeproto(p)	5  /* approximate "weight" for a prototype */
+#define gcsizeclosure(c) 1  /* approximate "weight" for a closure */
+
+
+
+Closure *luaF_newclosure (int nelems)
+{
+  Closure *c = (Closure *)luaM_malloc(sizeof(Closure)+nelems*sizeof(TObject));
+  luaO_insertlist(&(L->rootcl), (GCnode *)c);
+  L->nblocks += gcsizeclosure(c);
+  c->nelems = nelems;
+  return c;
+}
+
+
+TProtoFunc *luaF_newproto (void)
+{
+  TProtoFunc *f = luaM_new(TProtoFunc);
+  f->code = NULL;
+  f->lineDefined = 0;
+  f->fileName = NULL;
+  f->consts = NULL;
+  f->nconsts = 0;
+  f->locvars = NULL;
+  luaO_insertlist(&(L->rootproto), (GCnode *)f);
+  L->nblocks += gcsizeproto(f);
+  return f;
+}
+
+
+
+static void freefunc (TProtoFunc *f)
+{
+  luaM_free(f->code);
+  luaM_free(f->locvars);
+  luaM_free(f->consts);
+  luaM_free(f);
+}
+
+
+void luaF_freeproto (TProtoFunc *l)
+{
+  while (l) {
+    TProtoFunc *next = (TProtoFunc *)l->head.next;
+    L->nblocks -= gcsizeproto(l);
+    freefunc(l);
+    l = next;
+  }
+}
+
+
+void luaF_freeclosure (Closure *l)
+{
+  while (l) {
+    Closure *next = (Closure *)l->head.next;
+    L->nblocks -= gcsizeclosure(l);
+    luaM_free(l);
+    l = next;
+  }
+}
+
+
+/*
+** Look for n-th local variable at line "line" in function "func".
+** Returns NULL if not found.
+*/
+char *luaF_getlocalname (TProtoFunc *func, int local_number, int line)
+{
+  int count = 0;
+  char *varname = NULL;
+  LocVar *lv = func->locvars;
+  if (lv == NULL)
+    return NULL;
+  for (; lv->line != -1 && lv->line < line; lv++) {
+    if (lv->varname) {  /* register */
+      if (++count == local_number)
+        varname = lv->varname->str;
+    }
+    else  /* unregister */
+      if (--count < local_number)
+        varname = NULL;
+  }
+  return varname;
+}
+

lfunc.h

@@ -0,0 +1,23 @@
+/*
+** $Id: lfunc.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
+** Lua Function structures
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lfunc_h
+#define lfunc_h
+
+
+#include "lobject.h"
+
+
+
+TProtoFunc *luaF_newproto (void);
+Closure *luaF_newclosure (int nelems);
+void luaF_freeproto (TProtoFunc *l);
+void luaF_freeclosure (Closure *l);
+
+char *luaF_getlocalname (TProtoFunc *func, int local_number, int line);
+
+
+#endif

lgc.c

@@ -0,0 +1,288 @@
+/*
+** $Id: lgc.c,v 1.17 1998/03/06 16:54:42 roberto Exp roberto $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "lua.h"
+
+
+
+static int markobject (TObject *o);
+
+
+
+/*
+** =======================================================
+** REF mechanism
+** =======================================================
+*/
+
+
+int luaC_ref (TObject *o, int lock)
+{
+  int ref;
+  if (ttype(o) == LUA_T_NIL)
+    ref = -1;   /* special ref for nil */
+  else {
+    for (ref=0; ref<L->refSize; ref++)
+      if (L->refArray[ref].status == FREE)
+        goto found;
+    /* no more empty spaces */ {
+      int oldSize = L->refSize;
+      L->refSize = luaM_growvector(&L->refArray, L->refSize, struct ref,
+                                   refEM, MAX_INT);
+      for (ref=oldSize; ref<L->refSize; ref++)
+        L->refArray[ref].status = FREE;
+      ref = oldSize;
+    } found:
+    L->refArray[ref].o = *o;
+    L->refArray[ref].status = lock ? LOCK : HOLD;
+  }
+  return ref;
+}
+
+
+void lua_unref (int ref)
+{
+  if (ref >= 0 && ref < L->refSize)
+    L->refArray[ref].status = FREE;
+}
+
+
+TObject* luaC_getref (int ref)
+{
+  if (ref == -1)
+    return &luaO_nilobject;
+  if (ref >= 0 && ref < L->refSize &&
+      (L->refArray[ref].status == LOCK || L->refArray[ref].status == HOLD))
+    return &L->refArray[ref].o;
+  else
+    return NULL;
+}
+
+
+static void travlock (void)
+{
+  int i;
+  for (i=0; i<L->refSize; i++)
+    if (L->refArray[i].status == LOCK)
+      markobject(&L->refArray[i].o);
+}
+
+
+static int ismarked (TObject *o)
+{
+  /* valid only for locked objects */
+  switch (o->ttype) {
+    case LUA_T_STRING: case LUA_T_USERDATA:
+      return o->value.ts->head.marked;
+    case LUA_T_ARRAY:
+      return o->value.a->head.marked;
+    case LUA_T_CLOSURE:
+      return o->value.cl->head.marked;
+    case LUA_T_PROTO:
+      return o->value.tf->head.marked;
+#ifdef DEBUG
+    case LUA_T_LINE: case LUA_T_CLMARK:
+    case LUA_T_CMARK: case LUA_T_PMARK:
+      LUA_INTERNALERROR("invalid type");
+#endif
+    default:  /* nil, number or cproto */
+      return 1;
+  }
+}
+
+
+static void invalidaterefs (void)
+{
+  int i;
+  for (i=0; i<L->refSize; i++)
+    if (L->refArray[i].status == HOLD && !ismarked(&L->refArray[i].o))
+      L->refArray[i].status = COLLECTED;
+}
+
+
+
+void luaC_hashcallIM (Hash *l)
+{
+  TObject t;
+  ttype(&t) = LUA_T_ARRAY;
+  for (; l; l=(Hash *)l->head.next) {
+    avalue(&t) = l;
+    luaD_gcIM(&t);
+  }
+}
+
+
+void luaC_strcallIM (TaggedString *l)
+{
+  TObject o;
+  ttype(&o) = LUA_T_USERDATA;
+  for (; l; l=(TaggedString *)l->head.next)
+    if (l->constindex == -1) {  /* is userdata? */
+      tsvalue(&o) = l;
+      luaD_gcIM(&o);
+    }
+}
+
+
+
+static GCnode *listcollect (GCnode *l)
+{
+  GCnode *frees = NULL;
+  while (l) {
+    GCnode *next = l->next;
+    l->marked = 0;
+    while (next && !next->marked) {
+      l->next = next->next;
+      next->next = frees;
+      frees = next;
+      next = l->next;
+    }
+    l = next;
+  }
+  return frees;
+}
+
+
+static void strmark (TaggedString *s)
+{
+  if (!s->head.marked)
+    s->head.marked = 1;
+}
+
+
+static void protomark (TProtoFunc *f)
+{
+  if (!f->head.marked) {
+    LocVar *v = f->locvars;
+    int i;
+    f->head.marked = 1;
+    if (f->fileName)
+      strmark(f->fileName);
+    for (i=0; i<f->nconsts; i++)
+      markobject(&f->consts[i]);
+    if (v) {
+      for (; v->line != -1; v++)
+        if (v->varname)
+          strmark(v->varname);
+    }
+  }
+}
+
+
+static void closuremark (Closure *f)
+{
+  if (!f->head.marked) {
+    int i;
+    f->head.marked = 1;
+    for (i=f->nelems; i>=0; i--)
+      markobject(&f->consts[i]);
+  }
+}
+
+
+static void hashmark (Hash *h)
+{
+  if (!h->head.marked) {
+    int i;
+    h->head.marked = 1;
+    for (i=0; i<nhash(h); i++) {
+      Node *n = node(h,i);
+      if (ttype(ref(n)) != LUA_T_NIL) {
+        markobject(&n->ref);
+        markobject(&n->val);
+      }
+    }
+  }
+}
+
+
+static void globalmark (void)
+{
+  TaggedString *g;
+  for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next){
+    LUA_ASSERT(g->constindex >= 0, "userdata in global list");
+    if (g->u.s.globalval.ttype != LUA_T_NIL) {
+      markobject(&g->u.s.globalval);
+      strmark(g);  /* cannot collect non nil global variables */
+    }
+  }
+}
+
+
+static int markobject (TObject *o)
+{
+  switch (ttype(o)) {
+    case LUA_T_USERDATA:  case LUA_T_STRING:
+      strmark(tsvalue(o));
+      break;
+    case LUA_T_ARRAY:
+      hashmark(avalue(o));
+      break;
+    case LUA_T_CLOSURE:  case LUA_T_CLMARK:
+      closuremark(o->value.cl);
+      break;
+    case LUA_T_PROTO: case LUA_T_PMARK:
+      protomark(o->value.tf);
+      break;
+    default: break;  /* numbers, cprotos, etc */
+  }
+  return 0;
+}
+
+
+
+static void markall (void)
+{
+  luaD_travstack(markobject); /* mark stack objects */
+  globalmark();  /* mark global variable values and names */
+  travlock(); /* mark locked objects */
+  luaT_travtagmethods(markobject);  /* mark fallbacks */
+}
+
+
+long lua_collectgarbage (long limit)
+{
+  unsigned long recovered = L->nblocks;  /* to subtract nblocks after gc */
+  Hash *freetable;
+  TaggedString *freestr;
+  TProtoFunc *freefunc;
+  Closure *freeclos;
+  markall();
+  invalidaterefs();
+  freestr = luaS_collector();
+  freetable = (Hash *)listcollect(&(L->roottable));
+  freefunc = (TProtoFunc *)listcollect(&(L->rootproto));
+  freeclos = (Closure *)listcollect(&(L->rootcl));
+  L->GCthreshold *= 4;  /* to avoid GC during GC */
+  luaC_hashcallIM(freetable);  /* GC tag methods for tables */
+  luaC_strcallIM(freestr);  /* GC tag methods for userdata */
+  luaD_gcIM(&luaO_nilobject);  /* GC tag method for nil (signal end of GC) */
+  luaH_free(freetable);
+  luaS_free(freestr);
+  luaF_freeproto(freefunc);
+  luaF_freeclosure(freeclos);
+  recovered = recovered-L->nblocks;
+  L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
+  return recovered;
+}
+
+
+void luaC_checkGC (void)
+{
+  if (L->nblocks >= L->GCthreshold)
+    lua_collectgarbage(0);
+}
+

lgc.h

@@ -0,0 +1,21 @@
+/*
+** $Id: lgc.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
+** Garbage Collector
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lgc_h
+#define lgc_h
+
+
+#include "lobject.h"
+
+
+void luaC_checkGC (void);
+TObject* luaC_getref (int ref);
+int luaC_ref (TObject *o, int lock);
+void luaC_hashcallIM (Hash *l);
+void luaC_strcallIM (TaggedString *l);
+
+
+#endif

liolib.c

@@ -0,0 +1,448 @@
+/*
+** $Id: liolib.c,v 1.20 1998/06/05 22:17:44 roberto Exp roberto $
+** Standard I/O (and system) library
+** See Copyright Notice in lua.h
+*/
+
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#include "lauxlib.h"
+#include "lua.h"
+#include "luadebug.h"
+#include "lualib.h"
+
+
+#ifndef OLD_ANSI
+#include <locale.h>
+#else
+#define setlocale(a,b)	0
+#define LC_ALL		0
+#define LC_COLLATE	0
+#define LC_CTYPE	0
+#define LC_MONETARY	0
+#define LC_NUMERIC	0
+#define LC_TIME		0
+#define strerror(e)	"(no error message provided by operating system)"
+#endif
+
+
+#define CLOSEDTAG	2
+#define IOTAG		1
+
+#define FIRSTARG      3  /* 1st and 2nd are upvalues */
+
+#define FINPUT		"_INPUT"
+#define FOUTPUT		"_OUTPUT"
+
+
+#ifdef POPEN
+FILE *popen();
+int pclose();
+#else
+#define popen(x,y) NULL  /* that is, popen always fails */
+#define pclose(x)  (-1)
+#endif
+
+
+static int gettag (int i)
+{
+  return lua_getnumber(lua_getparam(i));
+}
+
+
+static void pushresult (int i)
+{
+  if (i)
+    lua_pushuserdata(NULL);
+  else {
+    lua_pushnil();
+    lua_pushstring(strerror(errno));
+  }
+}
+
+
+static int ishandler (lua_Object f)
+{
+  if (lua_isuserdata(f)) {
+    if (lua_tag(f) == gettag(CLOSEDTAG))
+      lua_error("cannot access a closed file");
+    return lua_tag(f) == gettag(IOTAG);
+  }
+  else return 0;
+}
+
+static FILE *getfile (char *name)
+{
+  lua_Object f = lua_getglobal(name);
+  if (!ishandler(f))
+      luaL_verror("global variable `%.50s' is not a file handle", name);
+  return lua_getuserdata(f);
+}
+
+
+static FILE *getfileparam (char *name, int *arg)
+{
+  lua_Object f = lua_getparam(*arg);
+  if (ishandler(f)) {
+    (*arg)++;
+    return lua_getuserdata(f);
+  }
+  else
+    return getfile(name);
+}
+
+
+static void closefile (char *name)
+{
+  FILE *f = getfile(name);
+  if (f == stdin || f == stdout) return;
+  if (pclose(f) == -1)
+    fclose(f);
+  lua_pushobject(lua_getglobal(name));
+  lua_settag(gettag(CLOSEDTAG));
+}
+
+
+static void setfile (FILE *f, char *name, int tag)
+{
+  lua_pushusertag(f, tag);
+  lua_setglobal(name);
+}
+
+
+static void setreturn (FILE *f, char *name)
+{
+  int tag = gettag(IOTAG);
+  setfile(f, name, tag);
+  lua_pushusertag(f, tag);
+}
+
+
+static void io_readfrom (void)
+{
+  FILE *current;
+  lua_Object f = lua_getparam(FIRSTARG);
+  if (f == LUA_NOOBJECT) {
+    closefile(FINPUT);
+    current = stdin;
+  }
+  else if (lua_tag(f) == gettag(IOTAG))
+    current = lua_getuserdata(f);
+  else {
+    char *s = luaL_check_string(FIRSTARG);
+    current = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
+    if (current == NULL) {
+      pushresult(0);
+      return;
+    }
+  }
+  setreturn(current, FINPUT);
+}
+
+
+static void io_writeto (void)
+{
+  FILE *current;
+  lua_Object f = lua_getparam(FIRSTARG);
+  if (f == LUA_NOOBJECT) {
+    closefile(FOUTPUT);
+    current = stdout;
+  }
+  else if (lua_tag(f) == gettag(IOTAG))
+    current = lua_getuserdata(f);
+  else {
+    char *s = luaL_check_string(FIRSTARG);
+    current = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
+    if (current == NULL) {
+      pushresult(0);
+      return;
+    }
+  }
+  setreturn(current, FOUTPUT);
+}
+
+
+static void io_appendto (void)
+{
+  char *s = luaL_check_string(FIRSTARG);
+  FILE *fp = fopen (s, "a");
+  if (fp != NULL)
+    setreturn(fp, FOUTPUT);
+  else
+    pushresult(0);
+}
+
+
+#define NEED_OTHER (EOF-1)  /* just some flag different from EOF */
+
+
+static void read_until (FILE *f, int lim) {
+  int l = 0;
+  int c;
+  for (c = getc(f); c != EOF && c != lim; c = getc(f)) {
+    luaL_addchar(c);
+    l++;
+  }
+  if (l > 0 || c == lim)  /* read anything? */
+    lua_pushlstring(luaL_buffer(), l);
+}
+
+static void io_read (void) {
+  int arg = FIRSTARG;
+  FILE *f = getfileparam(FINPUT, &arg);
+  char *p = luaL_opt_string(arg, NULL);
+  luaL_resetbuffer();
+  if (p == NULL)  /* default: read a line */
+    read_until(f, '\n');
+  else if (p[0] == '.' && p[1] == '*' && p[2] == 0)  /* p = ".*" */
+    read_until(f, EOF);
+  else {
+    int l = 0;  /* number of chars read in buffer */
+    int inskip = 0;  /* to control {skips} */
+    int c = NEED_OTHER;
+    while (*p) {
+      switch (*p) {
+        case '{':
+          inskip++;
+          p++;
+          continue;
+        case '}':
+          if (inskip == 0)
+            lua_error("unbalanced braces in read pattern");
+          inskip--;
+          p++;
+          continue;
+        default: {
+          char *ep;  /* get what is next */
+          int m;  /* match result */
+          if (c == NEED_OTHER) c = getc(f);
+          if (c == EOF) {
+            luaI_singlematch(0, p, &ep);  /* to set "ep" */
+            m = 0;
+          }
+          else {
+            m = luaI_singlematch(c, p, &ep);
+            if (m) {
+              if (inskip == 0) {
+                luaL_addchar(c);
+                l++;
+              }
+              c = NEED_OTHER;
+            }
+          }
+          switch (*ep) {
+            case '*':  /* repetition */
+              if (!m) p = ep+1;  /* else stay in (repeat) the same item */
+              continue;
+            case '?':  /* optional */
+              p = ep+1;  /* continues reading the pattern */
+              continue;
+            default:
+              if (m) p = ep;  /* continues reading the pattern */
+              else
+                goto break_while;   /* pattern fails */
+          }
+        }
+      }
+    } break_while:
+    if (c >= 0)  /* not EOF nor NEED_OTHER? */
+       ungetc(c, f);
+    if (l > 0 || *p == 0)  /* read something or did not fail? */
+      lua_pushlstring(luaL_buffer(), l);
+  }
+}
+
+
+static void io_write (void)
+{
+  int arg = FIRSTARG;
+  FILE *f = getfileparam(FOUTPUT, &arg);
+  int status = 1;
+  char *s;
+  long l;
+  while ((s = luaL_opt_lstr(arg++, NULL, &l)) != NULL)
+    status = status && (fwrite(s, 1, l, f) == l);
+  pushresult(status);
+}
+
+
+static void io_execute (void)
+{
+  lua_pushnumber(system(luaL_check_string(1)));
+}
+
+
+static void io_remove  (void)
+{
+  pushresult(remove(luaL_check_string(1)) == 0);
+}
+
+
+static void io_rename (void)
+{
+  pushresult(rename(luaL_check_string(1),
+                    luaL_check_string(2)) == 0);
+}
+
+
+static void io_tmpname (void)
+{
+  lua_pushstring(tmpnam(NULL));
+}
+
+
+
+static void io_getenv (void)
+{
+  lua_pushstring(getenv(luaL_check_string(1)));  /* if NULL push nil */
+}
+
+
+static void io_clock (void) {
+  lua_pushnumber(((double)clock())/CLOCKS_PER_SEC);
+}
+
+
+static void io_date (void)
+{
+  time_t t;
+  struct tm *tm;
+  char *s = luaL_opt_string(1, "%c");
+  char b[BUFSIZ];
+  time(&t); tm = localtime(&t);
+  if (strftime(b,sizeof(b),s,tm))
+    lua_pushstring(b);
+  else
+    lua_error("invalid `date' format");
+}
+
+
+static void setloc (void)
+{
+  static int cat[] = {LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC,
+                      LC_TIME};
+  static char *catnames[] = {"all", "collate", "ctype", "monetary",
+     "numeric", "time", NULL};
+  int op = luaL_findstring(luaL_opt_string(2, "all"), catnames);
+  luaL_arg_check(op != -1, 2, "invalid option");
+  lua_pushstring(setlocale(cat[op], luaL_check_string(1)));
+}
+
+
+static void io_exit (void)
+{
+  lua_Object o = lua_getparam(1);
+  exit(lua_isnumber(o) ? (int)lua_getnumber(o) : 1);
+}
+
+
+static void io_debug (void)
+{
+  while (1) {
+    char buffer[250];
+    fprintf(stderr, "lua_debug> ");
+    if (fgets(buffer, sizeof(buffer), stdin) == 0) return;
+    if (strcmp(buffer, "cont\n") == 0) return;
+    lua_dostring(buffer);
+  }
+}
+
+
+static void lua_printstack (FILE *f)
+{
+  int level = 1;  /* skip level 0 (it's this function) */
+  lua_Object func;
+  while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT) {
+    char *name;
+    int currentline;
+    char *filename;
+    int linedefined;
+    lua_funcinfo(func, &filename, &linedefined);
+    fprintf(f, (level==2) ? "Active Stack:\n\t" : "\t");
+    switch (*lua_getobjname(func, &name)) {
+      case 'g':
+        fprintf(f, "function %s", name);
+        break;
+      case 't':
+        fprintf(f, "`%s' tag method", name);
+        break;
+      default: {
+        if (linedefined == 0)
+          fprintf(f, "main of %s", filename);
+        else if (linedefined < 0)
+          fprintf(f, "%s", filename);
+        else
+          fprintf(f, "function (%s:%d)", filename, linedefined);
+        filename = NULL;
+      }
+    }
+    if ((currentline = lua_currentline(func)) > 0)
+      fprintf(f, " at line %d", currentline);
+    if (filename)
+      fprintf(f, " [in file %s]", filename);
+    fprintf(f, "\n");
+  }
+}
+
+
+static void errorfb (void)
+{
+  fprintf(stderr, "lua: %s\n", lua_getstring(lua_getparam(1)));
+  lua_printstack(stderr);
+}
+
+
+
+static struct luaL_reg iolib[] = {
+{"setlocale", setloc},
+{"execute",  io_execute},
+{"remove",   io_remove},
+{"rename",   io_rename},
+{"tmpname",   io_tmpname},
+{"getenv",   io_getenv},
+{"date",     io_date},
+{"clock",     io_clock},
+{"exit",     io_exit},
+{"debug",    io_debug},
+{"print_stack", errorfb}
+};
+
+static struct luaL_reg iolibtag[] = {
+{"readfrom", io_readfrom},
+{"writeto",  io_writeto},
+{"appendto", io_appendto},
+{"read",     io_read},
+{"write",    io_write}
+};
+
+static void openwithtags (void)
+{
+  int iotag = lua_newtag();
+  int closedtag = lua_newtag();
+  int i;
+  for (i=0; i<sizeof(iolibtag)/sizeof(iolibtag[0]); i++) {
+    /* put both tags as upvalues for these functions */
+    lua_pushnumber(iotag);
+    lua_pushnumber(closedtag);
+    lua_pushcclosure(iolibtag[i].func, 2);
+    lua_setglobal(iolibtag[i].name);
+  }
+  setfile(stdin, FINPUT, iotag);
+  setfile(stdout, FOUTPUT, iotag);
+  setfile(stdin, "_STDIN", iotag);
+  setfile(stdout, "_STDOUT", iotag);
+  setfile(stderr, "_STDERR", iotag);
+}
+
+void lua_iolibopen (void)
+{
+  luaL_openlib(iolib, (sizeof(iolib)/sizeof(iolib[0])));
+  openwithtags();
+  lua_pushcfunction(errorfb);
+  lua_seterrormethod();
+}

llex.c

@@ -0,0 +1,463 @@
+/*
+** $Id: llex.c,v 1.22 1998/06/19 18:47:06 roberto Exp roberto $
+** Lexical Analizer
+** See Copyright Notice in lua.h
+*/
+
+
+#include <ctype.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lparser.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "luadebug.h"
+#include "lzio.h"
+
+
+
+int lua_debug=0;
+
+
+#define next(LS) (LS->current = zgetc(LS->lex_z))
+
+
+#define save(c)	luaL_addchar(c)
+#define save_and_next(LS)  (save(LS->current), next(LS))
+
+
+char *reserved [] = {"and", "do", "else", "elseif", "end", "function",
+    "if", "local", "nil", "not", "or", "repeat", "return", "then",
+    "until", "while"};
+
+
+void luaX_init (void)
+{
+  int i;
+  for (i=0; i<(sizeof(reserved)/sizeof(reserved[0])); i++) {
+    TaggedString *ts = luaS_new(reserved[i]);
+    ts->head.marked = FIRST_RESERVED+i;  /* reserved word  (always > 255) */
+  }
+}
+
+
+void luaX_syntaxerror (LexState *ls, char *s, char *token) {
+  if (token[0] == 0)
+    token = "<eof>";
+  luaL_verror("%.100s;\n  last token read: `%.50s' at line %d in chunk `%.50s'",
+              s, token, ls->linenumber, zname(ls->lex_z));
+}
+
+
+void luaX_error (LexState *ls, char *s) {
+  save(0);
+  luaX_syntaxerror(ls, s, luaL_buffer());
+}
+
+
+void luaX_token2str (LexState *ls, int token, char *s) {
+  if (token < 255) {
+    s[0] = token;
+    s[1] = 0;
+  }
+  else
+    strcpy(s, reserved[token-FIRST_RESERVED]);
+}
+
+
+static void luaX_invalidchar (LexState *ls, int c) {
+  char buff[10];
+  sprintf(buff, "0x%X", c);
+  luaX_syntaxerror(ls, "invalid control char", buff);
+}
+
+
+static void firstline (LexState *LS)
+{
+  int c = zgetc(LS->lex_z);
+  if (c == '#')
+    while ((c=zgetc(LS->lex_z)) != '\n' && c != EOZ) /* skip first line */;
+  zungetc(LS->lex_z);
+}
+
+
+void luaX_setinput (LexState *LS, ZIO *z)
+{
+  LS->current = '\n';
+  LS->linenumber = 0;
+  LS->iflevel = 0;
+  LS->ifstate[0].skip = 0;
+  LS->ifstate[0].elsepart = 1;  /* to avoid a free $else */
+  LS->lex_z = z;
+  LS->fs = NULL;
+  firstline(LS);
+  luaL_resetbuffer();
+}
+
+
+
+/*
+** =======================================================
+** PRAGMAS
+** =======================================================
+*/
+
+#define PRAGMASIZE	20
+
+static void skipspace (LexState *LS)
+{
+  while (LS->current == ' ' || LS->current == '\t' || LS->current == '\r')
+    next(LS);
+}
+
+
+static int checkcond (LexState *LS, char *buff)
+{
+  static char *opts[] = {"nil", "1", NULL};
+  int i = luaL_findstring(buff, opts);
+  if (i >= 0) return i;
+  else if (isalpha((unsigned char)buff[0]) || buff[0] == '_')
+    return luaS_globaldefined(buff);
+  else {
+    luaX_syntaxerror(LS, "invalid $if condition", buff);
+    return 0;  /* to avoid warnings */
+  }
+}
+
+
+static void readname (LexState *LS, char *buff)
+{
+  int i = 0;
+  skipspace(LS);
+  while (isalnum(LS->current) || LS->current == '_') {
+    if (i >= PRAGMASIZE) {
+      buff[PRAGMASIZE] = 0;
+      luaX_syntaxerror(LS, "pragma too long", buff);
+    }
+    buff[i++] = LS->current;
+    next(LS);
+  }
+  buff[i] = 0;
+}
+
+
+static void inclinenumber (LexState *LS);
+
+
+static void ifskip (LexState *LS)
+{
+  while (LS->ifstate[LS->iflevel].skip) {
+    if (LS->current == '\n')
+      inclinenumber(LS);
+    else if (LS->current == EOZ)
+      luaX_error(LS, "input ends inside a $if");
+    else next(LS);
+  }
+}
+
+
+static void inclinenumber (LexState *LS)
+{
+  static char *pragmas [] =
+    {"debug", "nodebug", "endinput", "end", "ifnot", "if", "else", NULL};
+  next(LS);  /* skip '\n' */
+  ++LS->linenumber;
+  if (LS->current == '$') {  /* is a pragma? */
+    char buff[PRAGMASIZE+1];
+    int ifnot = 0;
+    int skip = LS->ifstate[LS->iflevel].skip;
+    next(LS);  /* skip $ */
+    readname(LS, buff);
+    switch (luaL_findstring(buff, pragmas)) {
+      case 0:  /* debug */
+        if (!skip) lua_debug = 1;
+        break;
+      case 1:  /* nodebug */
+        if (!skip) lua_debug = 0;
+        break;
+      case 2:  /* endinput */
+        if (!skip) {
+          LS->current = EOZ;
+          LS->iflevel = 0;  /* to allow $endinput inside a $if */
+        }
+        break;
+      case 3:  /* end */
+        if (LS->iflevel-- == 0)
+          luaX_syntaxerror(LS, "unmatched $end", "$end");
+        break;
+      case 4:  /* ifnot */
+        ifnot = 1;
+        /* go through */
+      case 5:  /* if */
+        if (LS->iflevel == MAX_IFS-1)
+          luaX_syntaxerror(LS, "too many nested $ifs", "$if");
+        readname(LS, buff);
+        LS->iflevel++;
+        LS->ifstate[LS->iflevel].elsepart = 0;
+        LS->ifstate[LS->iflevel].condition = checkcond(LS, buff) ? !ifnot : ifnot;
+        LS->ifstate[LS->iflevel].skip = skip || !LS->ifstate[LS->iflevel].condition;
+        break;
+      case 6:  /* else */
+        if (LS->ifstate[LS->iflevel].elsepart)
+          luaX_syntaxerror(LS, "unmatched $else", "$else");
+        LS->ifstate[LS->iflevel].elsepart = 1;
+        LS->ifstate[LS->iflevel].skip = LS->ifstate[LS->iflevel-1].skip ||
+                                      LS->ifstate[LS->iflevel].condition;
+        break;
+      default:
+        luaX_syntaxerror(LS, "unknown pragma", buff);
+    }
+    skipspace(LS);
+    if (LS->current == '\n')  /* pragma must end with a '\n' ... */
+      inclinenumber(LS);
+    else if (LS->current != EOZ)  /* or eof */
+      luaX_syntaxerror(LS, "invalid pragma format", buff);
+    ifskip(LS);
+  }
+}
+
+
+/*
+** =======================================================
+** LEXICAL ANALIZER
+** =======================================================
+*/
+
+
+
+
+
+static int read_long_string (LexState *LS)
+{
+  int cont = 0;
+  while (1) {
+    switch (LS->current) {
+      case EOZ:
+        luaX_error(LS, "unfinished long string");
+        return EOS;  /* to avoid warnings */
+      case '[':
+        save_and_next(LS);
+        if (LS->current == '[') {
+          cont++;
+          save_and_next(LS);
+        }
+        continue;
+      case ']':
+        save_and_next(LS);
+        if (LS->current == ']') {
+          if (cont == 0) goto endloop;
+          cont--;
+          save_and_next(LS);
+        }
+        continue;
+      case '\n':
+        save('\n');
+        inclinenumber(LS);
+        continue;
+      default:
+        save_and_next(LS);
+    }
+  } endloop:
+  save_and_next(LS);  /* pass the second ']' */
+  LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+2,
+                          L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-4);
+  return STRING;
+}
+
+
+int luaX_lex (LexState *LS) {
+  double a;
+  luaL_resetbuffer();
+  while (1) {
+    switch (LS->current) {
+
+      case ' ': case '\t': case '\r':  /* CR: to avoid problems with DOS */
+        next(LS);
+        continue;
+
+      case '\n':
+        inclinenumber(LS);
+        continue;
+
+      case '-':
+        save_and_next(LS);
+        if (LS->current != '-') return '-';
+        do { next(LS); } while (LS->current != '\n' && LS->current != EOZ);
+        luaL_resetbuffer();
+        continue;
+
+      case '[':
+        save_and_next(LS);
+        if (LS->current != '[') return '[';
+        else {
+          save_and_next(LS);  /* pass the second '[' */
+          return read_long_string(LS);
+        }
+
+      case '=':
+        save_and_next(LS);
+        if (LS->current != '=') return '=';
+        else { save_and_next(LS); return EQ; }
+
+      case '<':
+        save_and_next(LS);
+        if (LS->current != '=') return '<';
+        else { save_and_next(LS); return LE; }
+
+      case '>':
+        save_and_next(LS);
+        if (LS->current != '=') return '>';
+        else { save_and_next(LS); return GE; }
+
+      case '~':
+        save_and_next(LS);
+        if (LS->current != '=') return '~';
+        else { save_and_next(LS); return NE; }
+
+      case '"':
+      case '\'': {
+        int del = LS->current;
+        save_and_next(LS);
+        while (LS->current != del) {
+          switch (LS->current) {
+            case EOZ:
+            case '\n':
+              luaX_error(LS, "unfinished string");
+              return EOS;  /* to avoid warnings */
+            case '\\':
+              next(LS);  /* do not save the '\' */
+              switch (LS->current) {
+                case 'a': save('\a'); next(LS); break;
+                case 'b': save('\b'); next(LS); break;
+                case 'f': save('\f'); next(LS); break;
+                case 'n': save('\n'); next(LS); break;
+                case 'r': save('\r'); next(LS); break;
+                case 't': save('\t'); next(LS); break;
+                case 'v': save('\v'); next(LS); break;
+                case '\n': save('\n'); inclinenumber(LS); break;
+                default : {
+                  if (isdigit(LS->current)) {
+                    int c = 0;
+                    int i = 0;
+                    do {
+                      c = 10*c + (LS->current-'0');
+                      next(LS);
+                    } while (++i<3 && isdigit(LS->current));
+                    if (c >= 256)
+                      luaX_error(LS, "escape sequence too large");
+                    save(c);
+                  }
+                  else {  /* handles \, ", ', and ? */
+                    save(LS->current);
+                    next(LS);
+                  }
+                  break;
+                }
+              }
+              break;
+            default:
+              save_and_next(LS);
+          }
+        }
+        save_and_next(LS);  /* skip delimiter */
+        LS->seminfo.ts = luaS_newlstr(L->Mbuffbase+1,
+                                L->Mbuffnext-(L->Mbuffbase-L->Mbuffer)-2);
+        return STRING;
+      }
+
+      case '.':
+        save_and_next(LS);
+        if (LS->current == '.')
+        {
+          save_and_next(LS);
+          if (LS->current == '.')
+          {
+            save_and_next(LS);
+            return DOTS;   /* ... */
+          }
+          else return CONC;   /* .. */
+        }
+        else if (!isdigit(LS->current)) return '.';
+        /* LS->current is a digit: goes through to number */
+	a=0.0;
+        goto fraction;
+
+      case '0': case '1': case '2': case '3': case '4':
+      case '5': case '6': case '7': case '8': case '9':
+	a=0.0;
+        do {
+          a = 10.0*a + (LS->current-'0');
+          save_and_next(LS);
+        } while (isdigit(LS->current));
+        if (LS->current == '.') {
+          save_and_next(LS);
+          if (LS->current == '.') {
+            save('.');
+            luaX_error(LS, 
+              "ambiguous syntax (decimal point x string concatenation)");
+          }
+        }
+      fraction:
+	{ double da=0.1;
+	  while (isdigit(LS->current))
+	  {
+            a += (LS->current-'0')*da;
+            da /= 10.0;
+            save_and_next(LS);
+          }
+          if (toupper(LS->current) == 'E') {
+	    int e = 0;
+	    int neg;
+	    double ea;
+            save_and_next(LS);
+	    neg = (LS->current=='-');
+            if (LS->current == '+' || LS->current == '-') save_and_next(LS);
+            if (!isdigit(LS->current))
+              luaX_error(LS, "invalid numeral format");
+            do {
+              e = 10*e + (LS->current-'0');
+              save_and_next(LS);
+            } while (isdigit(LS->current));
+	    for (ea=neg?0.1:10.0; e>0; e>>=1)
+	    {
+	      if (e & 1) a *= ea;
+	      ea *= ea;
+	    }
+          }
+          LS->seminfo.r = a;
+          return NUMBER;
+        }
+
+      case EOZ:
+        if (LS->iflevel > 0)
+          luaX_error(LS, "input ends inside a $if");
+        return EOS;
+
+      default:
+        if (LS->current != '_' && !isalpha(LS->current)) {
+          int c = LS->current;
+          if (iscntrl(c))
+            luaX_invalidchar(LS, c);
+          save_and_next(LS);
+          return c;
+        }
+        else {  /* identifier or reserved word */
+          TaggedString *ts;
+          do {
+            save_and_next(LS);
+          } while (isalnum(LS->current) || LS->current == '_');
+          save(0);
+          ts = luaS_new(L->Mbuffbase);
+          if (ts->head.marked >= 'A')
+            return ts->head.marked;  /* reserved word */
+          LS->seminfo.ts = ts;
+          return NAME;
+        }
+    }
+  }
+}
+

llex.h

@@ -0,0 +1,62 @@
+/*
+** $Id: llex.h,v 1.8 1998/05/27 13:03:40 roberto Exp roberto $
+** Lexical Analizer
+** See Copyright Notice in lua.h
+*/
+
+#ifndef llex_h
+#define llex_h
+
+#include "lobject.h"
+#include "lzio.h"
+
+
+#define FIRST_RESERVED	260
+
+/* maximum length of a reserved word (+1 for terminal 0) */
+#define TOKEN_LEN	15
+
+enum RESERVED {
+  /* terminal symbols denoted by reserved words */
+  AND = FIRST_RESERVED,
+  DO, ELSE, ELSEIF, END, FUNCTION, IF, LOCAL, NIL, NOT, OR,
+  REPEAT, RETURN, THEN, UNTIL, WHILE,
+  /* other terminal symbols */
+  NAME, CONC, DOTS, EQ, GE, LE, NE, NUMBER, STRING, EOS};
+
+
+#define MAX_IFS 5
+
+/* "ifstate" keeps the state of each nested $if the lexical is dealing with. */
+
+struct ifState {
+  int elsepart;  /* true if its in the $else part */
+  int condition;  /* true if $if condition is true */
+  int skip;  /* true if part must be skipped */
+};
+
+
+typedef struct LexState {
+  int current;  /* look ahead character */
+  int token;  /* look ahead token */
+  struct FuncState *fs;  /* 'FuncState' is private for the parser */
+  union {
+    real r;
+    TaggedString *ts;
+  } seminfo;  /* semantics information */
+  struct zio *lex_z;  /* input stream */
+  int linenumber;  /* input line counter */
+  int iflevel;  /* level of nested $if's (for lexical analysis) */
+  struct ifState ifstate[MAX_IFS];
+} LexState;
+
+
+void luaX_init (void);
+void luaX_setinput (LexState *LS, ZIO *z);
+int luaX_lex (LexState *LS);
+void luaX_syntaxerror (LexState *ls, char *s, char *token);
+void luaX_error (LexState *ls, char *s);
+void luaX_token2str (LexState *ls, int token, char *s);
+
+
+#endif

lmathlib.c

@@ -0,0 +1,213 @@
+/*
+** $Id: lmathlib.c,v 1.9 1998/05/27 19:09:39 roberto Exp roberto $
+** Lua standard mathematical library
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+#include <math.h>
+
+#include "lauxlib.h"
+#include "lua.h"
+#include "lualib.h"
+
+#ifdef M_PI
+#define PI                      M_PI
+#else
+#define PI          ((double)3.14159265358979323846)
+#endif
+
+
+#define FROMRAD(a) ((a)*(180.0/PI))
+#define TORAD(a)    ((a)*(PI/180.0))
+
+
+static void math_abs (void)
+{
+  double d = luaL_check_number(1);
+  if (d < 0) d = -d;
+  lua_pushnumber(d);
+}
+
+static void math_sin (void)
+{
+  lua_pushnumber(sin(TORAD(luaL_check_number(1))));
+}
+
+static void math_cos (void)
+{
+  lua_pushnumber(cos(TORAD(luaL_check_number(1))));
+}
+
+static void math_tan (void)
+{
+  lua_pushnumber(tan(TORAD(luaL_check_number(1))));
+}
+
+static void math_asin (void)
+{
+  lua_pushnumber(FROMRAD(asin(luaL_check_number(1))));
+}
+
+static void math_acos (void)
+{
+  lua_pushnumber(FROMRAD(acos(luaL_check_number(1))));
+}
+
+static void math_atan (void)
+{
+  lua_pushnumber(FROMRAD(atan(luaL_check_number(1))));
+}
+
+static void math_atan2 (void)
+{
+  lua_pushnumber(FROMRAD(atan2(luaL_check_number(1), luaL_check_number(2))));
+}
+
+static void math_ceil (void)
+{
+  lua_pushnumber(ceil(luaL_check_number(1)));
+}
+
+static void math_floor (void)
+{
+  lua_pushnumber(floor(luaL_check_number(1)));
+}
+
+static void math_mod (void)
+{
+  lua_pushnumber(fmod(luaL_check_number(1), luaL_check_number(2)));
+}
+
+static void math_sqrt (void)
+{
+  lua_pushnumber(sqrt(luaL_check_number(1)));
+}
+
+static void math_pow (void)
+{
+  lua_pushnumber(pow(luaL_check_number(1), luaL_check_number(2)));
+}
+
+static void math_log (void)
+{
+  lua_pushnumber(log(luaL_check_number(1)));
+}
+
+static void math_log10 (void)
+{
+  lua_pushnumber(log10(luaL_check_number(1)));
+}
+
+static void math_exp (void)
+{
+  lua_pushnumber(exp(luaL_check_number(1)));
+}
+
+static void math_deg (void)
+{
+  lua_pushnumber(luaL_check_number(1)*(180.0/PI));
+}
+
+static void math_rad (void)
+{
+  lua_pushnumber(luaL_check_number(1)*(PI/180.0));
+}
+
+static void math_frexp (void) {
+  int e;
+  lua_pushnumber(frexp(luaL_check_number(1), &e));
+  lua_pushnumber(e);
+}
+
+static void math_ldexp (void) {
+  lua_pushnumber(ldexp(luaL_check_number(1), luaL_check_number(2)));
+}
+
+
+
+static void math_min (void)
+{
+  int i = 1;
+  double dmin = luaL_check_number(i);
+  while (lua_getparam(++i) != LUA_NOOBJECT) {
+    double d = luaL_check_number(i);
+    if (d < dmin)
+      dmin = d;
+  }
+  lua_pushnumber(dmin);
+}
+
+
+static void math_max (void)
+{
+  int i = 1;
+  double dmax = luaL_check_number(i);
+  while (lua_getparam(++i) != LUA_NOOBJECT) {
+    double d = luaL_check_number(i);
+    if (d > dmax)
+      dmax = d;
+  }
+  lua_pushnumber(dmax);
+}
+
+
+static void math_random (void)
+{
+  /* the '%' is needed because on some systems (SunOS!) "rand()" may */
+  /* return a value bigger than RAND_MAX... */
+  double r = (double)(rand()%RAND_MAX) / (double)RAND_MAX;
+  double l = luaL_opt_number(1, 0);
+  if (l == 0)
+    lua_pushnumber(r);
+  else
+    lua_pushnumber((int)(r*l)+1);
+}
+
+
+static void math_randomseed (void)
+{
+  srand(luaL_check_number(1));
+}
+
+
+static struct luaL_reg mathlib[] = {
+{"abs",   math_abs},
+{"sin",   math_sin},
+{"cos",   math_cos},
+{"tan",   math_tan},
+{"asin",  math_asin},
+{"acos",  math_acos},
+{"atan",  math_atan},
+{"atan2", math_atan2},
+{"ceil",  math_ceil},
+{"floor", math_floor},
+{"mod",   math_mod},
+{"frexp", math_frexp},
+{"ldexp", math_ldexp},
+{"sqrt",  math_sqrt},
+{"min",   math_min},
+{"max",   math_max},
+{"log",   math_log},
+{"log10", math_log10},
+{"exp",   math_exp},
+{"deg",   math_deg},
+{"rad",   math_rad},
+{"random",     math_random},
+{"randomseed", math_randomseed}
+};
+
+/*
+** Open math library
+*/
+void lua_mathlibopen (void)
+{
+  luaL_openlib(mathlib, (sizeof(mathlib)/sizeof(mathlib[0])));
+  lua_pushstring("deg"); lua_setglobal("_TRIGMODE");
+  lua_pushcfunction(math_pow);
+  lua_pushnumber(0);  /* to get its tag */
+  lua_settagmethod(lua_tag(lua_pop()), "pow");
+  lua_pushnumber(PI); lua_setglobal("PI");
+}
+

lmem.c

@@ -0,0 +1,113 @@
+/*
+** $Id: lmem.c,v 1.6 1998/06/19 16:14:09 roberto Exp roberto $
+** Interface to Memory Manager
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdlib.h>
+
+#include "lmem.h"
+#include "lstate.h"
+#include "lua.h"
+
+
+
+int luaM_growaux (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit)
+{
+  if (nelems >= limit)
+    lua_error(errormsg);
+  nelems = (nelems == 0) ? 32 : nelems*2;
+  if (nelems > limit)
+    nelems = limit;
+  *block = luaM_realloc(*block, nelems*size);
+  return (int)nelems;
+}
+
+
+
+#ifndef DEBUG
+
+/*
+** generic allocation routine.
+** real ANSI systems do not need some of these tests,
+** since realloc(NULL, s)==malloc(s) and realloc(b, 0)==free(b).
+** But some systems (e.g. Sun OS) are not that ANSI...
+*/
+void *luaM_realloc (void *block, unsigned long size)
+{
+  size_t s = (size_t)size;
+  if (s != size)
+    lua_error("Allocation Error: Block too big");
+  if (size == 0) {
+    if (block) {
+      free(block);
+    }
+    return NULL;
+  }
+  block = block ? realloc(block, s) : malloc(s);
+  if (block == NULL)
+    lua_error(memEM);
+  return block;
+}
+
+
+
+#else
+/* DEBUG */
+
+#include <string.h>
+
+
+#define HEADER	(sizeof(double))
+
+#define MARK    55
+
+unsigned long numblocks = 0;
+unsigned long totalmem = 0;
+
+
+static void *checkblock (void *block)
+{
+  unsigned long *b = (unsigned long *)((char *)block - HEADER);
+  unsigned long size = *b;
+  LUA_ASSERT(*(((char *)b)+size+HEADER) == MARK, 
+             "corrupted block");
+  numblocks--;
+  totalmem -= size;
+  return b;
+}
+
+
+void *luaM_realloc (void *block, unsigned long size)
+{
+  unsigned long realsize = HEADER+size+1;
+  if (realsize != (size_t)realsize)
+    lua_error("Allocation Error: Block too big");
+  if (size == 0) {  /* ANSI dosen't need this, but some machines... */
+    if (block) {
+      unsigned long *b = (unsigned long *)((char *)block - HEADER);
+      memset(block, -1, *b);  /* erase block */
+      block = checkblock(block);
+      free(block);
+    }
+    return NULL;
+  }
+  if (block) {
+    block = checkblock(block);
+    block = (unsigned long *)realloc(block, realsize);
+  }
+  else
+    block = (unsigned long *)malloc(realsize);
+  if (block == NULL)
+    lua_error(memEM);
+  totalmem += size;
+  numblocks++;
+  *(unsigned long *)block = size;
+  *(((char *)block)+size+HEADER) = MARK;
+  return (unsigned long *)((char *)block+HEADER);
+}
+
+
+#endif

lmem.h

@@ -0,0 +1,43 @@
+/*
+** $Id: lmem.h,v 1.4 1997/12/01 20:30:44 roberto Exp roberto $
+** Interface to Memory Manager
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lmem_h
+#define lmem_h
+
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+
+/* memory error messages */
+#define codeEM   "code size overflow"
+#define constantEM   "constant table overflow"
+#define refEM   "reference table overflow"
+#define tableEM  "table overflow"
+#define memEM "not enough memory"
+
+void *luaM_realloc (void *oldblock, unsigned long size);
+int luaM_growaux (void **block, unsigned long nelems, int size,
+                       char *errormsg, unsigned long limit);
+
+#define luaM_free(b)	luaM_realloc((b), 0)
+#define luaM_malloc(t)	luaM_realloc(NULL, (t))
+#define luaM_new(t)          ((t *)luaM_malloc(sizeof(t)))
+#define luaM_newvector(n,t)  ((t *)luaM_malloc((n)*sizeof(t)))
+#define luaM_growvector(old,n,t,e,l) \
+          (luaM_growaux((void**)old,n,sizeof(t),e,l))
+#define luaM_reallocvector(v,n,t) ((t *)luaM_realloc(v,(n)*sizeof(t)))
+
+
+#ifdef DEBUG
+extern unsigned long numblocks;
+extern unsigned long totalmem;
+#endif
+
+
+#endif
+

lobject.c

@@ -0,0 +1,83 @@
+/*
+** $Id: lobject.c,v 1.12 1998/06/18 16:57:03 roberto Exp roberto $
+** Some generic functions over Lua objects
+** See Copyright Notice in lua.h
+*/
+
+#include <stdlib.h>
+
+#include "lobject.h"
+#include "lua.h"
+
+
+char *luaO_typenames[] = { /* ORDER LUA_T */
+    "userdata", "number", "string", "table", "function", "function",
+    "nil", "function", "mark", "mark", "mark", "line", NULL
+};
+
+
+TObject luaO_nilobject = {LUA_T_NIL, {NULL}};
+
+
+
+/* hash dimensions values */
+static long dimensions[] =
+ {5L, 11L, 23L, 47L, 97L, 197L, 397L, 797L, 1597L, 3203L, 6421L,
+  12853L, 25717L, 51437L, 102811L, 205619L, 411233L, 822433L,
+  1644817L, 3289613L, 6579211L, 13158023L, MAX_INT};
+
+
+int luaO_redimension (int oldsize)
+{
+  int i;
+  for (i=0; dimensions[i]<MAX_INT; i++) {
+    if (dimensions[i] > oldsize)
+      return dimensions[i];
+  }
+  lua_error("table overflow");
+  return 0;  /* to avoid warnings */
+}
+
+
+int luaO_equalObj (TObject *t1, TObject *t2)
+{
+  if (ttype(t1) != ttype(t2)) return 0;
+  switch (ttype(t1)) {
+    case LUA_T_NIL: return 1;
+    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
+    case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
+    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
+    case LUA_T_PROTO: return tfvalue(t1)  == tfvalue(t2);
+    case LUA_T_CPROTO: return fvalue(t1)  == fvalue(t2);
+    case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;
+    default:
+     LUA_INTERNALERROR("invalid type");
+     return 0; /* UNREACHABLE */
+  }
+}
+
+
+void luaO_insertlist (GCnode *root, GCnode *node)
+{
+  node->next = root->next;
+  root->next = node;
+  node->marked = 0;
+}
+
+#ifdef OLD_ANSI
+void luaO_memup (void *dest, void *src, int size)
+{
+  char *d = dest;
+  char *s = src;
+  while (size--) d[size]=s[size];
+}
+
+void luaO_memdown (void *dest, void *src, int size)
+{
+  char *d = dest;
+  char *s = src;
+  int i;
+  for (i=0; i<size; i++) d[i]=s[i];
+}
+#endif
+

lobject.h

@@ -0,0 +1,210 @@
+/*
+** $Id: lobject.h,v 1.20 1998/06/11 18:21:37 roberto Exp roberto $
+** Type definitions for Lua objects
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lobject_h
+#define lobject_h
+
+
+#include <limits.h>
+
+#include "lua.h"
+
+
+#ifdef DEBUG
+#include "lauxlib.h"
+#define LUA_INTERNALERROR(s)	\
+	luaL_verror("INTERNAL ERROR - %s [%s:%d]",(s),__FILE__,__LINE__)
+#define LUA_ASSERT(c,s) { if (!(c)) LUA_INTERNALERROR(s); }
+#else
+#define LUA_INTERNALERROR(s)  /* empty */
+#define LUA_ASSERT(c,s)  /* empty */
+#endif
+
+
+/*
+** "real" is the type "number" of Lua
+** GREP LUA_NUMBER to change that
+*/
+#ifndef LUA_NUM_TYPE
+#define LUA_NUM_TYPE double
+#endif
+
+/*
+** format to convert number to strings
+*/
+#define NUMBER_FMT  "%g"
+
+typedef LUA_NUM_TYPE real;
+
+#define Byte lua_Byte	/* some systems have Byte as a predefined type */
+typedef unsigned char  Byte;  /* unsigned 8 bits */
+
+
+#define MAX_INT   (INT_MAX-2)  /* maximum value of an int (-2 for safety) */
+
+/* maximum value of a word of 2 bytes (-2 for safety); must fit in an "int" */
+#if MAX_INT < 65534
+#define MAX_WORD	MAX_INT
+#else
+#define MAX_WORD	65534
+#endif
+
+typedef unsigned int IntPoint; /* unsigned with same size as a pointer (for hashing) */
+
+
+/*
+** Lua TYPES
+** WARNING: if you change the order of this enumeration,
+** grep "ORDER LUA_T"
+*/
+typedef enum {
+  LUA_T_USERDATA =  0,  /* tag default for userdata */
+  LUA_T_NUMBER   = -1,  /* fixed tag for numbers */
+  LUA_T_STRING   = -2,  /* fixed tag for strings */
+  LUA_T_ARRAY    = -3,  /* tag default for tables (or arrays) */
+  LUA_T_PROTO    = -4,  /* fixed tag for functions */
+  LUA_T_CPROTO   = -5,  /* fixed tag for Cfunctions */
+  LUA_T_NIL      = -6,  /* last "pre-defined" tag */
+  LUA_T_CLOSURE  = -7,
+  LUA_T_CLMARK   = -8,  /* mark for closures */
+  LUA_T_PMARK    = -9,  /* mark for Lua prototypes */
+  LUA_T_CMARK    = -10, /* mark for C prototypes */
+  LUA_T_LINE     = -11
+} lua_Type;
+
+#define NUM_TYPES 11
+#define NUM_TAGS  7
+
+
+typedef union {
+  lua_CFunction f;  /* LUA_T_CPROTO, LUA_T_CMARK */
+  real n;  /* LUA_T_NUMBER */
+  struct TaggedString *ts;  /* LUA_T_STRING, LUA_T_USERDATA */
+  struct TProtoFunc *tf;  /* LUA_T_PROTO, LUA_T_PMARK */
+  struct Closure *cl;  /* LUA_T_CLOSURE, LUA_T_CLMARK */
+  struct Hash *a;  /* LUA_T_ARRAY */
+  int i;  /* LUA_T_LINE */
+} Value;
+
+
+typedef struct TObject {
+  lua_Type ttype;
+  Value value;
+} TObject;
+
+
+
+/*
+** generic header for garbage collector lists
+*/
+typedef struct GCnode {
+  struct GCnode *next;
+  int marked;
+} GCnode;
+
+
+/*
+** String headers for string table
+*/
+
+typedef struct TaggedString {
+  GCnode head;
+  unsigned long hash;
+  int constindex;  /* hint to reuse constants (= -1 if this is a userdata) */
+  union {
+    struct {
+      TObject globalval;
+      long len;  /* if this is a string, here is its length */
+    } s;
+    struct {
+      int tag;
+      void *v;  /* if this is a userdata, here is its value */
+    } d;
+  } u;
+  char str[1];   /* \0 byte already reserved */
+} TaggedString;
+
+
+
+
+/*
+** Function Prototypes
+*/
+typedef struct TProtoFunc {
+  GCnode head;
+  struct TObject *consts;
+  int nconsts;
+  Byte *code;  /* ends with opcode ENDCODE */
+  int lineDefined;
+  TaggedString  *fileName;
+  struct LocVar *locvars;  /* ends with line = -1 */
+} TProtoFunc;
+
+typedef struct LocVar {
+  TaggedString *varname;           /* NULL signals end of scope */
+  int line;
+} LocVar;
+
+
+
+
+
+/* Macros to access structure members */
+#define ttype(o)        ((o)->ttype)
+#define nvalue(o)       ((o)->value.n)
+#define svalue(o)       ((o)->value.ts->str)
+#define tsvalue(o)      ((o)->value.ts)
+#define clvalue(o)      ((o)->value.cl)
+#define avalue(o)       ((o)->value.a)
+#define fvalue(o)       ((o)->value.f)
+#define tfvalue(o)	((o)->value.tf)
+
+#define protovalue(o)	((o)->value.cl->consts)
+
+
+/*
+** Closures
+*/
+typedef struct Closure {
+  GCnode head;
+  int nelems;  /* not included the first one (always the prototype) */
+  TObject consts[1];  /* at least one for prototype */
+} Closure;
+
+
+
+typedef struct node {
+  TObject ref;
+  TObject val;
+} Node;
+
+typedef struct Hash {
+  GCnode head;
+  Node *node;
+  int nhash;
+  int nuse;
+  int htag;
+} Hash;
+
+
+extern char *luaO_typenames[];
+
+extern TObject luaO_nilobject;
+
+int luaO_equalObj (TObject *t1, TObject *t2);
+int luaO_redimension (int oldsize);
+void luaO_insertlist (GCnode *root, GCnode *node);
+
+#ifdef OLD_ANSI
+void luaO_memup (void *dest, void *src, int size);
+void luaO_memdown (void *dest, void *src, int size);
+#else
+#include <string.h>
+#define luaO_memup(d,s,n)	memmove(d,s,n)
+#define luaO_memdown(d,s,n)	memmove(d,s,n)
+#endif
+
+#endif

lopcodes.h

@@ -0,0 +1,181 @@
+/*
+** $Id: lopcodes.h,v 1.17 1998/03/25 18:52:29 roberto Exp roberto $
+** Opcodes for Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lopcodes_h
+#define lopcodes_h
+
+
+/*
+** NOTICE: variants of the same opcode must be consecutive: First, those
+** with byte parameter, then with built-in parameters, and last with
+** word parameter.
+*/
+
+
+typedef enum {
+/* name          parm    before          after           side effect
+-----------------------------------------------------------------------------*/
+ENDCODE,/*	-	-		-  */
+
+PUSHNIL,/*	b	-		nil_0...nil_b  */
+PUSHNIL0,/*	-	-		nil  */
+
+PUSHNUMBER,/*	b	-		(float)b  */
+PUSHNUMBER0,/*	-	-		0.0  */
+PUSHNUMBER1,/*	-	-		1.0  */
+PUSHNUMBER2,/*	-	-		2.0  */
+PUSHNUMBERW,/*	w	-		(float)w  */
+
+PUSHCONSTANT,/*	b	-		CNST[b] */
+PUSHCONSTANT0,/*-	-		CNST[0] */
+PUSHCONSTANT1,/*-	-		CNST[1] */
+PUSHCONSTANT2,/*-	-		CNST[2] */
+PUSHCONSTANT3,/*-	-		CNST[3] */
+PUSHCONSTANT4,/*-	-		CNST[4] */
+PUSHCONSTANT5,/*-	-		CNST[5] */
+PUSHCONSTANT6,/*-	-		CNST[6] */
+PUSHCONSTANT7,/*-	-		CNST[7] */
+PUSHCONSTANTW,/*w	-		CNST[w] */
+
+PUSHUPVALUE,/*	b	-		Closure[b] */
+PUSHUPVALUE0,/*	-	-		Closure[0] */
+PUSHUPVALUE1,/*	-	-		Closure[1] */
+
+PUSHLOCAL,/*	b	-		LOC[b]  */
+PUSHLOCAL0,/*	-	-		LOC[0]  */
+PUSHLOCAL1,/*	-	-		LOC[1]  */
+PUSHLOCAL2,/*	-	-		LOC[2]  */
+PUSHLOCAL3,/*	-	-		LOC[3]  */
+PUSHLOCAL4,/*	-	-		LOC[4]  */
+PUSHLOCAL5,/*	-	-		LOC[5]  */
+PUSHLOCAL6,/*	-	-		LOC[6]  */
+PUSHLOCAL7,/*	-	-		LOC[7]  */
+
+GETGLOBAL,/*	b 	-		VAR[CNST[b]]  */
+GETGLOBAL0,/*	-	-		VAR[CNST[0]]  */
+GETGLOBAL1,/*	-	-		VAR[CNST[1]]  */
+GETGLOBAL2,/*	-	-		VAR[CNST[2]]  */
+GETGLOBAL3,/*	-	-		VAR[CNST[3]]  */
+GETGLOBAL4,/*	-	-		VAR[CNST[4]]  */
+GETGLOBAL5,/*	-	-		VAR[CNST[5]]  */
+GETGLOBAL6,/*	-	-		VAR[CNST[6]]  */
+GETGLOBAL7,/*	-	-		VAR[CNST[7]]  */
+GETGLOBALW,/*	w	-		VAR[CNST[w]]  */
+
+GETTABLE,/*	-	i t		t[i]  */
+
+GETDOTTED,/*	b	t		t[CNST[b]]  */
+GETDOTTED0,/*	-	t		t[CNST[0]]  */
+GETDOTTED1,/*	-	t		t[CNST[1]]  */
+GETDOTTED2,/*	-	t		t[CNST[2]]  */
+GETDOTTED3,/*	-	t		t[CNST[3]]  */
+GETDOTTED4,/*	-	t		t[CNST[4]]  */
+GETDOTTED5,/*	-	t		t[CNST[5]]  */
+GETDOTTED6,/*	-	t		t[CNST[6]]  */
+GETDOTTED7,/*	-	t		t[CNST[7]]  */
+GETDOTTEDW,/*	w	t		t[CNST[w]]  */
+
+PUSHSELF,/*	b	t		t t[CNST[b]]  */
+PUSHSELF0,/*	-	t		t t[CNST[0]]  */
+PUSHSELF1,/*	-	t		t t[CNST[1]]  */
+PUSHSELF2,/*	-	t		t t[CNST[2]]  */
+PUSHSELF3,/*	-	t		t t[CNST[3]]  */
+PUSHSELF4,/*	-	t		t t[CNST[4]]  */
+PUSHSELF5,/*	-	t		t t[CNST[5]]  */
+PUSHSELF6,/*	-	t		t t[CNST[6]]  */
+PUSHSELF7,/*	-	t		t t[CNST[7]]  */
+PUSHSELFW,/*	w	t		t t[CNST[w]]  */
+
+CREATEARRAY,/*	b	-		newarray(size = b)  */
+CREATEARRAY0,/*	-	-		newarray(size = 0)  */
+CREATEARRAY1,/*	-	-		newarray(size = 1)  */
+CREATEARRAYW,/*	w	-		newarray(size = w)  */
+
+SETLOCAL,/*	b	x		-		LOC[b]=x  */
+SETLOCAL0,/*	-	x		-		LOC[0]=x  */
+SETLOCAL1,/*	-	x		-		LOC[1]=x  */
+SETLOCAL2,/*	-	x		-		LOC[2]=x  */
+SETLOCAL3,/*	-	x		-		LOC[3]=x  */
+SETLOCAL4,/*	-	x		-		LOC[4]=x  */
+SETLOCAL5,/*	-	x		-		LOC[5]=x  */
+SETLOCAL6,/*	-	x		-		LOC[6]=x  */
+SETLOCAL7,/*	-	x		-		LOC[7]=x  */
+
+SETGLOBAL,/*	b	x		-		VAR[CNST[b]]=x  */
+SETGLOBAL0,/*	-	x		-		VAR[CNST[0]]=x  */
+SETGLOBAL1,/*	-	x		-		VAR[CNST[1]]=x  */
+SETGLOBAL2,/*	-	x		-		VAR[CNST[2]]=x  */
+SETGLOBAL3,/*	-	x		-		VAR[CNST[3]]=x  */
+SETGLOBAL4,/*	-	x		-		VAR[CNST[4]]=x  */
+SETGLOBAL5,/*	-	x		-		VAR[CNST[5]]=x  */
+SETGLOBAL6,/*	-	x		-		VAR[CNST[6]]=x  */
+SETGLOBAL7,/*	-	x		-		VAR[CNST[7]]=x  */
+SETGLOBALW,/*	w	x		-		VAR[CNST[w]]=x  */
+
+SETTABLE0,/*	-	v i t		-		t[i]=v  */
+
+SETTABLE,/*	b	v a_b...a_1 i t	a_b...a_1 i t	t[i]=v  */
+
+SETLIST,/*	b c	v_c...v_1 t	-		t[i+b*FPF]=v_i  */
+SETLIST0,/*	b	v_b...v_1 t	-		t[i]=v_i  */
+SETLISTW,/*	w c	v_c...v_1 t	-		t[i+w*FPF]=v_i  */
+
+SETMAP,/*	b	v_b k_b ...v_0 k_0 t	t	t[k_i]=v_i  */
+SETMAP0,/*	-	v_0 k_0 t		t	t[k_0]=v_0  */
+
+EQOP,/*		-	y x		(x==y)? 1 : nil  */
+NEQOP,/*	-	y x		(x~=y)? 1 : nil  */
+LTOP,/*		-	y x		(x<y)? 1 : nil  */
+LEOP,/*		-	y x		(x<y)? 1 : nil  */
+GTOP,/*		-	y x		(x>y)? 1 : nil  */
+GEOP,/*		-	y x		(x>=y)? 1 : nil  */
+ADDOP,/*	-	y x		x+y  */
+SUBOP,/*	-	y x		x-y  */
+MULTOP,/*	-	y x		x*y  */
+DIVOP,/*	-	y x		x/y  */
+POWOP,/*	-	y x		x^y  */
+CONCOP,/*	-	y x		x..y  */
+MINUSOP,/*	-	x		-x  */
+NOTOP,/*	-	x		(x==nil)? 1 : nil  */
+
+ONTJMP,/*	b	x		(x!=nil)? x : -	(x!=nil)? PC+=b  */
+ONTJMPW,/*	w	x		(x!=nil)? x : -	(x!=nil)? PC+=w  */
+ONFJMP,/*	b	x		(x==nil)? x : -	(x==nil)? PC+=b  */
+ONFJMPW,/*	w	x		(x==nil)? x : -	(x==nil)? PC+=w  */
+JMP,/*		b	-		-		PC+=b  */
+JMPW,/*		w	-		-		PC+=w  */
+IFFJMP,/*	b	x		-		(x==nil)? PC+=b  */
+IFFJMPW,/*	w	x		-		(x==nil)? PC+=w  */
+IFTUPJMP,/*	b	x		-		(x!=nil)? PC-=b  */
+IFTUPJMPW,/*	w	x		-		(x!=nil)? PC-=w  */
+IFFUPJMP,/*	b	x		-		(x==nil)? PC-=b  */
+IFFUPJMPW,/*	w	x		-		(x==nil)? PC-=w  */
+
+CLOSURE,/*	b c	v_c...v_1	closure(CNST[b], v_c...v_1) */
+CLOSUREW,/*	w c	v_b...v_1	closure(CNST[w], v_c...v_1) */
+
+CALLFUNC,/*	b c	v_c...v_1 f	r_b...r_1	f(v1,...,v_c)  */
+CALLFUNC0,/*	b	v_b...v_1 f	-		f(v1,...,v_b)  */
+CALLFUNC1,/*	b	v_b...v_1 f	r_1		f(v1,...,v_b)  */
+
+RETCODE,/*	b	-		-  */
+
+SETLINE,/*	b	-		-		LINE=b  */
+SETLINEW,/*	w	-		-		LINE=w  */
+
+POP,/*		b	-		-		TOP-=(b+1)  */
+POP0,/*		-	-		-		TOP-=1  */
+POP1/*		-	-		-		TOP-=2  */
+
+} OpCode;
+
+
+#define RFIELDS_PER_FLUSH 32	/* records (SETMAP) */
+#define LFIELDS_PER_FLUSH 64    /* lists (SETLIST) */
+
+#define ZEROVARARG	64
+
+#endif

lparser.h

@@ -0,0 +1,20 @@
+/*
+** $Id: lparser.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
+** Syntax analizer and code generator
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lparser_h
+#define lparser_h
+
+#include "lobject.h"
+#include "lzio.h"
+
+
+void luaY_codedebugline (int line);
+TProtoFunc *luaY_parser (ZIO *z);
+void luaY_error (char *s);
+void luaY_syntaxerror (char *s, char *token);
+
+
+#endif

lstate.c

@@ -0,0 +1,86 @@
+/*
+** $Id: lstate.c,v 1.5 1997/12/17 20:48:58 roberto Exp roberto $
+** Global State
+** See Copyright Notice in lua.h
+*/
+
+
+#include "lbuiltin.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "llex.h"
+#include "lmem.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+
+
+lua_State *lua_state = NULL;
+
+
+void lua_open (void)
+{
+  if (lua_state) return;
+  lua_state = luaM_new(lua_State);
+  L->numCblocks = 0;
+  L->Cstack.base = 0;
+  L->Cstack.lua2C = 0;
+  L->Cstack.num = 0;
+  L->errorJmp = NULL;
+  L->rootproto.next = NULL;
+  L->rootproto.marked = 0;
+  L->rootcl.next = NULL;
+  L->rootcl.marked = 0;
+  L->rootglobal.next = NULL;
+  L->rootglobal.marked = 0;
+  L->roottable.next = NULL;
+  L->roottable.marked = 0;
+  L->refArray = NULL;
+  L->refSize = 0;
+  L->Mbuffsize = 0;
+  L->Mbuffnext = 0;
+  L->Mbuffbase = NULL;
+  L->Mbuffer = NULL;
+  L->GCthreshold = GARBAGE_BLOCK;
+  L->nblocks = 0;
+  luaD_init();
+  luaS_init();
+  luaX_init();
+  luaT_init();
+  luaB_predefine();
+}
+
+
+void lua_close (void)
+{
+  TaggedString *alludata = luaS_collectudata();
+  L->GCthreshold = MAX_INT;  /* to avoid GC during GC */
+  luaC_hashcallIM((Hash *)L->roottable.next);  /* GC t.methods for tables */
+  luaC_strcallIM(alludata);  /* GC tag methods for userdata */
+  luaD_gcIM(&luaO_nilobject);  /* GC tag method for nil (signal end of GC) */
+  luaH_free((Hash *)L->roottable.next);
+  luaF_freeproto((TProtoFunc *)L->rootproto.next);
+  luaF_freeclosure((Closure *)L->rootcl.next);
+  luaS_free(alludata);
+  luaS_freeall();
+  luaM_free(L->stack.stack);
+  luaM_free(L->IMtable);
+  luaM_free(L->refArray);
+  luaM_free(L->Mbuffer);
+  luaM_free(L);
+  L = NULL;
+#ifdef DEBUG
+  printf("total de blocos: %ld\n", numblocks);
+  printf("total de memoria: %ld\n", totalmem);
+#endif
+}
+
+
+lua_State *lua_setstate (lua_State *st) {
+  lua_State *old = lua_state;
+  lua_state = st;
+  return old;
+}
+

lstate.h

@@ -0,0 +1,86 @@
+/*
+** $Id: lstate.h,v 1.10 1998/06/19 16:14:09 roberto Exp roberto $
+** Global State
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lstate_h
+#define lstate_h
+
+#include <setjmp.h>
+
+#include "lobject.h"
+#include "lua.h"
+
+
+#define MAX_C_BLOCKS 10
+
+#define GARBAGE_BLOCK 150
+
+
+typedef int StkId;  /* index to stack elements */
+
+struct Stack {
+  TObject *top;
+  TObject *stack;
+  TObject *last;
+};
+
+struct C_Lua_Stack {
+  StkId base;  /* when Lua calls C or C calls Lua, points to */
+               /* the first slot after the last parameter. */
+  StkId lua2C; /* points to first element of "array" lua2C */
+  int num;     /* size of "array" lua2C */
+};
+
+
+typedef struct {
+  int size;
+  int nuse;  /* number of elements (including EMPTYs) */
+  TaggedString **hash;
+} stringtable;
+
+
+enum Status {LOCK, HOLD, FREE, COLLECTED};
+
+struct ref {
+  TObject o;
+  enum Status status;
+};
+
+
+struct lua_State {
+  /* thread-specific state */
+  struct Stack stack;  /* Lua stack */
+  struct C_Lua_Stack Cstack;  /* C2lua struct */
+  jmp_buf *errorJmp;  /* current error recover point */
+  char *Mbuffer;  /* global buffer */
+  char *Mbuffbase;  /* current first position of Mbuffer */
+  int Mbuffsize;  /* size of Mbuffer */
+  int Mbuffnext;  /* next position to fill in Mbuffer */
+  struct C_Lua_Stack Cblocks[MAX_C_BLOCKS];
+  int numCblocks;  /* number of nested Cblocks */
+  /* global state */
+  TObject errorim;  /* error tag method */
+  GCnode rootproto;  /* list of all prototypes */
+  GCnode rootcl;  /* list of all closures */
+  GCnode roottable;  /* list of all tables */
+  GCnode rootglobal;  /* list of strings with global values */
+  stringtable *string_root;  /* array of hash tables for strings and udata */
+  struct IM *IMtable;  /* table for tag methods */
+  int IMtable_size;  /* size of IMtable */
+  int last_tag;  /* last used tag in IMtable */
+  struct ref *refArray;  /* locked objects */
+  int refSize;  /* size of refArray */
+  unsigned long GCthreshold;
+  unsigned long nblocks;  /* number of 'blocks' currently allocated */
+};
+
+
+extern lua_State *lua_state;
+
+
+#define L	lua_state
+
+
+#endif

lstring.c

@@ -0,0 +1,313 @@
+/*
+** $Id: lstring.c,v 1.12 1998/03/06 16:54:42 roberto Exp roberto $
+** String table (keeps all strings handled by Lua)
+** See Copyright Notice in lua.h
+*/
+
+
+#include <string.h>
+
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "lua.h"
+
+
+#define NUM_HASHS  61
+
+
+#define gcsizestring(l)	(1+(l/64))  /* "weight" for a string with length 'l' */
+
+
+
+static TaggedString EMPTY = {{NULL, 2}, 0L, 0,
+                            {{{LUA_T_NIL, {NULL}}, 0L}}, {0}};
+
+
+void luaS_init (void)
+{
+  int i;
+  L->string_root = luaM_newvector(NUM_HASHS, stringtable);
+  for (i=0; i<NUM_HASHS; i++) {
+    L->string_root[i].size = 0;
+    L->string_root[i].nuse = 0;
+    L->string_root[i].hash = NULL;
+  }
+}
+
+
+static unsigned long hash_s (char *s, long l)
+{
+  unsigned long h = 0;
+  while (l--)
+    h = ((h<<5)-h)^(unsigned char)*(s++);
+  return h;
+}
+
+static int newsize (stringtable *tb)
+{
+  int size = tb->size;
+  int realuse = 0;
+  int i;
+  /* count how many entries are really in use */
+  for (i=0; i<size; i++)
+    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY)
+      realuse++;
+  if (2*(realuse+1) <= size)  /* +1 is the new element */
+    return size;  /* don't need to grow, just rehash to clear EMPTYs */
+  else
+    return luaO_redimension(size);
+}
+
+
+static void grow (stringtable *tb)
+{
+  
+  int ns = newsize(tb);
+  TaggedString **newhash = luaM_newvector(ns, TaggedString *);
+  int i;
+  for (i=0; i<ns; i++)
+    newhash[i] = NULL;
+  /* rehash */
+  tb->nuse = 0;
+  for (i=0; i<tb->size; i++) {
+    if (tb->hash[i] != NULL && tb->hash[i] != &EMPTY) {
+      int h = tb->hash[i]->hash%ns;
+      while (newhash[h])
+        h = (h+1)%ns;
+      newhash[h] = tb->hash[i];
+      tb->nuse++;
+    }
+  }
+  luaM_free(tb->hash);
+  tb->size = ns;
+  tb->hash = newhash;
+}
+
+
+static TaggedString *newone_s (char *str, long l, unsigned long h)
+{
+  TaggedString *ts = (TaggedString *)luaM_malloc(sizeof(TaggedString)+l);
+  memcpy(ts->str, str, l);
+  ts->str[l] = 0;  /* ending 0 */
+  ts->u.s.globalval.ttype = LUA_T_NIL;  /* initialize global value */
+  ts->u.s.len = l;
+  ts->constindex = 0;
+  L->nblocks += gcsizestring(l);
+  ts->head.marked = 0;
+  ts->head.next = (GCnode *)ts;  /* signal it is in no list */
+  ts->hash = h;
+  return ts;
+}
+
+static TaggedString *newone_u (char *buff, int tag, unsigned long h)
+{
+  TaggedString *ts = luaM_new(TaggedString);
+  ts->u.d.v = buff;
+  ts->u.d.tag = (tag == LUA_ANYTAG) ? 0 : tag;
+  ts->constindex = -1;  /* tag -> this is a userdata */
+  L->nblocks++;
+  ts->head.marked = 0;
+  ts->head.next = (GCnode *)ts;  /* signal it is in no list */
+  ts->hash = h;
+  return ts;
+}
+
+static TaggedString *insert_s (char *str, long l, stringtable *tb)
+{
+  TaggedString *ts;
+  unsigned long h = hash_s(str, l);
+  int size = tb->size;
+  int i;
+  int j = -1;
+  if ((long)tb->nuse*3 >= (long)size*2) {
+    grow(tb);
+    size = tb->size;
+  }
+  for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
+    if (ts == &EMPTY)
+      j = i;
+    else if (ts->constindex >= 0 &&
+             ts->u.s.len == l &&
+             (memcmp(str, ts->str, l) == 0))
+      return ts;
+    if (++i == size) i=0;
+  }
+  /* not found */
+  if (j != -1)  /* is there an EMPTY space? */
+    i = j;
+  else
+    tb->nuse++;
+  ts = tb->hash[i] = newone_s(str, l, h);
+  return ts;
+}
+
+static TaggedString *insert_u (void *buff, int tag, stringtable *tb)
+{
+  TaggedString *ts;
+  unsigned long h = (unsigned long)buff;
+  int size = tb->size;
+  int i;
+  int j = -1;
+  if ((long)tb->nuse*3 >= (long)size*2) {
+    grow(tb);
+    size = tb->size;
+  }
+  for (i = h%size; (ts = tb->hash[i]) != NULL; ) {
+    if (ts == &EMPTY)
+      j = i;
+    else if (ts->constindex < 0 &&  /* is a udata? */
+             (tag == ts->u.d.tag || tag == LUA_ANYTAG) &&
+             buff == ts->u.d.v)
+      return ts;
+    if (++i == size) i=0;
+  }
+  /* not found */
+  if (j != -1)  /* is there an EMPTY space? */
+    i = j;
+  else
+    tb->nuse++;
+  ts = tb->hash[i] = newone_u(buff, tag, h);
+  return ts;
+}
+
+TaggedString *luaS_createudata (void *udata, int tag)
+{
+  return insert_u(udata, tag, &L->string_root[(unsigned)udata%NUM_HASHS]);
+}
+
+TaggedString *luaS_newlstr (char *str, long l)
+{
+  int i = (l==0)?0:(unsigned char)str[0];
+  return insert_s(str, l, &L->string_root[i%NUM_HASHS]);
+}
+
+TaggedString *luaS_new (char *str)
+{
+  return luaS_newlstr(str, strlen(str));
+}
+
+TaggedString *luaS_newfixedstring (char *str)
+{
+  TaggedString *ts = luaS_new(str);
+  if (ts->head.marked == 0)
+    ts->head.marked = 2;  /* avoid GC */
+  return ts;
+}
+
+
+void luaS_free (TaggedString *l)
+{
+  while (l) {
+    TaggedString *next = (TaggedString *)l->head.next;
+    L->nblocks -= (l->constindex == -1) ? 1 : gcsizestring(l->u.s.len);
+    luaM_free(l);
+    l = next;
+  }
+}
+
+
+/*
+** Garbage collection functions.
+*/
+
+static void remove_from_list (GCnode *l)
+{
+  while (l) {
+    GCnode *next = l->next;
+    while (next && !next->marked)
+      next = l->next = next->next;
+    l = next;
+  }
+}
+
+
+TaggedString *luaS_collector (void)
+{
+  TaggedString *frees = NULL;
+  int i;
+  remove_from_list(&(L->rootglobal));
+  for (i=0; i<NUM_HASHS; i++) {
+    stringtable *tb = &L->string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++) {
+      TaggedString *t = tb->hash[j];
+      if (t == NULL) continue;
+      if (t->head.marked == 1)
+        t->head.marked = 0;
+      else if (!t->head.marked) {
+        t->head.next = (GCnode *)frees;
+        frees = t;
+        tb->hash[j] = &EMPTY;
+      }
+    }
+  }
+  return frees;
+}
+
+
+TaggedString *luaS_collectudata (void)
+{
+  TaggedString *frees = NULL;
+  int i;
+  L->rootglobal.next = NULL;  /* empty list of globals */
+  for (i=0; i<NUM_HASHS; i++) {
+    stringtable *tb = &L->string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++) {
+      TaggedString *t = tb->hash[j];
+      if (t == NULL || t == &EMPTY || t->constindex != -1)
+        continue;  /* get only user data */
+      t->head.next = (GCnode *)frees;
+      frees = t;
+      tb->hash[j] = &EMPTY;
+    }
+  }
+  return frees;
+}
+
+
+void luaS_freeall (void)
+{
+  int i;
+  for (i=0; i<NUM_HASHS; i++) {
+    stringtable *tb = &L->string_root[i];
+    int j;
+    for (j=0; j<tb->size; j++) {
+      TaggedString *t = tb->hash[j];
+      if (t == &EMPTY) continue;
+      luaM_free(t);
+    }
+    luaM_free(tb->hash);
+  }
+  luaM_free(L->string_root);
+}
+
+
+void luaS_rawsetglobal (TaggedString *ts, TObject *newval)
+{
+  ts->u.s.globalval = *newval;
+  if (ts->head.next == (GCnode *)ts) {  /* is not in list? */
+    ts->head.next = L->rootglobal.next;
+    L->rootglobal.next = (GCnode *)ts;
+  }
+}
+
+
+char *luaS_travsymbol (int (*fn)(TObject *))
+{
+  TaggedString *g;
+  for (g=(TaggedString *)L->rootglobal.next; g; g=(TaggedString *)g->head.next)
+    if (fn(&g->u.s.globalval))
+      return g->str;
+  return NULL;
+}
+
+
+int luaS_globaldefined (char *name)
+{
+  TaggedString *ts = luaS_new(name);
+  return ts->u.s.globalval.ttype != LUA_T_NIL;
+}
+

lstring.h

@@ -0,0 +1,28 @@
+/*
+** $Id: lstring.h,v 1.6 1997/12/01 20:31:25 roberto Exp roberto $
+** String table (keep all strings handled by Lua)
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lstring_h
+#define lstring_h
+
+
+#include "lobject.h"
+
+
+void luaS_init (void);
+TaggedString *luaS_createudata (void *udata, int tag);
+TaggedString *luaS_collector (void);
+void luaS_free (TaggedString *l);
+TaggedString *luaS_newlstr (char *str, long l);
+TaggedString *luaS_new (char *str);
+TaggedString *luaS_newfixedstring (char *str);
+void luaS_rawsetglobal (TaggedString *ts, TObject *newval);
+char *luaS_travsymbol (int (*fn)(TObject *));
+int luaS_globaldefined (char *name);
+TaggedString *luaS_collectudata (void);
+void luaS_freeall (void);
+
+
+#endif

lstrlib.c

@@ -0,0 +1,541 @@
+/*
+** $Id: lstrlib.c,v 1.17 1998/06/29 18:24:06 roberto Exp roberto $
+** Standard library for strings and pattern-matching
+** See Copyright Notice in lua.h
+*/
+
+
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "lua.h"
+#include "lualib.h"
+
+
+
+static void addnchar (char *s, int n)
+{
+  char *b = luaL_openspace(n);
+  memcpy(b, s, n);
+  luaL_addsize(n);
+}
+
+
+static void str_len (void)
+{
+  long l;
+  luaL_check_lstr(1, &l);
+  lua_pushnumber(l);
+}
+
+
+static void closeandpush (void)
+{
+  lua_pushlstring(luaL_buffer(), luaL_getsize());
+}
+
+
+static long posrelat (long pos, long len)
+{
+  /* relative string position: negative means back from end */
+  return (pos>=0) ? pos : len+pos+1;
+}
+
+
+static void str_sub (void)
+{
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  long start = posrelat(luaL_check_number(2), l);
+  long end = posrelat(luaL_opt_number(3, -1), l);
+  if (1 <= start && start <= end && end <= l)
+    lua_pushlstring(s+start-1, end-start+1);
+  else lua_pushstring("");
+}
+
+
+static void str_lower (void)
+{
+  long l;
+  int i;
+  char *s = luaL_check_lstr(1, &l);
+  luaL_resetbuffer();
+  for (i=0; i<l; i++)
+    luaL_addchar(tolower((unsigned char)(s[i])));
+  closeandpush();
+}
+
+
+static void str_upper (void)
+{
+  long l;
+  int i;
+  char *s = luaL_check_lstr(1, &l);
+  luaL_resetbuffer();
+  for (i=0; i<l; i++)
+    luaL_addchar(toupper((unsigned char)(s[i])));
+  closeandpush();
+}
+
+static void str_rep (void)
+{
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  int n = (int)luaL_check_number(2);
+  luaL_resetbuffer();
+  while (n-- > 0)
+    addnchar(s, l);
+  closeandpush();
+}
+
+
+static void str_byte (void)
+{
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  long pos = posrelat(luaL_opt_number(2, 1), l);
+  luaL_arg_check(0<pos && pos<=l, 2,  "out of range");
+  lua_pushnumber((unsigned char)s[pos-1]);
+}
+
+static void str_char (void) {
+  int i = 0;
+  luaL_resetbuffer();
+  while (lua_getparam(++i) != LUA_NOOBJECT) {
+    double c = luaL_check_number(i);
+    luaL_arg_check((unsigned char)c == c, i, "invalid value");
+    luaL_addchar((int)c);
+  }
+  closeandpush();
+}
+
+
+/*
+** =======================================================
+** PATTERN MATCHING
+** =======================================================
+*/
+
+#define MAX_CAPT 9
+
+struct Capture {
+  int level;  /* total number of captures (finished or unfinished) */
+  char *src_end;  /* end ('\0') of source string */
+  struct {
+    char *init;
+    int len;  /* -1 signals unfinished capture */
+  } capture[MAX_CAPT];
+};
+
+
+#define ESC	'%'
+#define SPECIALS  "^$*?.([%-"
+
+
+static void push_captures (struct Capture *cap)
+{
+  int i;
+  for (i=0; i<cap->level; i++)
+    lua_pushlstring(cap->capture[i].init, cap->capture[i].len);
+}
+
+
+static int check_cap (int l, struct Capture *cap)
+{
+  l -= '1';
+  if (!(0 <= l && l < cap->level && cap->capture[l].len != -1))
+    lua_error("invalid capture index");
+  return l;
+}
+
+
+static int capture_to_close (struct Capture *cap)
+{
+  int level = cap->level;
+  for (level--; level>=0; level--)
+    if (cap->capture[level].len == -1) return level;
+  lua_error("invalid pattern capture");
+  return 0;  /* to avoid warnings */
+}
+
+
+static char *bracket_end (char *p)
+{
+  return (*p == 0) ? NULL : strchr((*p=='^') ? p+2 : p+1, ']');
+}
+
+
+static int matchclass (int c, int cl)
+{
+  int res;
+  switch (tolower(cl)) {
+    case 'a' : res = isalpha(c); break;
+    case 'c' : res = iscntrl(c); break;
+    case 'd' : res = isdigit(c); break;
+    case 'l' : res = islower(c); break;
+    case 'p' : res = ispunct(c); break;
+    case 's' : res = isspace(c); break;
+    case 'u' : res = isupper(c); break;
+    case 'w' : res = isalnum(c); break;
+    case 'z' : res = (c == '\0'); break;
+    default: return (cl == c);
+  }
+  return (islower((unsigned char)cl) ? res : !res);
+}
+
+
+int luaI_singlematch (int c, char *p, char **ep)
+{
+  switch (*p) {
+    case '.':  /* matches any char */
+      *ep = p+1;
+      return 1;
+    case '\0':  /* end of pattern; matches nothing */
+      *ep = p;
+      return 0;
+    case ESC:
+      if (*(++p) == '\0')
+        luaL_verror("incorrect pattern (ends with `%c')", ESC);
+      *ep = p+1;
+      return matchclass(c, (unsigned char)*p);
+    case '[': {
+      char *end = bracket_end(p+1);
+      int sig = *(p+1) == '^' ? (p++, 0) : 1;
+      if (end == NULL) lua_error("incorrect pattern (missing `]')");
+      *ep = end+1;
+      while (++p < end) {
+        if (*p == ESC) {
+          if (((p+1) < end) && matchclass(c, (unsigned char)*++p))
+            return sig;
+        }
+        else if ((*(p+1) == '-') && (p+2 < end)) {
+          p+=2;
+          if ((unsigned char)*(p-2) <= c && c <= (unsigned char)*p)
+            return sig;
+        }
+        else if ((unsigned char)*p == c) return sig;
+      }
+      return !sig;
+    }
+    default:
+      *ep = p+1;
+      return ((unsigned char)*p == c);
+  }
+}
+
+
+static char *matchbalance (char *s, int b, int e, struct Capture *cap)
+{
+  if (*s != b) return NULL;
+  else {
+    int cont = 1;
+    while (++s < cap->src_end) {
+      if (*s == e) {
+        if (--cont == 0) return s+1;
+      }
+      else if (*s == b) cont++;
+    }
+  }
+  return NULL;  /* string ends out of balance */
+}
+
+
+static char *matchitem (char *s, char *p, struct Capture *cap, char **ep)
+{
+  if (*p == ESC) {
+    p++;
+    if (isdigit((unsigned char)*p)) {  /* capture */
+      int l = check_cap(*p, cap);
+      int len = cap->capture[l].len;
+      *ep = p+1;
+      if (cap->src_end-s >= len && memcmp(cap->capture[l].init, s, len) == 0)
+        return s+len;
+      else return NULL;
+    }
+    else if (*p == 'b') {  /* balanced string */
+      p++;
+      if (*p == 0 || *(p+1) == 0)
+        lua_error("unbalanced pattern");
+      *ep = p+2;
+      return matchbalance(s, *p, *(p+1), cap);
+    }
+    else p--;  /* and go through */
+  }
+  /* "luaI_singlematch" sets "ep" (so must be called even when *s == 0) */
+  return (luaI_singlematch((unsigned char)*s, p, ep) && s<cap->src_end) ?
+                    s+1 : NULL;
+}
+
+
+static char *match (char *s, char *p, struct Capture *cap)
+{
+  init: /* using goto's to optimize tail recursion */
+  switch (*p) {
+    case '(': {  /* start capture */
+      char *res;
+      if (cap->level >= MAX_CAPT) lua_error("too many captures");
+      cap->capture[cap->level].init = s;
+      cap->capture[cap->level].len = -1;
+      cap->level++;
+      if ((res=match(s, p+1, cap)) == NULL)  /* match failed? */
+        cap->level--;  /* undo capture */
+      return res;
+    }
+    case ')': {  /* end capture */
+      int l = capture_to_close(cap);
+      char *res;
+      cap->capture[l].len = s - cap->capture[l].init;  /* close capture */
+      if ((res = match(s, p+1, cap)) == NULL)  /* match failed? */
+        cap->capture[l].len = -1;  /* undo capture */
+      return res;
+    }
+    case '\0': case '$':  /* (possibly) end of pattern */
+      if (*p == 0 || (*(p+1) == 0 && s == cap->src_end))
+        return s;
+      /* else go through */
+    default: {  /* it is a pattern item */
+      char *ep;  /* get what is next */
+      char *s1 = matchitem(s, p, cap, &ep);
+      switch (*ep) {
+        case '*': {  /* repetition */
+          char *res;
+          if (s1 && s1>s && ((res=match(s1, p, cap)) != NULL))
+            return res;
+          p=ep+1; goto init;  /* else return match(s, ep+1, cap); */
+        }
+        case '?': {  /* optional */
+          char *res;
+          if (s1 && ((res=match(s1, ep+1, cap)) != NULL))
+            return res;
+          p=ep+1; goto init;  /* else return match(s, ep+1, cap); */
+        }
+        case '-': {  /* repetition */
+          char *res;
+          if ((res = match(s, ep+1, cap)) != NULL)
+            return res;
+          else if (s1 && s1>s) {
+            s = s1;
+            goto init;  /* return match(s1, p, cap); */
+          }
+          else
+            return NULL;
+        }
+        default:
+          if (s1) { s=s1; p=ep; goto init; }  /* return match(s1, ep, cap); */
+          else return NULL;
+      }
+    }
+  }
+}
+
+
+static void str_find (void)
+{
+  long l;
+  char *s = luaL_check_lstr(1, &l);
+  char *p = luaL_check_string(2);
+  long init = posrelat(luaL_opt_number(3, 1), l) - 1;
+  struct Capture cap;
+  luaL_arg_check(0 <= init && init <= l, 3, "out of range");
+  if (lua_getparam(4) != LUA_NOOBJECT ||
+      strpbrk(p, SPECIALS) == NULL) {  /* no special characters? */
+    char *s2 = strstr(s+init, p);
+    if (s2) {
+      lua_pushnumber(s2-s+1);
+      lua_pushnumber(s2-s+strlen(p));
+      return;
+    }
+  }
+  else {
+    int anchor = (*p == '^') ? (p++, 1) : 0;
+    char *s1=s+init;
+    cap.src_end = s+l;
+    do {
+      char *res;
+      cap.level = 0;
+      if ((res=match(s1, p, &cap)) != NULL) {
+        lua_pushnumber(s1-s+1);  /* start */
+        lua_pushnumber(res-s);   /* end */
+        push_captures(&cap);
+        return;
+      }
+    } while (s1++<cap.src_end && !anchor);
+  }
+  lua_pushnil();  /* if arrives here, it didn't find */
+}
+
+
+static void add_s (lua_Object newp, struct Capture *cap)
+{
+  if (lua_isstring(newp)) {
+    char *news = lua_getstring(newp);
+    int l = lua_strlen(newp);
+    int i;
+    for (i=0; i<l; i++) {
+      if (news[i] != ESC)
+        luaL_addchar(news[i]);
+      else {
+        i++;  /* skip ESC */
+        if (!isdigit((unsigned char)news[i]))
+          luaL_addchar(news[i]);
+        else {
+          int level = check_cap(news[i], cap);
+          addnchar(cap->capture[level].init, cap->capture[level].len);
+        }
+      }
+    }
+  }
+  else {  /* is a function */
+    lua_Object res;
+    int status;
+    int oldbuff;
+    lua_beginblock();
+    push_captures(cap);
+    /* function may use buffer, so save it and create a new one */
+    oldbuff = luaL_newbuffer(0);
+    status = lua_callfunction(newp);
+    /* restore old buffer */
+    luaL_oldbuffer(oldbuff);
+    if (status != 0) {
+      lua_endblock();
+      lua_error(NULL);
+    }
+    res = lua_getresult(1);
+    if (lua_isstring(res))
+      addnchar(lua_getstring(res), lua_strlen(res));
+    lua_endblock();
+  }
+}
+
+
+static void str_gsub (void)
+{
+  long srcl;
+  char *src = luaL_check_lstr(1, &srcl);
+  char *p = luaL_check_string(2);
+  lua_Object newp = lua_getparam(3);
+  int max_s = (int)luaL_opt_number(4, srcl+1);
+  int anchor = (*p == '^') ? (p++, 1) : 0;
+  int n = 0;
+  struct Capture cap;
+  luaL_arg_check(lua_isstring(newp) || lua_isfunction(newp), 3,
+                 "string or function expected");
+  luaL_resetbuffer();
+  cap.src_end = src+srcl;
+  while (n < max_s) {
+    char *e;
+    cap.level = 0;
+    e = match(src, p, &cap);
+    if (e) {
+      n++;
+      add_s(newp, &cap);
+    }
+    if (e && e>src) /* non empty match? */
+      src = e;  /* skip it */
+    else if (src < cap.src_end)
+      luaL_addchar(*src++);
+    else break;
+    if (anchor) break;
+  }
+  addnchar(src, cap.src_end-src);
+  closeandpush();
+  lua_pushnumber(n);  /* number of substitutions */
+}
+
+
+static void luaI_addquoted (char *s)
+{
+  luaL_addchar('"');
+  for (; *s; s++) {
+    if (strchr("\"\\\n", *s))
+      luaL_addchar('\\');
+    luaL_addchar(*s);
+  }
+  luaL_addchar('"');
+}
+
+#define MAX_FORMAT 200
+
+static void str_format (void)
+{
+  int arg = 1;
+  char *strfrmt = luaL_check_string(arg);
+  struct Capture cap;
+  cap.src_end = strfrmt+strlen(strfrmt)+1;
+  luaL_resetbuffer();
+  while (*strfrmt) {
+    if (*strfrmt != '%')
+      luaL_addchar(*strfrmt++);
+    else if (*++strfrmt == '%')
+      luaL_addchar(*strfrmt++);  /* %% */
+    else { /* format item */
+      char form[MAX_FORMAT];      /* store the format ('%...') */
+      char *buff;
+      char *initf = strfrmt;
+      form[0] = '%';
+      cap.level = 0;
+      if (isdigit((unsigned char)initf[0]) && initf[1] == '$') {
+        arg = initf[0] - '0';
+        initf += 2;  /* skip the 'n$' */
+      }
+      arg++;
+      strfrmt = match(initf, "[-+ #0]*(%d*)%.?(%d*)", &cap);
+      if (cap.capture[0].len > 2 || cap.capture[1].len > 2)  /* < 100? */
+        lua_error("invalid format (width or precision too long)");
+      strncpy(form+1, initf, strfrmt-initf+1); /* +1 to include conversion */
+      form[strfrmt-initf+2] = 0;
+      buff = luaL_openspace(1000);  /* to store the formatted value */
+      switch (*strfrmt++) {
+        case 'q':
+          luaI_addquoted(luaL_check_string(arg));
+          continue;
+        case 's': {
+          char *s = luaL_check_string(arg);
+          buff = luaL_openspace(strlen(s));
+          sprintf(buff, form, s);
+          break;
+        }
+        case 'c':  case 'd':  case 'i':
+          sprintf(buff, form, (int)luaL_check_number(arg));
+          break;
+        case 'o':  case 'u':  case 'x':  case 'X':
+          sprintf(buff, form, (unsigned int)luaL_check_number(arg));
+          break;
+        case 'e':  case 'E': case 'f': case 'g': case 'G':
+          sprintf(buff, form, luaL_check_number(arg));
+          break;
+        default:  /* also treat cases 'pnLlh' */
+          lua_error("invalid option in `format'");
+      }
+      luaL_addsize(strlen(buff));
+    }
+  }
+  closeandpush();  /* push the result */
+}
+
+
+static struct luaL_reg strlib[] = {
+{"strlen", str_len},
+{"strsub", str_sub},
+{"strlower", str_lower},
+{"strupper", str_upper},
+{"strchar", str_char},
+{"strrep", str_rep},
+{"ascii", str_byte},  /* for compatibility */
+{"strbyte", str_byte},
+{"format", str_format},
+{"strfind", str_find},
+{"gsub", str_gsub}
+};
+
+
+/*
+** Open string library
+*/
+void strlib_open (void)
+{
+  luaL_openlib(strlib, (sizeof(strlib)/sizeof(strlib[0])));
+}

ltable.c

@@ -0,0 +1,216 @@
+/*
+** $Id: ltable.c,v 1.11 1998/01/13 18:06:27 roberto Exp roberto $
+** Lua tables (hash)
+** See Copyright Notice in lua.h
+*/
+
+#include <stdlib.h>
+
+#include "lauxlib.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "ltable.h"
+#include "lua.h"
+
+
+#define gcsize(n)	(1+(n/16))
+
+#define nuse(t)		((t)->nuse)
+#define nodevector(t)	((t)->node)
+
+
+#define REHASH_LIMIT    0.70    /* avoid more than this % full */
+
+#define TagDefault LUA_T_ARRAY;
+
+
+
+static long int hashindex (TObject *ref)
+{
+  long int h;
+  switch (ttype(ref)) {
+    case LUA_T_NUMBER:
+      h = (long int)nvalue(ref);
+      break;
+    case LUA_T_STRING: case LUA_T_USERDATA:
+      h = (IntPoint)tsvalue(ref);
+      break;
+    case LUA_T_ARRAY:
+      h = (IntPoint)avalue(ref);
+      break;
+    case LUA_T_PROTO:
+      h = (IntPoint)tfvalue(ref);
+      break;
+    case LUA_T_CPROTO:
+      h = (IntPoint)fvalue(ref);
+      break;
+    case LUA_T_CLOSURE:
+      h = (IntPoint)clvalue(ref);
+      break;
+    default:
+      lua_error("unexpected type to index table");
+      h = 0;  /* to avoid warnings */
+  }
+  return (h >= 0 ? h : -(h+1));
+}
+
+
+static int present (Hash *t, TObject *key)
+{
+  int tsize = nhash(t);
+  long int h = hashindex(key);
+  int h1 = h%tsize;
+  TObject *rf = ref(node(t, h1));
+  if (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf)) {
+    int h2 = h%(tsize-2) + 1;
+    do {
+      h1 += h2;
+      if (h1 >= tsize) h1 -= tsize;
+      rf = ref(node(t, h1));
+    } while (ttype(rf) != LUA_T_NIL && !luaO_equalObj(key, rf));
+  }
+  return h1;
+}
+
+
+/*
+** Alloc a vector node
+*/
+static Node *hashnodecreate (int nhash)
+{
+  Node *v = luaM_newvector(nhash, Node);
+  int i;
+  for (i=0; i<nhash; i++)
+    ttype(ref(&v[i])) = LUA_T_NIL;
+  return v;
+}
+
+/*
+** Delete a hash
+*/
+static void hashdelete (Hash *t)
+{
+  luaM_free(nodevector(t));
+  luaM_free(t);
+}
+
+
+void luaH_free (Hash *frees)
+{
+  while (frees) {
+    Hash *next = (Hash *)frees->head.next;
+    L->nblocks -= gcsize(frees->nhash);
+    hashdelete(frees);
+    frees = next;
+  }
+}
+
+
+Hash *luaH_new (int nhash)
+{
+  Hash *t = luaM_new(Hash);
+  nhash = luaO_redimension((int)((float)nhash/REHASH_LIMIT));
+  nodevector(t) = hashnodecreate(nhash);
+  nhash(t) = nhash;
+  nuse(t) = 0;
+  t->htag = TagDefault;
+  luaO_insertlist(&(L->roottable), (GCnode *)t);
+  L->nblocks += gcsize(nhash);
+  return t;
+}
+
+
+static int newsize (Hash *t)
+{
+  Node *v = t->node;
+  int size = nhash(t);
+  int realuse = 0;
+  int i;
+  for (i=0; i<size; i++) {
+    if (ttype(ref(v+i)) != LUA_T_NIL && ttype(val(v+i)) != LUA_T_NIL)
+      realuse++;
+  }
+  if (2*(realuse+1) <= size)  /* +1 is the new element */
+    return size;  /* don't need to grow, just rehash */
+  else
+    return luaO_redimension(size);
+}
+
+static void rehash (Hash *t)
+{
+  int nold = nhash(t);
+  Node *vold = nodevector(t);
+  int nnew = newsize(t);
+  int i;
+  nodevector(t) = hashnodecreate(nnew);
+  nhash(t) = nnew;
+  for (i=0; i<nold; i++) {
+    Node *n = vold+i;
+    if (ttype(ref(n)) != LUA_T_NIL && ttype(val(n)) != LUA_T_NIL)
+      *node(t, present(t, ref(n))) = *n;  /* copy old node to luaM_new hash */
+  }
+  L->nblocks += gcsize(nnew)-gcsize(nold);
+  luaM_free(vold);
+}
+
+/*
+** If the hash node is present, return its pointer, otherwise return
+** null.
+*/
+TObject *luaH_get (Hash *t, TObject *ref)
+{
+ int h = present(t, ref);
+ if (ttype(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ else return NULL;
+}
+
+
+/*
+** If the hash node is present, return its pointer, otherwise create a luaM_new
+** node for the given reference and also return its pointer.
+*/
+TObject *luaH_set (Hash *t, TObject *ref)
+{
+  Node *n = node(t, present(t, ref));
+  if (ttype(ref(n)) == LUA_T_NIL) {
+    nuse(t)++;
+    if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT) {
+      rehash(t);
+      n = node(t, present(t, ref));
+    }
+    *ref(n) = *ref;
+    ttype(val(n)) = LUA_T_NIL;
+  }
+  return (val(n));
+}
+
+
+static Node *hashnext (Hash *t, int i)
+{
+  Node *n;
+  int tsize = nhash(t);
+  if (i >= tsize)
+    return NULL;
+  n = node(t, i);
+  while (ttype(ref(n)) == LUA_T_NIL || ttype(val(n)) == LUA_T_NIL) {
+    if (++i >= tsize)
+      return NULL;
+    n = node(t, i);
+  }
+  return node(t, i);
+}
+
+Node *luaH_next (TObject *o, TObject *r)
+{
+  Hash *t = avalue(o);
+  if (ttype(r) == LUA_T_NIL)
+    return hashnext(t, 0);
+  else {
+    int i = present(t, r);
+    Node *n = node(t, i);
+    luaL_arg_check(ttype(ref(n))!=LUA_T_NIL && ttype(val(n))!=LUA_T_NIL,
+                   2, "key not found");
+    return hashnext(t, i+1);
+  }
+}

ltable.h

@@ -0,0 +1,24 @@
+/*
+** $Id: ltable.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
+** Lua tables (hash)
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ltable_h
+#define ltable_h
+
+#include "lobject.h"
+
+
+#define node(t,i)       (&(t)->node[i])
+#define ref(n)		(&(n)->ref)
+#define val(n)		(&(n)->val)
+#define nhash(t)	((t)->nhash)
+
+Hash *luaH_new (int nhash);
+void luaH_free (Hash *frees);
+TObject *luaH_get (Hash *t, TObject *ref);
+TObject *luaH_set (Hash *t, TObject *ref);
+Node *luaH_next (TObject *o, TObject *r);
+
+#endif

ltm.c

@@ -0,0 +1,263 @@
+/*
+** $Id: ltm.c,v 1.15 1998/03/11 13:59:50 roberto Exp roberto $
+** Tag methods
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdio.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "lmem.h"
+#include "lobject.h"
+#include "lstate.h"
+#include "ltm.h"
+
+
+char *luaT_eventname[] = {  /* ORDER IM */
+  "gettable", "settable", "index", "getglobal", "setglobal", "add",
+  "sub", "mul", "div", "pow", "unm", "lt", "le", "gt", "ge",
+  "concat", "gc", "function", NULL
+};
+
+
+static int luaI_checkevent (char *name, char *list[])
+{
+  int e = luaL_findstring(name, list);
+  if (e < 0)
+    luaL_verror("`%.50s' is not a valid event name", name);
+  return e;
+}
+
+
+
+/* events in LUA_T_NIL are all allowed, since this is used as a
+*  'placeholder' for "default" fallbacks
+*/
+static char validevents[NUM_TAGS][IM_N] = { /* ORDER LUA_T, ORDER IM */
+{1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1},  /* LUA_T_USERDATA */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_NUMBER */
+{1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1},  /* LUA_T_STRING */
+{0, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},  /* LUA_T_ARRAY */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_PROTO */
+{1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0},  /* LUA_T_CPROTO */
+{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}   /* LUA_T_NIL */
+};
+
+
+static int validevent (int t, int e)
+{ /* ORDER LUA_T */
+  return (t < LUA_T_NIL) ?  1 : validevents[-t][e];
+}
+
+
+static void init_entry (int tag)
+{
+  int i;
+  for (i=0; i<IM_N; i++)
+    ttype(luaT_getim(tag, i)) = LUA_T_NIL;
+}
+
+
+void luaT_init (void)
+{
+  int t;
+  L->IMtable_size = NUM_TAGS*2;
+  L->last_tag = -(NUM_TAGS-1);
+  L->IMtable = luaM_newvector(L->IMtable_size, struct IM);
+  for (t=L->last_tag; t<=0; t++)
+    init_entry(t);
+}
+
+
+int lua_newtag (void)
+{
+  --L->last_tag;
+  if ((-L->last_tag) >= L->IMtable_size)
+    L->IMtable_size = luaM_growvector(&L->IMtable, L->IMtable_size,
+                                   struct IM, memEM, MAX_INT);
+  init_entry(L->last_tag);
+  return L->last_tag;
+}
+
+
+static void checktag (int tag)
+{
+  if (!(L->last_tag <= tag && tag <= 0))
+    luaL_verror("%d is not a valid tag", tag);
+}
+
+void luaT_realtag (int tag)
+{
+  if (!(L->last_tag <= tag && tag < LUA_T_NIL))
+    luaL_verror("tag %d is not result of `newtag'", tag);
+}
+
+
+int lua_copytagmethods (int tagto, int tagfrom)
+{
+  int e;
+  checktag(tagto);
+  checktag(tagfrom);
+  for (e=0; e<IM_N; e++) {
+    if (validevent(tagto, e))
+      *luaT_getim(tagto, e) = *luaT_getim(tagfrom, e);
+  }
+  return tagto;
+}
+
+
+int luaT_efectivetag (TObject *o)
+{
+  int t;
+  switch (t = ttype(o)) {
+    case LUA_T_ARRAY:
+      return o->value.a->htag;
+    case LUA_T_USERDATA: {
+      int tag = o->value.ts->u.d.tag;
+      return (tag >= 0) ? LUA_T_USERDATA : tag;
+    }
+    case LUA_T_CLOSURE:
+      return o->value.cl->consts[0].ttype;
+#ifdef DEBUG
+    case LUA_T_PMARK: case LUA_T_CMARK:
+    case LUA_T_CLMARK: case LUA_T_LINE:
+      LUA_INTERNALERROR("invalid type");
+#endif
+    default:
+      return t;
+  }
+}
+
+
+TObject *luaT_gettagmethod (int t, char *event)
+{
+  int e = luaI_checkevent(event, luaT_eventname);
+  checktag(t);
+  if (validevent(t, e))
+    return luaT_getim(t,e);
+  else
+    return &luaO_nilobject;
+}
+
+
+void luaT_settagmethod (int t, char *event, TObject *func)
+{
+  TObject temp = *func;
+  int e = luaI_checkevent(event, luaT_eventname);
+  checktag(t);
+  if (!validevent(t, e))
+    luaL_verror("settagmethod: cannot change tag method `%.20s' for tag %d",
+                luaT_eventname[e], t);
+  *func = *luaT_getim(t,e);
+  *luaT_getim(t, e) = temp;
+}
+
+
+char *luaT_travtagmethods (int (*fn)(TObject *))
+{
+  int e;
+  if (fn(&L->errorim))
+    return "error";
+  for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {  /* ORDER IM */
+    int t;
+    for (t=0; t>=L->last_tag; t--)
+      if (fn(luaT_getim(t,e)))
+        return luaT_eventname[e];
+  }
+  return NULL;
+}
+
+
+/*
+* ===================================================================
+* compatibility with old fallback system
+*/
+#ifdef LUA_COMPAT2_5
+
+#include "lapi.h"
+
+static void errorFB (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isstring(o))
+    fprintf(stderr, "lua: %s\n", lua_getstring(o));
+  else
+    fprintf(stderr, "lua: unknown error\n");
+}
+
+
+static void nilFB (void) { }
+
+
+static void typeFB (void)
+{
+  lua_error("unexpected type");
+}
+
+
+static void fillvalids (IMS e, TObject *func)
+{
+  int t;
+  for (t=LUA_T_NIL; t<=LUA_T_USERDATA; t++)
+    if (validevent(t, e))
+      *luaT_getim(t, e) = *func;
+}
+
+
+void luaT_setfallback (void)
+{
+  static char *oldnames [] = {"error", "getglobal", "arith", "order", NULL};
+  TObject oldfunc;
+  lua_CFunction replace;
+  char *name = luaL_check_string(1);
+  lua_Object func = lua_getparam(2);
+  luaL_arg_check(lua_isfunction(func), 2, "function expected");
+  switch (luaL_findstring(name, oldnames)) {
+    case 0:  /* old error fallback */
+      oldfunc = L->errorim;
+      L->errorim = *luaA_Address(func);
+      replace = errorFB;
+      break;
+    case 1:  /* old getglobal fallback */
+      oldfunc = *luaT_getim(LUA_T_NIL, IM_GETGLOBAL);
+      *luaT_getim(LUA_T_NIL, IM_GETGLOBAL) = *luaA_Address(func);
+      replace = nilFB;
+      break;
+    case 2: {  /* old arith fallback */
+      int i;
+      oldfunc = *luaT_getim(LUA_T_NUMBER, IM_POW);
+      for (i=IM_ADD; i<=IM_UNM; i++)  /* ORDER IM */
+        fillvalids(i, luaA_Address(func));
+      replace = typeFB;
+      break;
+    }
+    case 3: {  /* old order fallback */
+      int i;
+      oldfunc = *luaT_getim(LUA_T_NIL, IM_LT);
+      for (i=IM_LT; i<=IM_GE; i++)  /* ORDER IM */
+        fillvalids(i, luaA_Address(func));
+      replace = typeFB;
+      break;
+    }
+    default: {
+      int e;
+      if ((e = luaL_findstring(name, luaT_eventname)) >= 0) {
+        oldfunc = *luaT_getim(LUA_T_NIL, e);
+        fillvalids(e, luaA_Address(func));
+        replace = (e == IM_GC || e == IM_INDEX) ? nilFB : typeFB;
+      }
+      else {
+        luaL_verror("`%.50s' is not a valid fallback name", name);
+        replace = NULL;  /* to avoid warnings */
+      }
+    }
+  }
+  if (oldfunc.ttype != LUA_T_NIL)
+    luaA_pushobject(&oldfunc);
+  else
+    lua_pushcfunction(replace);
+}
+#endif
+

ltm.h

@@ -0,0 +1,62 @@
+/*
+** $Id: ltm.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
+** Tag methods
+** See Copyright Notice in lua.h
+*/
+
+#ifndef ltm_h
+#define ltm_h
+
+
+#include "lobject.h"
+#include "lstate.h"
+
+/*
+* WARNING: if you change the order of this enumeration,
+* grep "ORDER IM"
+*/
+typedef enum {
+  IM_GETTABLE = 0,
+  IM_SETTABLE,
+  IM_INDEX,
+  IM_GETGLOBAL,
+  IM_SETGLOBAL,
+  IM_ADD,
+  IM_SUB,
+  IM_MUL,
+  IM_DIV,
+  IM_POW,
+  IM_UNM,
+  IM_LT,
+  IM_LE,
+  IM_GT,
+  IM_GE,
+  IM_CONCAT,
+  IM_GC,
+  IM_FUNCTION
+} IMS;
+
+#define IM_N 18
+
+
+struct IM {
+  TObject int_method[IM_N];
+};
+
+
+#define luaT_getim(tag,event) (&L->IMtable[-(tag)].int_method[event])
+#define luaT_getimbyObj(o,e)  (luaT_getim(luaT_efectivetag(o),(e)))
+
+extern char *luaT_eventname[];
+
+
+void luaT_init (void);
+void luaT_realtag (int tag);
+int luaT_efectivetag (TObject *o);
+void luaT_settagmethod (int t, char *event, TObject *func);
+TObject *luaT_gettagmethod (int t, char *event);
+char *luaT_travtagmethods (int (*fn)(TObject *));
+
+void luaT_setfallback (void);  /* only if LUA_COMPAT2_5 */
+
+#endif

lua.c

@@ -1,31 +1,194 @@
 /*
-** lua.c
-** Linguagem para Usuarios de Aplicacao
+** $Id: lua.c,v 1.13 1998/01/19 19:49:49 roberto Exp roberto $
+** Lua stand-alone interpreter
+** See Copyright Notice in lua.h
 */
 
-char *rcs_lua="$Id: $";
 
+#include <signal.h>
 #include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
 
 #include "lua.h"
+#include "luadebug.h"
 #include "lualib.h"
 
 
-void main (int argc, char *argv[])
+#ifndef OLD_ANSI
+#include <locale.h>
+#else
+#define setlocale(a,b)  0
+#endif
+
+#ifdef _POSIX_SOURCE
+#include <unistd.h>
+#else
+#define isatty(x)       (x==0)  /* assume stdin is a tty */
+#endif
+
+
+typedef void (*handler)(int);  /* type for signal actions */
+
+static void laction (int i);
+
+static handler lreset (void)
 {
- int i;
- iolib_open ();
- strlib_open ();
- mathlib_open ();
- if (argc < 2)
- {
-   char buffer[250];
-   while (gets(buffer) != 0)
-     lua_dostring(buffer);
- }
- else
-   for (i=1; i<argc; i++)
-    lua_dofile (argv[i]);
+  lua_linehook = NULL;
+  lua_callhook = NULL;
+  return signal(SIGINT, laction);
+}
+
+static void lstop (void)
+{
+  lreset();
+  lua_error("interrupted!");
+}
+
+static void laction (int i)
+{
+  lua_linehook = (lua_LHFunction)lstop;
+  lua_callhook = (lua_CHFunction)lstop;
+}
+
+static int ldo (int (*f)(char *), char *name)
+{
+  int res;
+  handler h = lreset();
+  res = f(name);  /* dostring | dofile */
+  signal(SIGINT, h);  /* restore old action */
+  return res;
 }
 
 
+static void print_message (void)
+{
+  fprintf(stderr,
+"Lua: command line options:\n"
+"  -v       print version information\n"
+"  -d       turn debug on\n"
+"  -e stat  dostring `stat'\n"
+"  -q       interactive mode without prompt\n"
+"  -i       interactive mode with prompt\n"
+"  -        executes stdin as a file\n"
+"  a=b      sets global `a' with string `b'\n"
+"  name     dofile `name'\n\n");
+}
+
+
+static void assign (char *arg)
+{
+  if (strlen(arg) >= 500)
+    fprintf(stderr, "lua: shell argument too long");
+  else {
+    char buffer[500];
+    char *eq = strchr(arg, '=');
+    lua_pushstring(eq+1);
+    strncpy(buffer, arg, eq-arg);
+    buffer[eq-arg] = 0;
+    lua_setglobal(buffer);
+  }
+}
+
+#define BUF_SIZE	512
+
+static void manual_input (int prompt)
+{
+  int cont = 1;
+  while (cont) {
+    char buffer[BUF_SIZE];
+    int i = 0;
+    lua_beginblock();
+    if (prompt)
+      printf("%s", lua_getstring(lua_getglobal("_PROMPT")));
+    for(;;) {
+      int c = getchar();
+      if (c == EOF) {
+        cont = 0;
+        break;
+      }
+      else if (c == '\n') {
+        if (i>0 && buffer[i-1] == '\\')
+          buffer[i-1] = '\n';
+        else break;
+      }
+      else if (i >= BUF_SIZE-1) {
+        fprintf(stderr, "lua: argument line too long\n");
+        break;
+      }
+      else buffer[i++] = c;
+    }
+    buffer[i] = 0;
+    ldo(lua_dostring, buffer);
+    lua_endblock();
+  }
+  printf("\n");
+}
+
+
+int main (int argc, char *argv[])
+{
+  int i;
+  setlocale(LC_ALL, "");
+  lua_iolibopen();
+  lua_strlibopen();
+  lua_mathlibopen();
+  lua_pushstring("> "); lua_setglobal("_PROMPT");
+  if (argc < 2) {  /* no arguments? */
+    if (isatty(0)) {
+      printf("%s  %s\n", LUA_VERSION, LUA_COPYRIGHT);
+      manual_input(1);
+    }
+    else
+      ldo(lua_dofile, NULL);  /* executes stdin as a file */
+  }
+  else for (i=1; i<argc; i++) {
+    if (argv[i][0] == '-') {  /* option? */
+      switch (argv[i][1]) {
+        case 0:
+          ldo(lua_dofile, NULL);  /* executes stdin as a file */
+          break;
+        case 'i':
+          manual_input(1);
+          break;
+        case 'q':
+          manual_input(0);
+          break;
+        case 'd':
+          lua_debug = 1;
+          break;
+        case 'v':
+          printf("%s  %s\n(written by %s)\n\n",
+                 LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
+          break;
+        case 'e':
+          i++;
+          if (ldo(lua_dostring, argv[i]) != 0) {
+            fprintf(stderr, "lua: error running argument `%s'\n", argv[i]);
+            return 1;
+          }
+          break;
+        default:
+          print_message();
+          exit(1);
+      }
+    }
+    else if (strchr(argv[i], '='))
+      assign(argv[i]);
+    else {
+      int result = ldo(lua_dofile, argv[i]);
+      if (result) {
+        if (result == 2) {
+          fprintf(stderr, "lua: cannot execute file ");
+          perror(argv[i]);
+        }
+        exit(1);
+      }
+    }
+  }
+#ifdef DEBUG
+  lua_close();
+#endif
+  return 0;
+}
+

lua.h

@@ -1,54 +1,196 @@
 /*
-** LUA - Linguagem para Usuarios de Aplicacao
-** Grupo de Tecnologia em Computacao Grafica
-** TeCGraf - PUC-Rio
-** $Id: $
+** $Id: lua.h,v 1.22 1998/06/15 21:34:14 roberto Exp roberto $
+** Lua - An Extensible Extension Language
+** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
+** e-mail: lua@tecgraf.puc-rio.br
+** www: http://www.tecgraf.puc-rio.br/lua/
+** See Copyright Notice at the end of this file
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+#define LUA_VERSION	"Lua 3.1"
+#define LUA_COPYRIGHT	"Copyright (C) 1994-1998 TeCGraf, PUC-Rio"
+#define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
+
+
+#define LUA_NOOBJECT  0
+
+#define LUA_ANYTAG    (-1)
+
 typedef void (*lua_CFunction) (void);
-typedef struct Object *lua_Object;
+typedef unsigned int lua_Object;
 
-#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+typedef struct lua_State lua_State;
+extern lua_State *lua_state;
 
+void	       lua_open			(void);
+void           lua_close		(void);
+lua_State      *lua_setstate		(lua_State *st);
+
+lua_Object     lua_settagmethod	(int tag, char *event); /* In: new method */
+lua_Object     lua_gettagmethod	(int tag, char *event);
+lua_Object     lua_seterrormethod (void);  /* In: new method */
+
+int            lua_newtag		(void);
+int            lua_copytagmethods	(int tagto, int tagfrom);
+void           lua_settag		(int tag); /* In: object */
 
-void           lua_errorfunction    	(void (*fn) (char *s));
 void           lua_error		(char *s);
-int            lua_dofile 		(char *filename);
-int            lua_dostring 		(char *string);
-int            lua_call 		(char *functionname, int nparam);
+int            lua_dofile 		(char *filename); /* Out: returns */
+int            lua_dostring 		(char *string); /* Out: returns */
+int            lua_dobuffer		(char *buff, int size, char *name);
+					  /* Out: returns */
+int            lua_callfunction		(lua_Object f);
+					  /* In: parameters; Out: returns */
 
-lua_Object     lua_getparam 		(int number);
-float          lua_getnumber 		(lua_Object object);
+void	       lua_beginblock		(void);
+void	       lua_endblock		(void);
+
+lua_Object     lua_lua2C 		(int number);
+#define	       lua_getparam(_)		lua_lua2C(_)
+#define	       lua_getresult(_)		lua_lua2C(_)
+
+int            lua_isnil                (lua_Object object);
+int            lua_istable              (lua_Object object);
+int            lua_isuserdata           (lua_Object object);
+int            lua_iscfunction          (lua_Object object);
+int            lua_isnumber             (lua_Object object);
+int            lua_isstring             (lua_Object object);
+int            lua_isfunction           (lua_Object object);
+
+double         lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
-char 	      *lua_copystring 		(lua_Object object);
+long           lua_strlen 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
-void          *lua_getuserdata  	(lua_Object object);
-lua_Object     lua_getfield         	(lua_Object object, char *field);
-lua_Object     lua_getindexed         	(lua_Object object, float index);
+void	      *lua_getuserdata		(lua_Object object);
+
+
+void 	       lua_pushnil 		(void);
+void           lua_pushnumber 		(double n);
+void           lua_pushlstring		(char *s, long len);
+void           lua_pushstring 		(char *s);
+void           lua_pushcclosure		(lua_CFunction fn, int n);
+void           lua_pushusertag          (void *u, int tag);
+void           lua_pushobject       	(lua_Object object);
+
+lua_Object     lua_pop			(void);
+
 lua_Object     lua_getglobal 		(char *name);
+lua_Object     lua_rawgetglobal		(char *name);
+void           lua_setglobal		(char *name); /* In: value */
+void           lua_rawsetglobal		(char *name); /* In: value */
 
-lua_Object     lua_pop 			(void);
+void           lua_settable	(void); /* In: table, index, value */
+void           lua_rawsettable	(void); /* In: table, index, value */
+lua_Object     lua_gettable 		(void); /* In: table, index */
+lua_Object     lua_rawgettable		(void); /* In: table, index */
 
-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_tag			(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);
+int            lua_ref			(int lock); /* In: value */
+lua_Object     lua_getref		(int ref);
+void	       lua_unref		(int ref);
+
+lua_Object     lua_createtable		(void);
+
+long	       lua_collectgarbage	(long limit);
+
+
+/* =============================================================== */
+/* some useful macros/derived functions */
+
+int     (lua_call) (char *name);
+#define lua_call(name)		lua_callfunction(lua_getglobal(name))
+
+void    (lua_pushref) (int ref);
+#define lua_pushref(ref)	lua_pushobject(lua_getref(ref))
+
+int     (lua_refobject) (lua_Object o, int l);
+#define lua_refobject(o,l)	(lua_pushobject(o), lua_ref(l))
+
+void    (lua_register) (char *n, lua_CFunction f);
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_setglobal(n))
+
+void    (lua_pushuserdata) (void *u);
+#define lua_pushuserdata(u)     lua_pushusertag(u, 0)
+
+void    (lua_pushcfunction) (lua_CFunction f);
+#define lua_pushcfunction(f)	lua_pushcclosure(f, 0)
+
+int     (lua_clonetag) (int t);
+#define lua_clonetag(t)		lua_copytagmethods(lua_newtag(), (t))
+
+
+/* ==========================================================================
+** for compatibility with old versions. Avoid using these macros/functions
+** If your program does need any of these, define LUA_COMPAT2_5
+*/
+
+
+#ifdef LUA_COMPAT2_5
+
+
+lua_Object     lua_setfallback		(char *event, lua_CFunction fallback);
+
+#define lua_storeglobal		lua_setglobal
+#define lua_type		lua_tag
+
+#define lua_lockobject(o)  lua_refobject(o,1)
+#define	lua_lock() lua_ref(1)
+#define lua_getlocked lua_getref
+#define	lua_pushlocked lua_pushref
+#define	lua_unlock lua_unref
+
+#define lua_pushliteral(o)  lua_pushstring(o)
+
+#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_gettable())
+#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushstring(f), lua_gettable())
+
+#define lua_copystring(o) (strdup(lua_getstring(o)))
+
+#define lua_getsubscript  lua_gettable
+#define lua_storesubscript  lua_settable
 
 #endif
+
+#endif
+
+
+
+/******************************************************************************
+* Copyright (c) 1994-1998 TeCGraf, PUC-Rio.  All rights reserved.
+* 
+* Permission is hereby granted, without written agreement and without license
+* or royalty fees, to use, copy, modify, and distribute this software and its
+* documentation for any purpose, including commercial applications, subject to
+* the following conditions:
+* 
+*  - The above copyright notice and this permission notice shall appear in all
+*    copies or substantial portions of this software.
+* 
+*  - The origin of this software must not be misrepresented; you must not
+*    claim that you wrote the original software. If you use this software in a
+*    product, an acknowledgment in the product documentation would be greatly
+*    appreciated (but it is not required).
+* 
+*  - Altered source versions must be plainly marked as such, and must not be
+*    misrepresented as being the original software.
+*    
+* The authors specifically disclaim any warranties, including, but not limited
+* to, the implied warranties of merchantability and fitness for a particular
+* purpose.  The software provided hereunder is on an "as is" basis, and the
+* authors have no obligation to provide maintenance, support, updates,
+* enhancements, or modifications.  In no event shall TeCGraf, PUC-Rio, or the
+* authors be held liable to any party for direct, indirect, special,
+* incidental, or consequential damages arising out of the use of this software
+* and its documentation.
+* 
+* The Lua language and this implementation have been entirely designed and
+* written by Waldemar Celes Filho, Roberto Ierusalimschy and
+* Luiz Henrique de Figueiredo at TeCGraf, PUC-Rio.
+* This implementation contains no third-party code.
+******************************************************************************/

lua.lex

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

lua.stx

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

luadebug.h

@@ -0,0 +1,33 @@
+/*
+** $Id: luadebug.h,v 1.1 1997/09/16 19:25:59 roberto Exp roberto $
+** Debugging API
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef luadebug_h
+#define luadebug_h
+
+
+#include "lua.h"
+
+typedef lua_Object lua_Function;
+
+typedef void (*lua_LHFunction) (int line);
+typedef void (*lua_CHFunction) (lua_Function func, char *file, int line);
+
+lua_Function lua_stackedfunction (int level);
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
+int lua_currentline (lua_Function func);
+char *lua_getobjname (lua_Object o, char **name);
+
+lua_Object lua_getlocal (lua_Function func, int local_number, char **name);
+int lua_setlocal (lua_Function func, int local_number);
+
+
+extern lua_LHFunction lua_linehook;
+extern lua_CHFunction lua_callhook;
+extern int lua_debug;
+
+
+#endif

lualib.h

@@ -1,16 +1,34 @@
 /*
-** Libraries to be used in LUA programs
-** Grupo de Tecnologia em Computacao Grafica
-** TeCGraf - PUC-Rio
-** $Id: $
+** $Id: lualib.h,v 1.3 1997/12/17 20:48:58 roberto Exp roberto $
+** Lua standard libraries
+** See Copyright Notice in lua.h
 */
 
+
 #ifndef lualib_h
 #define lualib_h
 
-void iolib_open   (void);
-void strlib_open  (void);
-void mathlib_open (void);
+#include "lua.h"
+
+
+void lua_iolibopen   (void);
+void lua_strlibopen  (void);
+void lua_mathlibopen (void);
+
+
+
+
+/* To keep compatibility with old versions */
+
+#define iolib_open	lua_iolibopen
+#define strlib_open	lua_strlibopen
+#define mathlib_open	lua_mathlibopen
+
+
+
+/* Auxiliary functions (private) */
+
+int luaI_singlematch (int c, char *p, char **ep);
 
 #endif
 

lundump.c

@@ -0,0 +1,226 @@
+/*
+** $Id: lundump.c,v 1.10 1998/06/25 15:50:09 lhf Exp $
+** load bytecodes from files
+** See Copyright Notice in lua.h
+*/
+
+#include <stdio.h>
+#include "lauxlib.h"
+#include "lfunc.h"
+#include "lmem.h"
+#include "lstring.h"
+#include "lundump.h"
+
+#define	LoadBlock(b,size,Z)	ezread(Z,b,size)
+#define	LoadNative(t,Z)		LoadBlock(&t,sizeof(t),Z)
+
+#if ID_NUMBER==ID_NATIVE
+	#define doLoadNumber(f,Z)	LoadNative(f,Z)
+#else
+	#define doLoadNumber(f,Z)	f=LoadNumber(Z)
+#endif
+
+static void unexpectedEOZ(ZIO* Z)
+{
+ luaL_verror("unexpected end of file in %s",zname(Z));
+}
+
+static int ezgetc(ZIO* Z)
+{
+ int c=zgetc(Z);
+ if (c==EOZ) unexpectedEOZ(Z);
+ return c;
+}
+
+static void ezread(ZIO* Z, void* b, int n)
+{
+ int r=zread(Z,b,n);
+ if (r!=0) unexpectedEOZ(Z);
+}
+
+static unsigned int LoadWord(ZIO* Z)
+{
+ unsigned int hi=ezgetc(Z);
+ unsigned int lo=ezgetc(Z);
+ return (hi<<8)|lo;
+}
+
+static unsigned long LoadLong(ZIO* Z)
+{
+ unsigned long hi=LoadWord(Z);
+ unsigned long lo=LoadWord(Z);
+ return (hi<<16)|lo;
+}
+
+#if ID_NUMBER==ID_REAL4
+/* LUA_NUMBER */
+/* assumes sizeof(long)==4 and sizeof(float)==4 (IEEE) */
+static float LoadFloat(ZIO* Z)
+{
+ unsigned long l=LoadLong(Z);
+ float f=*(float*)&l;
+ return f;
+}
+#endif
+
+#if ID_NUMBER==ID_REAL8
+/* LUA_NUMBER */
+/* assumes sizeof(long)==4 and sizeof(double)==8 (IEEE) */
+static double LoadDouble(ZIO* Z)
+{
+ unsigned long l[2];
+ double f;
+ int x=1;
+ if (*(char*)&x==1)			/* little-endian */
+ {
+  l[1]=LoadLong(Z);
+  l[0]=LoadLong(Z);
+ }
+ else					/* big-endian */
+ {
+  l[0]=LoadLong(Z);
+  l[1]=LoadLong(Z);
+ }
+ f=*(double*)l;
+ return f;
+}
+#endif
+
+static Byte* LoadCode(ZIO* Z)
+{
+ unsigned long size=LoadLong(Z);
+ unsigned int s=size;
+ void* b;
+ if (s!=size) luaL_verror("code too long (%ld bytes) in %s",size,zname(Z));
+ b=luaM_malloc(size);
+ LoadBlock(b,size,Z);
+ return b;
+}
+
+static TaggedString* LoadTString(ZIO* Z)
+{
+ int size=LoadWord(Z);
+ if (size==0)
+  return NULL;
+ else
+ {
+  char* s=luaL_openspace(size);
+  LoadBlock(s,size,Z);
+  return luaS_newlstr(s,size-1);
+ }
+}
+
+static void LoadLocals(TProtoFunc* tf, ZIO* Z)
+{
+ int i,n=LoadWord(Z);
+ if (n==0) return;
+ tf->locvars=luaM_newvector(n+1,LocVar);
+ for (i=0; i<n; i++)
+ {
+  tf->locvars[i].line=LoadWord(Z);
+  tf->locvars[i].varname=LoadTString(Z);
+ }
+ tf->locvars[i].line=-1;		/* flag end of vector */
+ tf->locvars[i].varname=NULL;
+}
+
+static TProtoFunc* LoadFunction(ZIO* Z);
+
+static void LoadConstants(TProtoFunc* tf, ZIO* Z)
+{
+ int i,n=LoadWord(Z);
+ tf->nconsts=n;
+ if (n==0) return;
+ tf->consts=luaM_newvector(n,TObject);
+ for (i=0; i<n; i++)
+ {
+  TObject* o=tf->consts+i;
+  int c=ezgetc(Z);
+  switch (c)
+  {
+   case ID_NUM:
+	ttype(o)=LUA_T_NUMBER;
+	doLoadNumber(nvalue(o),Z);
+	break;
+   case ID_STR:
+	ttype(o)=LUA_T_STRING;	
+	tsvalue(o)=LoadTString(Z);
+	break;
+   case ID_FUN:
+	ttype(o)=LUA_T_PROTO;
+	tfvalue(o)=LoadFunction(Z);
+	break;
+   default:
+	luaL_verror("bad constant #%d in %s: type=%d ('%c')",i,zname(Z),c,c);
+	break;
+  }
+ }
+}
+
+static TProtoFunc* LoadFunction(ZIO* Z)
+{
+ TProtoFunc* tf=luaF_newproto();
+ tf->lineDefined=LoadWord(Z);
+ tf->fileName=LoadTString(Z);
+ tf->code=LoadCode(Z);
+ LoadLocals(tf,Z);
+ LoadConstants(tf,Z);
+ return tf;
+}
+
+static void LoadSignature(ZIO* Z)
+{
+ char* s=SIGNATURE;
+ while (*s!=0 && ezgetc(Z)==*s)
+  ++s;
+ if (*s!=0) luaL_verror("bad signature in %s",zname(Z));
+}
+
+static void LoadHeader(ZIO* Z)
+{
+ int version,id,sizeofR;
+ real f=-TEST_NUMBER,tf=TEST_NUMBER;
+ LoadSignature(Z);
+ version=ezgetc(Z);
+ if (version>VERSION)
+  luaL_verror(
+	"%s too new: version=0x%02x; expected at most 0x%02x",
+	zname(Z),version,VERSION);
+ if (version<VERSION0)			/* check last major change */
+  luaL_verror(
+	"%s too old: version=0x%02x; expected at least 0x%02x",
+	zname(Z),version,VERSION0);
+ id=ezgetc(Z);				/* test number representation */
+ sizeofR=ezgetc(Z);
+ if (id!=ID_NUMBER || sizeofR!=sizeof(real))
+ {
+  luaL_verror("unknown number signature in %s: "
+	"read 0x%02x%02x; expected 0x%02x%02x",
+	zname(Z),id,sizeofR,ID_NUMBER,sizeof(real));
+ }
+ doLoadNumber(f,Z);
+ if (f!=tf)
+  luaL_verror("unknown number representation in %s: "
+	"read " NUMBER_FMT "; expected " NUMBER_FMT "",	/* LUA_NUMBER */
+	zname(Z),(double)f,(double)tf);
+}
+
+static TProtoFunc* LoadChunk(ZIO* Z)
+{
+ LoadHeader(Z);
+ return LoadFunction(Z);
+}
+
+/*
+** load one chunk from a file or buffer
+** return main if ok and NULL at EOF
+*/
+TProtoFunc* luaU_undump1(ZIO* Z)
+{
+ int c=zgetc(Z);
+ if (c==ID_CHUNK)
+  return LoadChunk(Z);
+ else if (c!=EOZ)
+  luaL_verror("%s is not a Lua binary file",zname(Z));
+ return NULL;
+}

lundump.h

@@ -0,0 +1,81 @@
+/*
+** $Id: lundump.h,v 1.7 1998/06/25 15:50:09 lhf Exp $
+** load pre-compiled Lua chunks
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lundump_h
+#define lundump_h
+
+#include "lobject.h"
+#include "lzio.h"
+
+TProtoFunc* luaU_undump1(ZIO* Z);	/* load one chunk */
+
+#define	SIGNATURE	"Lua"
+#define	VERSION		0x31		/* last format change was in 3.1 */
+#define	VERSION0	0x31		/* last major  change was in 3.1 */
+
+#define IsMain(f)	(f->lineDefined==0)
+
+#define ID_CHUNK	27		/* ESC */
+#define ID_NUM		'N'
+#define ID_STR		'S'
+#define ID_FUN		'F'
+
+/* number representation */
+#define ID_INT4		'l'		/* 4-byte integers */
+#define ID_REAL4	'f'		/* 4-byte reals */
+#define ID_REAL8	'd'		/* 8-byte reals */
+#define ID_NATIVE	'?'		/* whatever your machine uses */
+
+/*
+* use a multiple of PI for testing number representation.
+* multiplying by 1E8 gives notrivial integer values.
+*/
+#define	TEST_NUMBER	3.14159265358979323846E8
+
+/* LUA_NUMBER
+* choose one below for the number representation in precompiled chunks.
+* the default is ID_REAL8 because the default for LUA_NUM_TYPE is double.
+* if your machine does not use IEEE 754, use ID_NATIVE.
+* the next version will support conversion to/from IEEE 754.
+*
+* if you change LUA_NUM_TYPE, make sure you set ID_NUMBER accordingly,
+* specially if sizeof(long)!=4.
+* for types other than the ones listed below, you'll have to write your own
+* dump and undump routines.
+*/
+
+#ifndef ID_NUMBER
+#define	ID_NUMBER	ID_NATIVE
+#endif
+
+#if 0
+#define	ID_NUMBER	ID_INT4
+#define	ID_NUMBER	ID_REAL4
+#define	ID_NUMBER	ID_REAL8
+#define	ID_NUMBER	ID_NATIVE
+#endif
+
+#endif
+
+#if   ID_NUMBER==ID_REAL4
+	#define	DumpNumber	DumpFloat
+	#define	LoadNumber	LoadFloat
+	#define SIZEOF_NUMBER	4
+#elif ID_NUMBER==ID_REAL8
+	#define	DumpNumber	DumpDouble
+	#define	LoadNumber	LoadDouble
+	#define SIZEOF_NUMBER	8
+#elif ID_NUMBER==ID_INT4
+	#define	DumpNumber	DumpLong
+	#define	LoadNumber	LoadLong
+	#define SIZEOF_NUMBER	4
+#elif ID_NUMBER==ID_NATIVE
+	#define	DumpNumber	DumpNative
+	#define	LoadNumber	LoadNative
+	#define SIZEOF_NUMBER	sizeof(real)
+#else
+	#error	bad ID_NUMBER
+#endif

lvm.c

@@ -0,0 +1,737 @@
+/*
+** $Id: lvm.c,v 1.29 1998/05/31 22:18:24 roberto Exp roberto $
+** Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+
+#include <stdio.h>
+#include <string.h>
+
+#include "lauxlib.h"
+#include "ldo.h"
+#include "lfunc.h"
+#include "lgc.h"
+#include "lmem.h"
+#include "lopcodes.h"
+#include "lstate.h"
+#include "lstring.h"
+#include "ltable.h"
+#include "ltm.h"
+#include "luadebug.h"
+#include "lvm.h"
+
+
+#ifdef OLD_ANSI
+#define strcoll(a,b)	strcmp(a,b)
+#endif
+
+
+#define skip_word(pc)	(pc+=2)
+#define get_word(pc)	((*(pc)<<8)+(*((pc)+1)))
+#define next_word(pc)   (pc+=2, get_word(pc-2))
+
+
+/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
+#define	EXTRA_STACK	5
+
+
+
+static TaggedString *strconc (TaggedString *l, TaggedString *r)
+{
+  size_t nl = l->u.s.len;
+  size_t nr = r->u.s.len;
+  char *buffer = luaL_openspace(nl+nr+1);
+  memcpy(buffer, l->str, nl);
+  memcpy(buffer+nl, r->str, nr);
+  return luaS_newlstr(buffer, nl+nr);
+}
+
+
+int luaV_tonumber (TObject *obj)
+{  /* LUA_NUMBER */
+  double t;
+  char c;
+  if (ttype(obj) != LUA_T_STRING)
+    return 1;
+  else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) {
+    nvalue(obj) = (real)t;
+    ttype(obj) = LUA_T_NUMBER;
+    return 0;
+  }
+  else
+    return 2;
+}
+
+
+int luaV_tostring (TObject *obj)
+{ /* LUA_NUMBER */
+  if (ttype(obj) != LUA_T_NUMBER)
+    return 1;
+  else {
+    char s[60];
+    real f = nvalue(obj);
+    int i;
+    if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f)
+      sprintf (s, "%d", i);
+    else
+      sprintf (s, NUMBER_FMT, nvalue(obj));
+    tsvalue(obj) = luaS_new(s);
+    ttype(obj) = LUA_T_STRING;
+    return 0;
+  }
+}
+
+
+void luaV_closure (int nelems)
+{
+  if (nelems > 0) {
+    struct Stack *S = &L->stack;
+    Closure *c = luaF_newclosure(nelems);
+    c->consts[0] = *(S->top-1);
+    memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
+    S->top -= nelems;
+    ttype(S->top-1) = LUA_T_CLOSURE;
+    (S->top-1)->value.cl = c;
+  }
+}
+
+
+/*
+** Function to index a table.
+** Receives the table at top-2 and the index at top-1.
+*/
+void luaV_gettable (void)
+{
+  struct Stack *S = &L->stack;
+  TObject *im;
+  if (ttype(S->top-2) != LUA_T_ARRAY)  /* not a table, get "gettable" method */
+    im = luaT_getimbyObj(S->top-2, IM_GETTABLE);
+  else {  /* object is a table... */
+    int tg = (S->top-2)->value.a->htag;
+    im = luaT_getim(tg, IM_GETTABLE);
+    if (ttype(im) == LUA_T_NIL) {  /* and does not have a "gettable" method */
+      TObject *h = luaH_get(avalue(S->top-2), S->top-1);
+      if (h != NULL && ttype(h) != LUA_T_NIL) {
+        --S->top;
+        *(S->top-1) = *h;
+      }
+      else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)
+        luaD_callTM(im, 2, 1);
+      else {
+        --S->top;
+        ttype(S->top-1) = LUA_T_NIL;
+      }
+      return;
+    }
+    /* else it has a "gettable" method, go through to next command */
+  }
+  /* object is not a table, or it has a "gettable" method */
+  if (ttype(im) != LUA_T_NIL)
+    luaD_callTM(im, 2, 1);
+  else
+    lua_error("indexed expression not a table");
+}
+
+
+/*
+** Function to store indexed based on values at the stack.top
+** mode = 0: raw store (without tag methods)
+** mode = 1: normal store (with tag methods)
+** mode = 2: "deep L->stack.stack" store (with tag methods)
+*/
+void luaV_settable (TObject *t, int mode)
+{
+  struct Stack *S = &L->stack;
+  TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE);
+  if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) {
+    TObject *h = luaH_set(avalue(t), t+1);
+    *h = *(S->top-1);
+    S->top -= (mode == 2) ? 1 : 3;
+  }
+  else {  /* object is not a table, and/or has a specific "settable" method */
+    if (im && ttype(im) != LUA_T_NIL) {
+      if (mode == 2) {
+        *(S->top+1) = *(L->stack.top-1);
+        *(S->top) = *(t+1);
+        *(S->top-1) = *t;
+        S->top += 2;  /* WARNING: caller must assure stack space */
+      }
+      luaD_callTM(im, 3, 0);
+    }
+    else
+      lua_error("indexed expression not a table");
+  }
+}
+
+
+void luaV_getglobal (TaggedString *ts)
+{
+  /* WARNING: caller must assure stack space */
+  TObject *value = &ts->u.s.globalval;
+  TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
+  if (ttype(im) == LUA_T_NIL) {  /* default behavior */
+    *L->stack.top++ = *value;
+  }
+  else {
+    struct Stack *S = &L->stack;
+    ttype(S->top) = LUA_T_STRING;
+    tsvalue(S->top) = ts;
+    S->top++;
+    *S->top++ = *value;
+    luaD_callTM(im, 2, 1);
+  }
+}
+
+
+void luaV_setglobal (TaggedString *ts)
+{
+  TObject *oldvalue = &ts->u.s.globalval;
+  TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
+  if (ttype(im) == LUA_T_NIL)  /* default behavior */
+    luaS_rawsetglobal(ts, --L->stack.top);
+  else {
+    /* WARNING: caller must assure stack space */
+    struct Stack *S = &L->stack;
+    TObject newvalue = *(S->top-1);
+    ttype(S->top-1) = LUA_T_STRING;
+    tsvalue(S->top-1) = ts;
+    *S->top++ = *oldvalue;
+    *S->top++ = newvalue;
+    luaD_callTM(im, 3, 0);
+  }
+}
+
+
+static void call_binTM (IMS event, char *msg)
+{
+  TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */
+  if (ttype(im) == LUA_T_NIL) {
+    im = luaT_getimbyObj(L->stack.top-1, event);  /* try second operand */
+    if (ttype(im) == LUA_T_NIL) {
+      im = luaT_getim(0, event);  /* try a 'global' i.m. */
+      if (ttype(im) == LUA_T_NIL)
+        lua_error(msg);
+    }
+  }
+  lua_pushstring(luaT_eventname[event]);
+  luaD_callTM(im, 3, 1);
+}
+
+
+static void call_arith (IMS event)
+{
+  call_binTM(event, "unexpected type in arithmetic operation");
+}
+
+
+static int strcomp (char *l, long ll, char *r, long lr)
+{
+  for (;;) {
+    long temp = strcoll(l, r);
+    if (temp != 0) return temp;
+    /* strings are equal up to a '\0' */
+    temp = strlen(l);  /* index of first '\0' in both strings */
+    if (temp == ll)  /* l is finished? */
+      return (temp == lr) ? 0 : -1;  /* l is equal or smaller than r */
+    else if (temp == lr)  /* r is finished? */
+      return 1;  /* l is greater than r (because l is not finished) */
+    /* both strings longer than temp; go on comparing (after the '\0') */
+    temp++;
+    l += temp; ll -= temp; r += temp; lr -= temp;
+  }
+}
+
+static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
+                        lua_Type ttype_great, IMS op)
+{
+  struct Stack *S = &L->stack;
+  TObject *l = S->top-2;
+  TObject *r = S->top-1;
+  int result;
+  if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER)
+    result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1;
+  else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING)
+    result = strcomp(svalue(l), tsvalue(l)->u.s.len,
+                     svalue(r), tsvalue(r)->u.s.len);
+  else {
+    call_binTM(op, "unexpected type in comparison");
+    return;
+  }
+  S->top--;
+  nvalue(S->top-1) = 1;
+  ttype(S->top-1) = (result < 0) ? ttype_less :
+                                (result == 0) ? ttype_equal : ttype_great;
+}
+
+
+void luaV_pack (StkId firstel, int nvararg, TObject *tab)
+{
+  TObject *firstelem = L->stack.stack+firstel;
+  int i;
+  if (nvararg < 0) nvararg = 0;
+  avalue(tab)  = luaH_new(nvararg+1);  /* +1 for field 'n' */
+  ttype(tab) = LUA_T_ARRAY;
+  for (i=0; i<nvararg; i++) {
+    TObject index;
+    ttype(&index) = LUA_T_NUMBER;
+    nvalue(&index) = i+1;
+    *(luaH_set(avalue(tab), &index)) = *(firstelem+i);
+  }
+  /* store counter in field "n" */ {
+    TObject index, extra;
+    ttype(&index) = LUA_T_STRING;
+    tsvalue(&index) = luaS_new("n");
+    ttype(&extra) = LUA_T_NUMBER;
+    nvalue(&extra) = nvararg;
+    *(luaH_set(avalue(tab), &index)) = extra;
+  }
+}
+
+
+static void adjust_varargs (StkId first_extra_arg)
+{
+  TObject arg;
+  luaV_pack(first_extra_arg,
+       (L->stack.top-L->stack.stack)-first_extra_arg, &arg);
+  luaD_adjusttop(first_extra_arg);
+  *L->stack.top++ = arg;
+}
+
+
+
+/*
+** Execute the given opcode, until a RET. Parameters are between
+** [stack+base,top). Returns n such that the the results are between
+** [stack+n,top).
+*/
+StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
+{
+  struct Stack *S = &L->stack;  /* to optimize */
+  Byte *pc = tf->code;
+  TObject *consts = tf->consts;
+  if (lua_callhook)
+    luaD_callHook(base, tf, 0);
+  luaD_checkstack((*pc++)+EXTRA_STACK);
+  if (*pc < ZEROVARARG)
+    luaD_adjusttop(base+*(pc++));
+  else {  /* varargs */
+    luaC_checkGC();
+    adjust_varargs(base+(*pc++)-ZEROVARARG);
+  }
+  while (1) {
+    int aux;
+    switch ((OpCode)(aux = *pc++)) {
+
+      case PUSHNIL0:
+        ttype(S->top++) = LUA_T_NIL;
+        break;
+
+      case PUSHNIL:
+        aux = *pc++;
+        do {
+          ttype(S->top++) = LUA_T_NIL;
+        } while (aux--);
+        break;
+
+      case PUSHNUMBER:
+        aux = *pc++; goto pushnumber;
+
+      case PUSHNUMBERW:
+        aux = next_word(pc); goto pushnumber;
+
+      case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
+        aux -= PUSHNUMBER0;
+      pushnumber:
+        ttype(S->top) = LUA_T_NUMBER;
+        nvalue(S->top) = aux;
+        S->top++;
+        break;
+
+      case PUSHLOCAL:
+        aux = *pc++; goto pushlocal;
+
+      case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
+      case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
+        aux -= PUSHLOCAL0;
+      pushlocal:
+        *S->top++ = *((S->stack+base) + aux);
+        break;
+
+      case GETGLOBALW:
+        aux = next_word(pc); goto getglobal;
+
+      case GETGLOBAL:
+        aux = *pc++; goto getglobal;
+
+      case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3:
+      case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7:
+        aux -= GETGLOBAL0;
+      getglobal:
+        luaV_getglobal(tsvalue(&consts[aux]));
+        break;
+
+      case GETTABLE:
+       luaV_gettable();
+       break;
+
+      case GETDOTTEDW:
+        aux = next_word(pc); goto getdotted;
+
+      case GETDOTTED:
+        aux = *pc++; goto getdotted;
+
+      case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3:
+      case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
+        aux -= GETDOTTED0;
+      getdotted:
+        *S->top++ = consts[aux];
+        luaV_gettable();
+        break;
+
+      case PUSHSELFW:
+        aux = next_word(pc); goto pushself;
+
+      case PUSHSELF:
+        aux = *pc++; goto pushself;
+
+      case PUSHSELF0: case PUSHSELF1: case PUSHSELF2: case PUSHSELF3:
+      case PUSHSELF4: case PUSHSELF5: case PUSHSELF6: case PUSHSELF7:
+        aux -= PUSHSELF0;
+      pushself: {
+        TObject receiver = *(S->top-1);
+        *S->top++ = consts[aux];
+        luaV_gettable();
+        *S->top++ = receiver;
+        break;
+      }
+
+      case PUSHCONSTANTW:
+        aux = next_word(pc); goto pushconstant;
+
+      case PUSHCONSTANT:
+        aux = *pc++; goto pushconstant;
+
+      case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2:
+      case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5:
+      case PUSHCONSTANT6: case PUSHCONSTANT7:
+        aux -= PUSHCONSTANT0;
+      pushconstant:
+        *S->top++ = consts[aux];
+        break;
+
+      case PUSHUPVALUE:
+        aux = *pc++; goto pushupvalue;
+
+      case PUSHUPVALUE0: case PUSHUPVALUE1:
+        aux -= PUSHUPVALUE0;
+      pushupvalue:
+        *S->top++ = cl->consts[aux+1];
+        break;
+
+      case SETLOCAL:
+        aux = *pc++; goto setlocal;
+
+      case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3:
+      case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
+        aux -= SETLOCAL0;
+      setlocal:
+        *((S->stack+base) + aux) = *(--S->top);
+        break;
+
+      case SETGLOBALW:
+        aux = next_word(pc); goto setglobal;
+
+      case SETGLOBAL:
+        aux = *pc++; goto setglobal;
+
+      case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3:
+      case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7:
+        aux -= SETGLOBAL0;
+      setglobal:
+        luaV_setglobal(tsvalue(&consts[aux]));
+        break;
+
+      case SETTABLE0:
+       luaV_settable(S->top-3, 1);
+       break;
+
+      case SETTABLE:
+        luaV_settable(S->top-3-(*pc++), 2);
+        break;
+
+      case SETLISTW:
+        aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist;
+
+      case SETLIST:
+        aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist;
+
+      case SETLIST0:
+        aux = 0;
+      setlist: {
+        int n = *(pc++);
+        TObject *arr = S->top-n-1;
+        for (; n; n--) {
+          ttype(S->top) = LUA_T_NUMBER;
+          nvalue(S->top) = n+aux;
+          *(luaH_set(avalue(arr), S->top)) = *(S->top-1);
+          S->top--;
+        }
+        break;
+      }
+
+      case SETMAP0:
+        aux = 0; goto setmap;
+
+      case SETMAP:
+        aux = *pc++;
+      setmap: {
+        TObject *arr = S->top-(2*aux)-3;
+        do {
+          *(luaH_set(avalue(arr), S->top-2)) = *(S->top-1);
+          S->top-=2;
+        } while (aux--);
+        break;
+      }
+
+      case POP:
+        aux = *pc++; goto pop;
+
+      case POP0: case POP1:
+        aux -= POP0;
+      pop:
+        S->top -= (aux+1);
+        break;
+
+      case CREATEARRAYW:
+        aux = next_word(pc); goto createarray;
+
+      case CREATEARRAY0: case CREATEARRAY1:
+        aux -= CREATEARRAY0; goto createarray;
+
+      case CREATEARRAY:
+        aux = *pc++;
+      createarray:
+        luaC_checkGC();
+        avalue(S->top) = luaH_new(aux);
+        ttype(S->top) = LUA_T_ARRAY;
+        S->top++;
+        break;
+
+      case EQOP: case NEQOP: {
+        int res = luaO_equalObj(S->top-2, S->top-1);
+        S->top--;
+        if (aux == NEQOP) res = !res;
+        ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
+        nvalue(S->top-1) = 1;
+        break;
+      }
+
+       case LTOP:
+         comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT);
+         break;
+
+      case LEOP:
+        comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE);
+        break;
+
+      case GTOP:
+        comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT);
+        break;
+
+      case GEOP:
+        comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE);
+        break;
+
+      case ADDOP: {
+        TObject *l = S->top-2;
+        TObject *r = S->top-1;
+        if (tonumber(r) || tonumber(l))
+          call_arith(IM_ADD);
+        else {
+          nvalue(l) += nvalue(r);
+          --S->top;
+        }
+        break;
+      }
+
+      case SUBOP: {
+        TObject *l = S->top-2;
+        TObject *r = S->top-1;
+        if (tonumber(r) || tonumber(l))
+          call_arith(IM_SUB);
+        else {
+          nvalue(l) -= nvalue(r);
+          --S->top;
+        }
+        break;
+      }
+
+      case MULTOP: {
+        TObject *l = S->top-2;
+        TObject *r = S->top-1;
+        if (tonumber(r) || tonumber(l))
+          call_arith(IM_MUL);
+        else {
+          nvalue(l) *= nvalue(r);
+          --S->top;
+        }
+        break;
+      }
+
+      case DIVOP: {
+        TObject *l = S->top-2;
+        TObject *r = S->top-1;
+        if (tonumber(r) || tonumber(l))
+          call_arith(IM_DIV);
+        else {
+          nvalue(l) /= nvalue(r);
+          --S->top;
+        }
+        break;
+      }
+
+      case POWOP:
+        call_binTM(IM_POW, "undefined operation");
+        break;
+
+      case CONCOP: {
+        TObject *l = S->top-2;
+        TObject *r = S->top-1;
+        if (tostring(l) || tostring(r))
+          call_binTM(IM_CONCAT, "unexpected type for concatenation");
+        else {
+          tsvalue(l) = strconc(tsvalue(l), tsvalue(r));
+          --S->top;
+        }
+        luaC_checkGC();
+        break;
+      }
+
+      case MINUSOP:
+        if (tonumber(S->top-1)) {
+          ttype(S->top) = LUA_T_NIL;
+          S->top++;
+          call_arith(IM_UNM);
+        }
+        else
+          nvalue(S->top-1) = - nvalue(S->top-1);
+        break;
+
+      case NOTOP:
+        ttype(S->top-1) =
+           (ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
+        nvalue(S->top-1) = 1;
+        break;
+
+      case ONTJMPW:
+        aux = next_word(pc); goto ontjmp;
+
+      case ONTJMP:
+        aux = *pc++;
+      ontjmp:
+        if (ttype(S->top-1) != LUA_T_NIL) pc += aux;
+        else S->top--;
+        break;
+
+      case ONFJMPW:
+        aux = next_word(pc); goto onfjmp;
+
+      case ONFJMP:
+        aux = *pc++;
+      onfjmp:
+        if (ttype(S->top-1) == LUA_T_NIL) pc += aux;
+        else S->top--;
+        break;
+
+      case JMPW:
+        aux = next_word(pc); goto jmp;
+
+      case JMP:
+        aux = *pc++;
+      jmp:
+        pc += aux;
+        break;
+
+      case IFFJMPW:
+        aux = next_word(pc); goto iffjmp;
+
+      case IFFJMP:
+        aux = *pc++;
+      iffjmp:
+        if (ttype(--S->top) == LUA_T_NIL) pc += aux;
+        break;
+
+      case IFTUPJMPW:
+        aux = next_word(pc); goto iftupjmp;
+
+      case IFTUPJMP:
+        aux = *pc++;
+      iftupjmp:
+        if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
+        break;
+
+      case IFFUPJMPW:
+        aux = next_word(pc); goto iffupjmp;
+
+      case IFFUPJMP:
+        aux = *pc++;
+      iffupjmp:
+        if (ttype(--S->top) == LUA_T_NIL) pc -= aux;
+        break;
+
+      case CLOSUREW:
+        aux = next_word(pc); goto closure;
+
+      case CLOSURE:
+        aux = *pc++;
+      closure:
+        *S->top++ = consts[aux];
+        luaV_closure(*pc++);
+        luaC_checkGC();
+        break;
+
+      case CALLFUNC:
+        aux = *pc++; goto callfunc;
+
+      case CALLFUNC0: case CALLFUNC1:
+        aux -= CALLFUNC0;
+      callfunc: {
+        StkId newBase = (S->top-S->stack)-(*pc++);
+        luaD_call(newBase, aux);
+        break;
+      }
+
+      case ENDCODE:
+        S->top = S->stack + base;
+        /* goes through */
+      case RETCODE:
+        if (lua_callhook)
+          luaD_callHook(base, NULL, 1);
+        return (base + ((aux==RETCODE) ? *pc : 0));
+
+      case SETLINEW:
+        aux = next_word(pc); goto setline;
+
+      case SETLINE:
+        aux = *pc++;
+      setline:
+        if ((S->stack+base-1)->ttype != LUA_T_LINE) {
+          /* open space for LINE value */
+          luaD_openstack((S->top-S->stack)-base);
+          base++;
+          (S->stack+base-1)->ttype = LUA_T_LINE;
+        }
+        (S->stack+base-1)->value.i = aux;
+        if (lua_linehook)
+          luaD_lineHook(aux);
+        break;
+
+#ifdef DEBUG
+      default:
+        LUA_INTERNALERROR("opcode doesn't match");
+#endif
+    }
+  }
+}
+

lvm.h

@@ -0,0 +1,29 @@
+/*
+** $Id: lvm.h,v 1.3 1997/10/16 10:59:34 roberto Exp roberto $
+** Lua virtual machine
+** See Copyright Notice in lua.h
+*/
+
+#ifndef lvm_h
+#define lvm_h
+
+
+#include "ldo.h"
+#include "lobject.h"
+
+
+#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0))
+#define tostring(o) ((ttype(o) != LUA_T_STRING) && (luaV_tostring(o) != 0))
+
+
+void luaV_pack (StkId firstel, int nvararg, TObject *tab);
+int luaV_tonumber (TObject *obj);
+int luaV_tostring (TObject *obj);
+void luaV_gettable (void);
+void luaV_settable (TObject *t, int mode);
+void luaV_getglobal (TaggedString *ts);
+void luaV_setglobal (TaggedString *ts);
+StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base);
+void luaV_closure (int nelems);
+
+#endif

lzio.c

@@ -0,0 +1,84 @@
+/*
+** $Id: lzio.c,v 1.2 1997/11/21 19:00:46 roberto Exp roberto $
+** a generic input stream interface
+** See Copyright Notice in lua.h
+*/
+
+
+
+#include <stdio.h>
+#include <string.h>
+
+#include "lzio.h"
+
+
+
+/* ----------------------------------------------------- memory buffers --- */
+
+static int zmfilbuf (ZIO* z)
+{
+ return EOZ;
+}
+
+ZIO* zmopen (ZIO* z, char* b, int size, char *name)
+{
+ if (b==NULL) return NULL;
+ z->n=size;
+ z->p= (unsigned char *)b;
+ z->filbuf=zmfilbuf;
+ z->u=NULL;
+ z->name=name;
+ return z;
+}
+
+/* ------------------------------------------------------------ strings --- */
+
+ZIO* zsopen (ZIO* z, char* s, char *name)
+{
+ if (s==NULL) return NULL;
+ return zmopen(z,s,strlen(s),name);
+}
+
+/* -------------------------------------------------------------- FILEs --- */
+
+static int zffilbuf (ZIO* z)
+{
+ int n=fread(z->buffer,1,ZBSIZE,z->u);
+ if (n==0) return EOZ;
+ z->n=n-1;
+ z->p=z->buffer;
+ return *(z->p++);
+}
+
+
+ZIO* zFopen (ZIO* z, FILE* f, char *name)
+{
+ if (f==NULL) return NULL;
+ z->n=0;
+ z->p=z->buffer;
+ z->filbuf=zffilbuf;
+ z->u=f;
+ z->name=name;
+ return z;
+}
+
+
+/* --------------------------------------------------------------- read --- */
+int zread (ZIO *z, void *b, int n)
+{
+  while (n) {
+    int m;
+    if (z->n == 0) {
+      if (z->filbuf(z) == EOZ)
+        return n;  /* retorna quantos faltaram ler */
+      zungetc(z);  /* poe o resultado de filbuf no buffer */
+    }
+    m = (n <= z->n) ? n : z->n;  /* minimo de n e z->n */
+    memcpy(b, z->p, m);
+    z->n -= m;
+    z->p += m;
+    b = (char *)b + m;
+    n -= m;
+  }
+  return 0;
+}

lzio.h

@@ -0,0 +1,50 @@
+/*
+** $Id: lzio.h,v 1.3 1997/12/22 20:57:18 roberto Exp roberto $
+** Buffered streams
+** See Copyright Notice in lua.h
+*/
+
+
+#ifndef lzio_h
+#define lzio_h
+
+#include <stdio.h>
+
+
+
+/* For Lua only */
+#define zFopen	luaZ_Fopen
+#define zsopen	luaZ_sopen
+#define zmopen	luaZ_mopen
+#define zread	luaZ_read
+
+#define EOZ	(-1)			/* end of stream */
+
+typedef struct zio ZIO;
+
+ZIO* zFopen (ZIO* z, FILE* f, char *name);		/* open FILEs */
+ZIO* zsopen (ZIO* z, char* s, char *name);		/* string */
+ZIO* zmopen (ZIO* z, char* b, int size, char *name);	/* memory */
+
+int zread (ZIO* z, void* b, int n);	/* read next n bytes */
+
+#define zgetc(z)	(--(z)->n>=0 ? ((int)*(z)->p++): (z)->filbuf(z))
+#define zungetc(z)	(++(z)->n,--(z)->p)
+#define zname(z)	((z)->name)
+
+
+/* --------- Private Part ------------------ */
+
+#define ZBSIZE	256			/* buffer size */
+
+struct zio {
+ int n;					/* bytes still unread */
+ unsigned char* p;			/* current position in buffer */
+ int (*filbuf)(ZIO* z);
+ void* u;				/* additional data */
+ char *name;
+ unsigned char buffer[ZBSIZE];		/* buffer */
+};
+
+
+#endif

makefile

@@ -1,53 +1,124 @@
-# $Id: makefile,v 1.5 1994/01/10 19:49:56 roberto Exp celes $
+#
+## $Id: makefile,v 1.12 1998/05/27 13:03:40 roberto Exp roberto $
+## Makefile
+## See Copyright Notice in lua.h
+#
+
+
+#CONFIGURATION
+
+# define (undefine) POPEN if your system (does not) support piped I/O
+#
+# define (undefine) _POSIX_SOURCE if your system is (not) POSIX compliant
+#
+# define (undefine) OLD_ANSI if your system does NOT have some new ANSI
+#   facilities (e.g. strerror, locale.h, memmove). Although they are ANSI,
+#   SunOS does not comply; so, add "-DOLD_ANSI" on SunOS
+#
+# define LUA_COMPAT2_5 if yous system does need to be compatible with
+# version 2.5 (or older)
+#
+# define LUA_NUM_TYPE if you need numbers to be different from double
+
+CONFIG = -DPOPEN -D_POSIX_SOURCE
+#CONFIG = -DLUA_COMPAT2_5 -DOLD_ANSI -DDEBUG
+
+
 # Compilation parameters
 CC = gcc
-CFLAGS = -I/usr/5include -Wall -O2
+CWARNS = -Wall -Wmissing-prototypes -Wshadow -pedantic -Wpointer-arith -Wcast-align -Waggregate-return
+CFLAGS = $(CONFIG) $(CWARNS) -ansi -O2
+
 
 AR = ar
 ARFLAGS	= rvl
 
+
 # Aplication modules
-LUAMOD =	\
-	y.tab 	\
-	lex	\
-	opcode	\
-	hash	\
-	table	\
-	inout	\
-	tree
+LUAOBJS = \
+	lapi.o \
+	lauxlib.o \
+	lbuffer.o \
+	lbuiltin.o \
+	ldo.o \
+	lfunc.o \
+	lgc.o \
+	llex.o \
+	lmem.o \
+	lobject.o \
+	lparser.o \
+	lstate.o \
+	lstring.o \
+	ltable.o \
+	ltm.o \
+	lvm.o \
+	lundump.o \
+	lzio.o
 
-LIBMOD = 	\
-	iolib	\
-	strlib	\
-	mathlib
+LIBOBJS = 	\
+	liolib.o \
+	lmathlib.o \
+	lstrlib.o
 
-LUAOBJS	= $(LUAMOD:%=%.o)
 
-LIBOBJS	= $(LIBMOD:%=%.o)
+lua : lua.o liblua.a liblualib.a
+	$(CC) $(CFLAGS) -o $@ lua.o -L. -llua -llualib -lm
 
-lua : lua.o lua.a lualib.a
-	$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
-
-lua.a : y.tab.c $(LUAOBJS)
-	$(AR) $(ARFLAGS) $@  $?
-	ranlib lua.a
-
-lualib.a : $(LIBOBJS)
+liblua.a : $(LUAOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib $@
 
-.KEEP_STATE:
+liblualib.a : $(LIBOBJS)
+	$(AR) $(ARFLAGS) $@  $?
+	ranlib $@
 
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
-%.o	: %.c
-	$(CC) $(CFLAGS) -c -o $@ $<
+
+clear	:
+	rcsclean
+	rm -f *.o
+	rm -f
+	co lua.h lualib.h luadebug.h
 
 
-y.tab.c : lua.stx exscript
-	yacc -d lua.stx ; ex y.tab.c <exscript
-
-% : RCS/%,v
+%.h : RCS/%.h,v
 	co $@
 
+%.c : RCS/%.c,v
+	co $@
+
+
+lapi.o: lapi.c lapi.h lua.h lobject.h lauxlib.h ldo.h lstate.h lfunc.h \
+ lgc.h lmem.h lstring.h ltable.h ltm.h luadebug.h lvm.h
+lauxlib.o: lauxlib.c lauxlib.h lua.h luadebug.h
+lbuffer.o: lbuffer.c lauxlib.h lua.h lmem.h lstate.h lobject.h
+lbuiltin.o: lbuiltin.c lapi.h lua.h lobject.h lauxlib.h lbuiltin.h \
+ ldo.h lstate.h lfunc.h lmem.h lstring.h ltable.h ltm.h lundump.h \
+ lzio.h
+ldo.o: ldo.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
+ lparser.h lzio.h ltm.h luadebug.h lundump.h lvm.h
+lfunc.o: lfunc.c lfunc.h lobject.h lua.h lmem.h lstate.h
+lgc.o: lgc.c ldo.h lobject.h lua.h lstate.h lfunc.h lgc.h lmem.h \
+ lstring.h ltable.h ltm.h
+liolib.o: liolib.c lauxlib.h lua.h luadebug.h lualib.h
+llex.o: llex.c lauxlib.h lua.h llex.h lobject.h lzio.h lmem.h \
+ lparser.h lstate.h lstring.h luadebug.h
+lmathlib.o: lmathlib.c lauxlib.h lua.h lualib.h
+lmem.o: lmem.c lmem.h lstate.h lobject.h lua.h
+lobject.o: lobject.c lobject.h lua.h
+lparser.o: lparser.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h \
+ llex.h lzio.h lmem.h lopcodes.h lparser.h lstring.h luadebug.h
+lstate.o: lstate.c lbuiltin.h ldo.h lobject.h lua.h lstate.h lfunc.h \
+ lgc.h llex.h lzio.h lmem.h lstring.h ltable.h ltm.h
+lstring.o: lstring.c lmem.h lobject.h lua.h lstate.h lstring.h
+lstrlib.o: lstrlib.c lauxlib.h lua.h lualib.h
+ltable.o: ltable.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltable.h
+ltm.o: ltm.c lauxlib.h lua.h lmem.h lobject.h lstate.h ltm.h
+lua.o: lua.c lua.h luadebug.h lualib.h
+lundump.o: lundump.c lauxlib.h lua.h lfunc.h lobject.h lmem.h \
+ lstring.h lundump.h lzio.h
+lvm.o: lvm.c lauxlib.h lua.h ldo.h lobject.h lstate.h lfunc.h lgc.h \
+ lmem.h lopcodes.h lstring.h ltable.h ltm.h luadebug.h lvm.h
+lzio.o: lzio.c lzio.h

mathlib.c

@@ -1,235 +0,0 @@
-/*
-** mathlib.c
-** Mathematics library to LUA
-*/
-
-char *rcs_mathlib="$Id: $";
-
-#include <stdio.h>		/* NULL */
-#include <math.h>
-
-#include "lua.h"
-
-#define TODEGREE(a) ((a)*180.0/3.14159)
-#define TORAD(a)    ((a)*3.14159/180.0)
-
-static void math_abs (void)
-{
- double d;
- 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(TORAD(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(TORAD(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(TORAD(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 (TODEGREE(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 (TODEGREE(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 (TODEGREE(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);
-}

mathlib.h

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

mm.h

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

opcode.h

@@ -1,164 +0,0 @@
-/*
-** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
-*/
-
-#ifndef opcode_h
-#define opcode_h
-
-#ifndef STACKGAP
-#define STACKGAP	128
-#endif 
-
-#ifndef real
-#define real float
-#endif
-
-#define FIELDS_PER_FLUSH 40
-
-typedef unsigned char  Byte;
-
-typedef unsigned short Word;
-
-typedef signed long  Long;
-
-typedef union
-{
- struct {char c1; char c2;} m;
- Word w;
-} CodeWord;
-
-typedef union
-{
- struct {char c1; char c2; char c3; char c4;} m;
- float f;
-} CodeFloat;
-
-typedef enum 
-{ 
- 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,
- STORELIST0,
- STORELIST,
- STORERECORD,
- 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 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
-{
- 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_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)))
-
-#define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
-#define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
-                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
- 
-
-
-/* Exported functions */
-int     lua_execute   (Byte *pc);
-void    lua_markstack (void);
-char   *lua_strdup (char *l);
-
-void    lua_setinput   (Input fn);	/* from "lex.c" module */
-char   *lua_lasttext   (void);		/* from "lex.c" module */
-int     lua_parse      (void); 		/* from "lua.stx" module */
-void    lua_type       (void);
-void 	lua_obj2number (void);
-void 	lua_print      (void);
-void 	lua_internaldofile (void);
-void 	lua_internaldostring (void);
-void    lua_travstack (void (*fn)(Object *));
-
-#endif

strlib.c

@@ -1,135 +0,0 @@
-/*
-** strlib.c
-** String library to LUA
-*/
-
-char *rcs_strlib="$Id: strlib.c,v 1.1 1993/12/17 18:41:19 celes Exp celes $";
-
-#include <stdlib.h>
-#include <string.h>
-#include <ctype.h>
-
-#include "mm.h"
-
-
-#include "lua.h"
-
-/*
-** Return the position of the first caracter of a substring into a string
-** LUA interface:
-**			n = strfind (string, substring)
-*/
-static void str_find (void)
-{
- char *s1, *s2, *f;
- lua_Object o1 = lua_getparam (1);
- lua_Object o2 = lua_getparam (2);
- if (!lua_isstring(o1) || !lua_isstring(o2))
- { lua_error ("incorrect arguments to function `strfind'"); return; }
- s1 = lua_getstring(o1);
- s2 = lua_getstring(o2);
- f = strstr(s1,s2);
- if (f != NULL)
-  lua_pushnumber (f-s1+1);
- else
-  lua_pushnil();
-}
-
-/*
-** 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_error ("incorrect arguments to function `strsub'"); return; }
- if (o3 != NULL && !lua_isnumber(o3))
- { lua_error ("incorrect third argument to function `strsub'"); return; }
- s = lua_copystring(o1);
- start = lua_getnumber (o2);
- end = o3 == NULL ? strlen(s) : 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);
-}

strlib.h

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

table.c

@@ -1,309 +0,0 @@
-/*
-** table.c
-** Module to control static tables
-*/
-
-char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
-
-#include <stdlib.h>
-#include <string.h>
-
-#include "mm.h"
-
-#include "opcode.h"
-#include "tree.h"
-#include "hash.h"
-#include "inout.h"
-#include "table.h"
-#include "lua.h"
-
-#define streq(s1,s2)	(s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0)
-
-#define BUFFER_BLOCK 256
-
-Symbol *lua_table;
-static Word lua_ntable = 0;
-static Word lua_maxsymbol = 0;
-
-char **lua_constant;
-static Word lua_nconstant = 0;
-static Word lua_maxconstant = 0;
-
-
-
-#define MAXFILE 	20
-char  		       *lua_file[MAXFILE];
-int      		lua_nfile;
-
-/* Variables to controll garbage collection */
-#define GARBAGE_BLOCK 256
-Word lua_block=GARBAGE_BLOCK; /* when garbage collector will be called */
-Word lua_nentity;   /* counter of new entities (strings and arrays) */
-
-
-/*
-** Initialise symbol table with internal functions
-*/
-static void lua_initsymbol (void)
-{
- int n;
- lua_maxsymbol = BUFFER_BLOCK;
- lua_table = (Symbol *) calloc(lua_maxsymbol, sizeof(Symbol));
- if (lua_table == NULL)
- {
-  lua_error ("symbol table: not enough memory");
-  return;
- }
- n = lua_findsymbol("type"); 
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_type;
- n = lua_findsymbol("tonumber");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_obj2number;
- n = lua_findsymbol("next");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_next;
- n = lua_findsymbol("nextvar");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_nextvar;
- n = lua_findsymbol("print");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_print;
- n = lua_findsymbol("dofile");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
- n = lua_findsymbol("dostring");
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
-}
-
-
-/*
-** Initialise constant table with pre-defined constants
-*/
-void lua_initconstant (void)
-{
- lua_maxconstant = BUFFER_BLOCK;
- lua_constant = (char **) calloc(lua_maxconstant, sizeof(char *));
- if (lua_constant == NULL)
- {
-  lua_error ("constant table: not enough memory");
-  return;
- }
- lua_findconstant("mark");
- lua_findconstant("nil");
- lua_findconstant("number");
- lua_findconstant("string");
- lua_findconstant("table");
- lua_findconstant("function");
- lua_findconstant("cfunction");
- lua_findconstant("userdata");
-}
-
-/*
-** Given a name, search it at symbol table and return its index. If not
-** found, allocate it.
-** On error, return -1.
-*/
-int lua_findsymbol (char *s)
-{
- char *n; 
- if (lua_table == NULL)
-  lua_initsymbol(); 
- n = lua_varcreate(s);
- if (n == NULL)
- {
-  lua_error ("create symbol: not enough memory");
-  return -1;
- }
- if (indexstring(n) == UNMARKED_STRING)
- {
-  if (lua_ntable == lua_maxsymbol)
-  {
-   lua_maxsymbol *= 2;
-   if (lua_maxsymbol > MAX_WORD)
-   {
-    lua_error("symbol table overflow");
-    return -1;
-   }
-   lua_table = (Symbol *)realloc(lua_table, lua_maxsymbol*sizeof(Symbol));
-   if (lua_table == NULL)
-   {
-    lua_error ("symbol table: not enough memory");
-    return -1;
-   }
-  }
-  indexstring(n) = lua_ntable;
-  s_tag(lua_ntable) = T_NIL;
-  lua_ntable++;
- }
- return indexstring(n);
-}
-
-
-/*
-** Given a name, search it at constant table and return its index. If not
-** found, allocate it.
-** On error, return -1.
-*/
-int lua_findconstant (char *s)
-{
- char *n;
- if (lua_constant == NULL)
-  lua_initconstant();
- n = lua_constcreate(s);
- if (n == NULL)
- {
-  lua_error ("create constant: not enough memory");
-  return -1;
- }
- if (indexstring(n) == UNMARKED_STRING)
- {
-  if (lua_nconstant == lua_maxconstant)
-  {
-   lua_maxconstant *= 2;
-   if (lua_maxconstant > MAX_WORD)
-   {
-    lua_error("constant table overflow");
-    return -1;
-   }
-   lua_constant = (char**)realloc(lua_constant,lua_maxconstant*sizeof(char*));
-   if (lua_constant == NULL)
-   {
-    lua_error ("constant table: not enough memory");
-    return -1;
-   }
-  }
-  indexstring(n) = lua_nconstant;
-  lua_constant[lua_nconstant] = n;
-  lua_nconstant++;
- }
- return indexstring(n);
-}
-
-
-/*
-** Traverse symbol table objects
-*/
-void lua_travsymbol (void (*fn)(Object *))
-{
- int i;
- for (i=0; i<lua_ntable; i++)
-  fn(&s_object(i));
-}
-
-
-/*
-** Mark an object if it is a string or a unmarked array.
-*/
-void lua_markobject (Object *o)
-{
- if (tag(o) == T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
-  indexstring(svalue(o)) = MARKED_STRING;
- else if (tag(o) == T_ARRAY)
-  lua_hashmark (avalue(o));
-}
-
-
-/*
-** Garbage collection. 
-** Delete all unused strings and arrays.
-*/
-void lua_pack (void)
-{
- /* mark stack strings */
- lua_travstack(lua_markobject);
- 
- /* mark symbol table strings */
- lua_travsymbol(lua_markobject);
-
- lua_strcollector();
- lua_hashcollector();
-
- lua_nentity = 0;      /* reset counter */
-} 
-
-
-/*
-** If the string isn't allocated, allocate a new string at string tree.
-*/
-char *lua_createstring (char *s)
-{
- if (s == NULL) return NULL;
- 
- if (lua_nentity == lua_block)
-  lua_pack ();
- lua_nentity++;
- return lua_strcreate(s);
-}
-
-
-/*
-** 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;
-}
-
-/*
-** Delete a file from file stack
-*/
-int lua_delfile (void)
-{
- lua_nfile--; 
- return 1;
-}
-
-/*
-** Return the last file name set.
-*/
-char *lua_filename (void)
-{
- return lua_file[lua_nfile-1];
-}
-
-/*
-** Internal function: return next global variable
-*/
-void lua_nextvar (void)
-{
- char *varname, *next;
- 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)
- {
-  varname = 0;
- }
- else if (tag(o) != T_STRING) 
- { 
-  lua_error ("incorrect argument to function `nextvar'"); 
-  return;
- }
- else
- {
-  varname = svalue(o);
- }
- next = lua_varnext(varname);
- if (next == NULL)
- {
-  lua_pushnil();
-  lua_pushnil();
- }
- else
- {
-  Object name;
-  tag(&name) = T_STRING;
-  svalue(&name) = next;
-  if (lua_pushobject (&name)) return;
-  if (lua_pushobject (&s_object(indexstring(next)))) return;
- }
-}

table.h

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

tree.c

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

tree.h

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