useless "#include math.h"

small changes.

exscript

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

fallback.c

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

fallback.h

@@ -0,0 +1,34 @@
+/*
+** $Id: fallback.h,v 1.9 1995/10/09 13:14:29 roberto Exp roberto $
+*/
+ 
+#ifndef fallback_h
+#define fallback_h
+
+#include "opcode.h"
+
+extern struct FB {
+  char *kind;
+  Object function;
+  int nParams;
+  int nResults;
+} luaI_fallBacks[];
+
+#define FB_ERROR  0
+#define FB_INDEX  1
+#define FB_GETTABLE  2
+#define FB_ARITH  3
+#define FB_ORDER  4
+#define FB_CONCAT  5
+#define FB_SETTABLE  6
+#define FB_GC 7
+#define FB_FUNCTION 8
+
+void luaI_setfallback (void);
+int luaI_lock (Object *object);
+Object *luaI_getlocked (int ref);
+void luaI_travlock (int (*fn)(Object *));
+char *luaI_travfallbacks (int (*fn)(Object *));
+
+#endif
+

func.c

@@ -0,0 +1,79 @@
+#include <stdio.h>
+
+#include "luadebug.h"
+#include "table.h"
+#include "mem.h"
+#include "func.h"
+#include "opcode.h"
+
+static TFunc *function_root = NULL;
+
+
+/*
+** Insert function in list for GC
+*/
+void luaI_insertfunction (TFunc *f)
+{
+  lua_pack();
+  f->next = function_root;
+  function_root = f;
+  f->marked = 0;
+}
+
+
+/*
+** Free function
+*/
+static void freefunc (TFunc *f)
+{
+  luaI_free (f->code);
+  luaI_free (f);
+}
+
+/*
+** Garbage collection function.
+** This function traverse the function list freeing unindexed functions
+*/
+Long luaI_funccollector (void)
+{
+  TFunc *curr = function_root;
+  TFunc *prev = NULL;
+  Long counter = 0;
+  while (curr)
+  {
+    TFunc *next = curr->next;
+    if (!curr->marked)
+    {
+      if (prev == NULL)
+        function_root = next;
+      else
+        prev->next = next;
+      freefunc (curr);
+      ++counter;
+    }
+    else
+    {
+      curr->marked = 0;
+      prev = curr;
+    } 
+    curr = next;
+  }
+  return counter;
+}
+
+
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined)
+{
+  Object *f = luaI_Address(func);
+  if (f->tag == LUA_T_MARK || f->tag == LUA_T_FUNCTION)
+  {
+    *filename = f->value.tf->fileName;
+    *linedefined = f->value.tf->lineDefined;
+  }
+  else if (f->tag == LUA_T_CMARK || f->tag == LUA_T_CFUNCTION)
+  {
+    *filename = "(C)";
+    *linedefined = -1;
+  }
+}
+

func.h

@@ -0,0 +1,24 @@
+#ifndef func_h
+#define func_h
+
+#include "types.h"
+#include "lua.h"
+
+/*
+** Header para funcoes.
+*/
+typedef struct TFunc
+{
+  struct TFunc	*next;
+  char		marked;
+  int		size;
+  Byte		*code;
+  int		lineDefined;
+  char		*fileName;
+} TFunc;
+
+Long luaI_funccollector (void);
+void luaI_insertfunction (TFunc *f);
+
+
+#endif

hash.c

@@ -1,135 +1,146 @@
 /*
 ** 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 $";
+char *rcs_hash="$Id: hash.c,v 2.25 1995/05/02 18:43:03 roberto Exp $";
 
 #include <string.h>
-#include <stdlib.h>
-
-#include "mm.h"
 
+#include "mem.h"
 #include "opcode.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
 #include "lua.h"
 
-#define streq(s1,s2)	(strcmp(s1,s2)==0)
+#define streq(s1,s2)	(s1 == s2 || (*(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 nuse(t)		((t)->nuse)
-#define list(t,i)	((t)->list[i])
 #define markarray(t)    ((t)->mark)
-#define ref_tag(n)	(tag(&(n)->ref))
+#define nodevector(t)	((t)->node)
-#define ref_nvalue(n)	(nvalue(&(n)->ref))
+#define node(t,i)	(&(t)->node[i])
-#define ref_svalue(n)	(svalue(&(n)->ref))
+#define ref(n)		(&(n)->ref)
+#define val(n)		(&(n)->val)
 
 
-typedef struct ArrayList
+#define REHASH_LIMIT	0.70	/* avoid more than this % full */
+
+
+static Hash *listhead = NULL;
+
+
+
+/* hash dimensions values */
+static Word dimensions[] = 
+ {3, 5, 7, 11, 23, 47, 97, 197, 397, 797, 1597, 3203, 6421,
+  12853, 25717, 51437, 65521, 0};  /* 65521 == last prime < MAX_WORD */
+
+static Word redimension (Word nhash)
 {
- Hash *array;
+ Word i;
- struct ArrayList *next;
+ for (i=0; dimensions[i]!=0; i++)
-} 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;
+  if (dimensions[i] > nhash)
-  char *name = svalue(ref);
+   return dimensions[i];
-  for (h=0; *name!=0; name++)		/* interpret name as binary number */
+ }
+ lua_error("table overflow");
+ return 0;  /* to avoid warnings */
+}
+
+static Word hashindex (Hash *t, Object *ref)		/* hash function */
+{
+ switch (tag(ref))
+ {
+  case LUA_T_NIL:
+   lua_error ("unexpected type to index table");
+   return -1;  /* UNREACHEABLE */
+  case LUA_T_NUMBER:
+   return (((Word)nvalue(ref))%nhash(t));
+  case LUA_T_STRING:
   {
-   h <<= 8;
+   unsigned long h = tsvalue(ref)->hash;
-   h  += (unsigned char) *name;		/* avoid sign extension */
+   if (h == 0)
-   h  %= nhash(t);			/* make it a valid index */
+   {
+     char *name = svalue(ref);
+     while (*name)
+       h = ((h<<5)-h)^(unsigned char)*(name++);
+     tsvalue(ref)->hash = h;
+   }
+   return (Word)h%nhash(t);  /* make it a valid index */
   }
-  return h;
+  case LUA_T_FUNCTION:
- }
+   return (((IntPoint)ref->value.tf)%nhash(t));
- else
+  case LUA_T_CFUNCTION:
- {
+   return (((IntPoint)fvalue(ref))%nhash(t));
-  lua_reportbug ("unexpected type to index table");
+  case LUA_T_ARRAY:
-  return -1;
+   return (((IntPoint)avalue(ref))%nhash(t));
+  default:  /* user data */
+   return (((IntPoint)uvalue(ref))%nhash(t));
  }
 }
 
-static Node *present(Hash *t, Object *ref, int h)
+Bool lua_equalObj (Object *t1, Object *t2)
 {
- Node *n=NULL, *p;
+  if (tag(t1) != tag(t2)) return 0;
- if (tag(ref) == T_NUMBER)
+  switch (tag(t1))
- {
+  {
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
+    case LUA_T_NIL: return 1;
-   if (ref_tag(n) == T_NUMBER && nvalue(ref) == ref_nvalue(n)) break;
+    case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
- }  
+    case LUA_T_STRING: return streq(svalue(t1), svalue(t2));
- else if (tag(ref) == T_STRING)
+    case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
- {
+    case LUA_T_FUNCTION: return t1->value.tf == t2->value.tf;
-  for (p=NULL,n=list(t,h); n!=NULL; p=n, n=n->next)
+    case LUA_T_CFUNCTION: return fvalue(t1) == fvalue(t2);
-   if (ref_tag(n) == T_STRING && streq(svalue(ref),ref_svalue(n))) break;
+    default: return uvalue(t1) == uvalue(t2);
- }  
+  }
- 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)
+static Word present (Hash *t, Object *ref)
 { 
- while (n)
+ Word h = hashindex(t, ref);
+ while (tag(ref(node(t, h))) != LUA_T_NIL)
  {
-  Node *next = n->next;
+  if (lua_equalObj(ref, ref(node(t, h))))
-  free (n);
+    return h;
-  n = next;
+  h = (h+1) % nhash(t);
  }
+ return h;
+}
+
+
+/*
+** Alloc a vector node 
+*/
+static Node *hashnodecreate (Word nhash)
+{
+ Word i;
+ Node *v = newvector (nhash, Node);
+ for (i=0; i<nhash; i++)
+   tag(ref(&v[i])) = LUA_T_NIL;
+ return v;
 }
 
 /*
 ** Create a new hash. Return the hash pointer or NULL on error.
 */
-static Hash *hashcreate (unsigned int nhash)
+static Hash *hashcreate (Word nhash)
 {
- Hash *t = new (Hash);
+ Hash *t = new(Hash);
- if (t == NULL)
+ nhash = redimension((Word)((float)nhash/REHASH_LIMIT));
- {
+ nodevector(t) = hashnodecreate(nhash);
-  lua_error ("not enough memory");
-  return NULL;
- }
  nhash(t) = nhash;
+ nuse(t) = 0;
  markarray(t) = 0;
- nodelist(t) = newvector (nhash, Node*);
- if (nodelist(t) == NULL)
- {
-  lua_error ("not enough memory");
-  return NULL;
- }
  return t;
 }
 
 /*
 ** Delete a hash
 */
-static void hashdelete (Hash *h)
+static void hashdelete (Hash *t)
 {
- int i;
+ luaI_free (nodevector(t));
- for (i=0; i<nhash(h); i++)
+ luaI_free(t);
-  freelist (list(h,i));
- free (nodelist(h));
- free(h);
 }
 
 
@@ -140,12 +151,12 @@ void lua_hashmark (Hash *h)
 {
  if (markarray(h) == 0)
  {
-  int i;
+  Word i;
   markarray(h) = 1;
   for (i=0; i<nhash(h); i++)
   {
-   Node *n;
+   Node *n = node(h,i);
-   for (n = list(h,i); n != NULL; n = n->next)
+   if (tag(ref(n)) != LUA_T_NIL)
    {
     lua_markobject(&n->ref);
     lua_markobject(&n->val);
@@ -154,91 +165,124 @@ void lua_hashmark (Hash *h)
  } 
 }
 
+
+static void call_fallbacks (void)
+{
+  Hash *curr_array;
+  Object t;
+  tag(&t) = LUA_T_ARRAY;
+  for (curr_array = listhead; curr_array; curr_array = curr_array->next)
+    if (markarray(curr_array) != 1)
+    {
+      avalue(&t) = curr_array;
+      luaI_gcFB(&t);
+    }
+  tag(&t) = LUA_T_NIL;
+  luaI_gcFB(&t);  /* end of list */
+}
+
+ 
 /*
 ** Garbage collection to arrays
 ** Delete all unmarked arrays.
 */
-void lua_hashcollector (void)
+Long lua_hashcollector (void)
 {
- ArrayList *curr = listhead, *prev = NULL;
+ Hash *curr_array = listhead, *prev = NULL;
- while (curr != NULL)
+ Long counter = 0;
+ call_fallbacks();
+ while (curr_array != NULL)
  {
-  ArrayList *next = curr->next;
+  Hash *next = curr_array->next;
-  if (markarray(curr->array) != 1)
+  if (markarray(curr_array) != 1)
   {
    if (prev == NULL) listhead = next;
    else              prev->next = next;
-   hashdelete(curr->array);
+   hashdelete(curr_array);
-   free(curr);
+   ++counter;
   }
   else
   {
-   markarray(curr->array) = 0;
+   markarray(curr_array) = 0;
-   prev = curr;
+   prev = curr_array;
   }
-  curr = next;
+  curr_array = next;
  }
+ return counter;
 }
 
 
 /*
 ** Create a new array
-** This function insert the new array at array list. It also
+** This function inserts the new array in the array list. It also
-** execute garbage collection if the number of array created
+** executes garbage collection if the number of arrays created
 ** exceed a pre-defined range.
 */
-Hash *lua_createarray (int nhash)
+Hash *lua_createarray (Word nhash)
 {
- ArrayList *new = new(ArrayList);
+ Hash *array;
- if (new == NULL)
+ lua_pack();
- {
+ array = hashcreate(nhash);
-  lua_error ("not enough memory");
+ array->next = listhead;
-  return NULL;
+ listhead = array;
- }
+ return array;
- 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;
+** Re-hash
- listhead = new;
+*/
- return new->array;
+static void rehash (Hash *t)
+{
+ Word i;
+ Word   nold = nhash(t);
+ Node *vold = nodevector(t);
+ nhash(t) = redimension(nhash(t));
+ nodevector(t) = hashnodecreate(nhash(t));
+ for (i=0; i<nold; i++)
+ {
+  Node *n = vold+i;
+  if (tag(ref(n)) != LUA_T_NIL && tag(val(n)) != LUA_T_NIL)
+   *node(t, present(t, ref(n))) = *n;  /* copy old node to new hahs */
+ }
+ luaI_free(vold);
+}
+
+/*
+** If the hash node is present, return its pointer, otherwise return
+** null.
+*/
+Object *lua_hashget (Hash *t, Object *ref)
+{
+ Word h = present(t, ref);
+ if (tag(ref(node(t, h))) != LUA_T_NIL) return val(node(t, h));
+ else return NULL;
 }
 
 
 /*
 ** If the hash node is present, return its pointer, otherwise create a new
 ** node for the given reference and also return its pointer.
-** On error, return NULL.
 */
 Object *lua_hashdefine (Hash *t, Object *ref)
 {
- int   h;
+ Word   h;
  Node *n;
- h = head (t, ref);
+ h = present(t, ref);
- if (h < 0) return NULL; 
+ n = node(t, h);
- 
+ if (tag(ref(n)) == LUA_T_NIL)
- n = present(t, ref, h);
- if (n == NULL)
  {
-  n = new(Node);
+  nuse(t)++;
-  if (n == NULL)
+  if ((float)nuse(t) > (float)nhash(t)*REHASH_LIMIT)
   {
-   lua_error ("not enough memory");
+   rehash(t);
-   return NULL;
+   h = present(t, ref);
+   n = node(t, h);
   }
-  n->ref = *ref;
+  *ref(n) = *ref;
-  tag(&n->val) = T_NIL;
+  tag(val(n)) = LUA_T_NIL;
-  n->next = list(t,h);			/* link node to head of list */
-  list(t,h) = n;
  }
- return (&n->val);
+ return (val(n));
 }
 
 
@@ -248,98 +292,44 @@ Object *lua_hashdefine (Hash *t, Object *ref)
 ** in the hash.
 ** This function pushs the element value and its reference to the stack.
 */
-static void firstnode (Hash *a, int h)
+static void hashnext (Hash *t, Word i)
 {
- if (h < nhash(a))
+ if (i >= nhash(t))
  {
-  int i;
+  lua_pushnil(); lua_pushnil();
-  for (i=h; i<nhash(a); i++)
+  return;
+ }
+ while (tag(ref(node(t,i))) == LUA_T_NIL || tag(val(node(t,i))) == LUA_T_NIL)
+ {
+  if (++i >= nhash(t))
   {
-   if (list(a,i) != NULL)
+   lua_pushnil(); lua_pushnil();
-   {
+   return;
-    if (tag(&list(a,i)->val) != T_NIL)
-    {
-     lua_pushobject (&list(a,i)->ref);
-     lua_pushobject (&list(a,i)->val);
-     return;
-    }
-    else
-    {
-     Node *next = list(a,i)->next;
-     while (next != NULL && tag(&next->val) == T_NIL) next = next->next;
-     if (next != NULL)
-     {
-      lua_pushobject (&next->ref);
-      lua_pushobject (&next->val);
-      return;
-     }
-    }
-   }
   }
  }
- lua_pushnil();
+ luaI_pushobject(ref(node(t,i)));
- lua_pushnil();
+ luaI_pushobject(val(node(t,i)));
 }
+
 void lua_next (void)
 {
- Hash   *a;
+ Hash   *t;
- Object *o = lua_getparam (1);
+ lua_Object o = lua_getparam(1);
- Object *r = lua_getparam (2);
+ lua_Object r = lua_getparam(2);
- if (o == NULL || r == NULL)
+ if (o == LUA_NOOBJECT || r == LUA_NOOBJECT)
- { lua_error ("too few arguments to function `next'"); return; }
+   lua_error ("too few arguments to function `next'");
- if (lua_getparam (3) != NULL)
+ if (lua_getparam(3) != LUA_NOOBJECT)
- { lua_error ("too many arguments to function `next'"); return; }
+   lua_error ("too many arguments to function `next'");
- if (tag(o) != T_ARRAY)
+ if (!lua_istable(o))
- { lua_error ("first argument of function `next' is not a table"); return; }
+   lua_error ("first argument of function `next' is not a table");
- a = avalue(o);
+ t = avalue(luaI_Address(o));
- if (tag(r) == T_NIL)
+ if (lua_isnil(r))
  {
-  firstnode (a, 0);
+  hashnext(t, 0);
-  return;
  }
  else
  {
-  int h = head (a, r);
+  Word h = present (t, luaI_Address(r));
-  if (h >= 0)
+  hashnext(t, h+1);
-  {
-   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

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

inout.c

@@ -2,50 +2,46 @@
 ** inout.c
 ** Provide function to realise the input/output function and debugger 
 ** facilities.
+** Also provides some predefined lua functions.
 */
 
-char *rcs_inout="$Id: inout.c,v 1.2 1993/12/22 21:15:16 roberto Exp celes $";
+char *rcs_inout="$Id: inout.c,v 2.24 1995/10/23 13:54:11 roberto Exp roberto $";
 
 #include <stdio.h>
+#include <stdlib.h>
 #include <string.h>
 
+#include "mem.h"
 #include "opcode.h"
 #include "hash.h"
 #include "inout.h"
 #include "table.h"
 #include "tree.h"
+#include "lua.h"
+
+
+#ifndef MAXFUNCSTACK
+#define MAXFUNCSTACK 100
+#endif
+
+#define MAXMESSAGE MAXFUNCSTACK*80
+
 
 /* Exported variables */
-int lua_linenumber;
+Word lua_linenumber;
-int lua_debug;
+Bool lua_debug = 0;
-int lua_debugline;
+char *lua_parsedfile;
 
-/* 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 fgetc (fp);
- return (c == EOF ? 0 : c);
 }
 
 /*
@@ -53,22 +49,32 @@ static int fileinput (void)
 */
 static int stringinput (void)
 {
- st++;
+ return *st++;
- return (*(st-1));
 }
 
 /*
 ** Function to open a file to be input unit. 
-** Return 0 on success or 1 on error.
+** Return 0 on success or error message on error.
 */
-int lua_openfile (char *fn)
+char *lua_openfile (char *fn)
 {
- lua_linenumber = 1;
  lua_setinput (fileinput);
- fp = fopen (fn, "r");
+ if (fn == NULL)
- if (fp == NULL) return 1;
+ {
- if (lua_addfile (fn)) return 1;
+   fp = stdin;
- return 0;
+   fn = "(stdin)";
+ }
+ else
+   fp = fopen (fn, "r");
+ if (fp == NULL)
+ {
+   static char buff[255];
+   sprintf(buff, "unable to open file `%.200s'", fn);
+   return buff;
+ }
+ lua_linenumber = 1;
+ lua_parsedfile = lua_constcreate(fn)->ts.str;
+ return NULL;
 }
 
 /*
@@ -76,9 +82,8 @@ int lua_openfile (char *fn)
 */
 void lua_closefile (void)
 {
- if (fp != NULL)
+ if (fp != NULL && fp != stdin)
  {
-  lua_delfile();
   fclose (fp);
   fp = NULL;
  }
@@ -87,17 +92,12 @@ void lua_closefile (void)
 /*
 ** Function to open a string to be input unit
 */
-int lua_openstring (char *s)
+void lua_openstring (char *s)
 {
- lua_linenumber = 1;
  lua_setinput (stringinput);
  st = s;
- {
+ lua_linenumber = 1;
-  char sn[64];
+ lua_parsedfile = lua_constcreate("(string)")->ts.str;
-  sprintf (sn, "String: %10.10s...", s);
-  if (lua_addfile (sn)) return 1;
- }
- return 0;
 }
 
 /*
@@ -105,74 +105,116 @@ int lua_openstring (char *s)
 */
 void lua_closestring (void)
 {
- lua_delfile();
+}
+
+ 
+/*
+** Internal function: do a string
+*/
+void lua_internaldostring (void)
+{
+ lua_Object obj = lua_getparam (1);
+ if (lua_isstring(obj) && !lua_dostring(lua_getstring(obj)))
+  lua_pushnumber(1);
+ else
+  lua_pushnil();
 }
 
 /*
-** Call user function to handle error messages, if registred. Or report error
+** Internal function: do a file
-** using standard function (fprintf).
 */
-void lua_error (char *s)
+void lua_internaldofile (void)
 {
- if (usererror != NULL) usererror (s);
+ lua_Object obj = lua_getparam (1);
- else			    fprintf (stderr, "lua: %s\n", s);
+ if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
+  lua_pushnumber(1);
+ else
+  lua_pushnil();
 }
  
 /*
-** Called to execute  SETFUNCTION opcode, this function pushs a function into
+** Internal function: print object values
-** function stack. Return 0 on success or 1 on error.
 */
-int lua_pushfunction (int file, int function)
+void lua_print (void)
 {
- if (nfuncstack >= MAXFUNCSTACK-1)
+ int i=1;
+ lua_Object obj;
+ while ((obj=lua_getparam (i++)) != LUA_NOOBJECT)
  {
-  lua_error ("function stack overflow");
+  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber(obj));
-  return 1;
+  else if (lua_isstring(obj))    printf("%s\n",lua_getstring(obj));
+  else if (lua_isfunction(obj))  printf("function: %p\n",(luaI_Address(obj))->value.tf);
+  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction(obj)
+);
+  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata(obj));
+  else if (lua_istable(obj))     printf("table: %p\n",avalue(luaI_Address(obj)));
+  else if (lua_isnil(obj))       printf("nil\n");
+  else                           printf("invalid value to print\n");
  }
- 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.
+** Internal function: return an object type.
 */
-void lua_reportbug (char *s)
+void luaI_type (void)
 {
- char msg[1024];
+  lua_Object o = lua_getparam(1);
- strcpy (msg, s);
+  int t;
- if (lua_debugline != 0)
+  if (o == LUA_NOOBJECT)
- {
+    lua_error("no parameter to function 'type'");
-  int i;
+  t = lua_type(o);
-  if (nfuncstack > 0)
+  switch (t)
   {
-   sprintf (strchr(msg,0), 
+    case LUA_T_NIL :
-         "\n\tin statement begining at line %d in function \"%s\" of file \"%s\"",
+      lua_pushliteral("nil");
-         lua_debugline, lua_varname(funcstack[nfuncstack-1].function),
+      break;
-  	 lua_file[funcstack[nfuncstack-1].file]);
+    case LUA_T_NUMBER :
-   sprintf (strchr(msg,0), "\n\tactive stack\n");
+      lua_pushliteral("number");
-   for (i=nfuncstack-1; i>=0; i--)
+      break;
-    sprintf (strchr(msg,0), "\t-> function \"%s\" of file \"%s\"\n", 
+    case LUA_T_STRING :
-                            lua_varname(funcstack[i].function),
+      lua_pushliteral("string");
-			    lua_file[funcstack[i].file]);
+      break;
+    case LUA_T_ARRAY :
+      lua_pushliteral("table");
+      break;
+    case LUA_T_FUNCTION :
+    case LUA_T_CFUNCTION :
+      lua_pushliteral("function");
+      break;
+    default :
+      lua_pushliteral("userdata");
+      break;
+  }
+  lua_pushnumber(t);
+}
+ 
+/*
+** Internal function: convert an object to a number
+*/
+void lua_obj2number (void)
+{
+  lua_Object o = lua_getparam(1);
+  if (lua_isnumber(o))
+    lua_pushobject(o);
+  else if (lua_isstring(o))
+  {
+    char c;
+    float f;
+    if (sscanf(lua_getstring(o),"%f %c",&f,&c) == 1)
+      lua_pushnumber(f);
+    else
+      lua_pushnil();
   }
   else
-  {
+    lua_pushnil();
-   sprintf (strchr(msg,0),
+}
-         "\n\tin statement begining at line %d of file \"%s\"", 
+
-         lua_debugline, lua_filename());
+
-  }
+void luaI_error (void)
- }
+{
- lua_error (msg);
+  char *s = lua_getstring(lua_getparam(1));
+  if (s == NULL) s = "(no message)";
+  lua_error(s);
 }
 

inout.h

@@ -1,21 +1,29 @@
 /*
-** $Id: $
+** $Id: inout.h,v 1.9 1995/05/16 17:23:58 roberto Exp roberto $
 */
 
 
 #ifndef inout_h
 #define inout_h
 
-extern int lua_linenumber;
+#include "types.h"
-extern int lua_debug;
-extern int lua_debugline;
 
-int  lua_openfile     (char *fn);
+
+extern Word lua_linenumber;
+extern Bool lua_debug;
+extern Word lua_debugline;
+extern char *lua_parsedfile;
+
+char *lua_openfile     (char *fn);
 void lua_closefile    (void);
-int  lua_openstring   (char *s);
+void lua_openstring   (char *s);
 void lua_closestring  (void);
-int  lua_pushfunction (int file, int function);
+
-void lua_popfunction  (void);
+void    lua_internaldofile (void);
-void lua_reportbug    (char *s);
+void    lua_internaldostring (void);
+void    lua_print      (void);
+void    luaI_type       (void);
+void    lua_obj2number (void);
+void	luaI_error     (void);
 
 #endif

iolib.c

@@ -3,64 +3,79 @@
 ** Input/output library to LUA
 */
 
-char *rcs_iolib="$Id: iolib.c,v 1.3 1994/03/28 15:14:02 celes Exp celes $";
+char *rcs_iolib="$Id: iolib.c,v 1.28 1995/11/10 17:55:48 roberto Exp roberto $";
 
-#include <stdlib.h>
-#include <string.h>
 #include <stdio.h>
 #include <ctype.h>
+#include <sys/types.h>
 #include <sys/stat.h>
-#ifdef __GNUC__
+#include <string.h>
-#include <floatingpoint.h>
+#include <time.h>
-#endif
+#include <stdlib.h>
-
-#include "mm.h"
 
 #include "lua.h"
+#include "luadebug.h"
+#include "lualib.h"
 
 static FILE *in=stdin, *out=stdout;
 
+
+#ifdef POPEN
+FILE *popen();
+int pclose();
+#else
+#define popen(x,y) NULL  /* that is, popen always fails */
+#define pclose(x)  (-1)
+#endif
+
+
+static void closeread (void)
+{
+  if (in != stdin)
+  {
+    if (pclose(in) == -1)
+      fclose(in);
+    in = stdin;
+  }
+}
+
+static void closewrite (void)
+{
+  if (out != stdout)
+  {
+    if (pclose(out) == -1)
+      fclose(out);
+    out = stdout;
+  }
+}
+
 /*
 ** Open a file to read.
 ** LUA interface:
 **			status = readfrom (filename)
 ** where:
 **			status = 1 -> success
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_readfrom (void)
 {
- lua_Object o = lua_getparam (1);
+ if (lua_getparam (1) == LUA_NOOBJECT)	
- if (o == NULL)			/* restore standart input */
+ { /* restore standart input */
- {
+  closeread();
-  if (in != stdin)
-  {
-   fclose (in);
-   in = stdin;
-  }
   lua_pushnumber (1);
  }
  else
  {
-  if (!lua_isstring (o))
+   char *s = lua_check_string(1, "readfrom");
-  {
+   FILE *fp = (*s == '|') ? popen(s+1, "r") : fopen(s, "r");
-   lua_error ("incorrect argument to function 'readfrom`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"r");
    if (fp == NULL)
-   {
+    lua_pushnil();
-    lua_pushnumber (0);
-   }
    else
    {
-    if (in != stdin) fclose (in);
+    closeread();
     in = fp;
     lua_pushnumber (1);
    }
-  }
  }
 }
 
@@ -71,41 +86,27 @@ static void io_readfrom (void)
 **			status = writeto (filename)
 ** where:
 **			status = 1 -> success
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_writeto (void)
 {
- lua_Object o = lua_getparam (1);
+ if (lua_getparam (1) == LUA_NOOBJECT)	/* restore standart output */
- if (o == NULL)			/* restore standart output */
  {
-  if (out != stdout)
+  closewrite();
-  {
-   fclose (out);
-   out = stdout;
-  }
   lua_pushnumber (1);
  }
  else
  {
-  if (!lua_isstring (o))
+   char *s = lua_check_string(1, "writeto");
-  {
+   FILE *fp = (*s == '|') ? popen(s+1,"w") : fopen(s,"w");
-   lua_error ("incorrect argument to function 'writeto`");
-   lua_pushnumber (0);
-  }
-  else
-  {
-   FILE *fp = fopen (lua_getstring(o),"w");
    if (fp == NULL)
-   {
+    lua_pushnil();
-    lua_pushnumber (0);
-   }
    else
    {
-    if (out != stdout) fclose (out);
+    closewrite();
     out = fp;
     lua_pushnumber (1);
    }
-  }
  }
 }
 
@@ -117,50 +118,90 @@ static void io_writeto (void)
 ** where:
 **			status = 2 -> success (already exist)
 **			status = 1 -> success (new file)
-**			status = 0 -> error
+**			status = nil -> error
 */
 static void io_appendto (void)
 {
- lua_Object o = lua_getparam (1);
+ char *s = lua_check_string(1, "appendto");
- if (o == NULL)			/* restore standart output */
+ struct stat st;
- {
+ int r = (stat(s, &st) == -1) ? 1 : 2;
-  if (out != stdout)
+ FILE *fp = fopen (s, "a");
-  {
+ if (fp == NULL)
-   fclose (out);
+  lua_pushnil();
-   out = stdout;
-  }
-  lua_pushnumber (1);
- }
  else
  {
-  if (!lua_isstring (o))
+  if (out != stdout) fclose (out);
-  {
+  out = fp;
-   lua_error ("incorrect argument to function 'appendto`");
+  lua_pushnumber (r);
-   lua_pushnumber (0);
-  }
-  else
-  {
-   int r;
-   FILE *fp;
-   struct stat st;
-   if (stat(lua_getstring(o), &st) == -1) r = 1;
-   else                                   r = 2;
-   fp = fopen (lua_getstring(o),"a");
-   if (fp == NULL)
-   {
-    lua_pushnumber (0);
-   }
-   else
-   {
-    if (out != stdout) fclose (out);
-    out = fp;
-    lua_pushnumber (r);
-   }
-  }
  }
 }
 
 
+static char getformat (char *f, int *just, int *m, int *n)
+{
+  int t;
+  switch (*f++)
+  {
+    case 's': case 'S':
+      t = 's';
+      break;
+    case 'f': case 'F': case 'g': case 'G': case 'e': case 'E':
+      t = 'f';
+      break;
+    case 'i': case 'I':
+      t = 'i';
+      break;
+    default:
+      t = 0;  /* to avoid compiler warnings */
+      lua_arg_error("read/write (format)");
+  }
+  *just = (*f == '<' || *f == '>' || *f == '|') ? *f++ : '>';
+  if (isdigit(*f))
+  {
+    *m = 0;
+    while (isdigit(*f))
+      *m = *m*10 + (*f++ - '0');
+  }
+  else
+    *m = -1;
+  if (*f == '.')
+  {
+    f++;	/* skip point */
+    *n = 0;
+    while (isdigit(*f))
+      *n = *n*10 + (*f++ - '0');
+  }
+  else
+    *n = -1;
+  return t;
+}
+
+
+static char *add_char (int c)
+{
+  static char *buff = NULL;
+  static int max = 0;
+  static int n = 0;
+  if (n >= max)
+  {
+    if (max == 0)
+    {
+      max = 100;
+      buff = (char *)malloc(max);
+    }
+    else
+    {
+      max *= 2;
+      buff = (char *)realloc(buff, max);
+    }
+    if (buff == NULL)
+      lua_error("memory overflow");
+  }
+  buff[n++] = c;
+  if (c == 0)
+    n = 0;  /* prepare for next string */
+  return buff;
+}
 
 /*
 ** Read a variable. On error put nil on stack.
@@ -176,140 +217,117 @@ static void io_appendto (void)
 **	Estes especificadores podem vir seguidos de numero que representa
 **	o numero de campos a serem lidos.
 */
-static void io_read (void)
+
+static int read_until_char (int del)
+{
+  int c;
+  while((c = fgetc(in)) != EOF && c != del)
+    add_char(c);
+  return c;
+}
+
+static int read_until_blank (void)
+{
+  int c;
+  while((c = fgetc(in)) != EOF && !isspace(c))
+    add_char(c);
+  return c;
+}
+
+static void read_m (int m)
+{
+  int c;
+  while (m-- && (c = fgetc(in)) != EOF)
+    add_char(c);
+}
+
+
+static void read_free (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 == '\"')
+  if (c == EOF)
   {
-   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 (c == '\"' || c == '\'')
-   {
+  { /* string */
-    if (s[strlen(s)-1] == '\n')
+    c = read_until_char(c);
-     s[strlen(s)-1] = 0;
+    if (c == EOF)
-   }
-   switch (tolower(t))
-   {
-    case 'i':
     {
-     long int l;
+      add_char(0);  /* to be ready for next time */
-     sscanf (s, "%ld", &l);
+      lua_pushnil();
-     lua_pushnumber(l);
     }
-    break;
+    else
-    case 'f': case 'g': case 'e':
+      lua_pushstring(add_char(0));
-    {
-     float f;
-     sscanf (s, "%f", &f);
-     lua_pushnumber(f);
-    }
-    break;
-    default: 
-     lua_pushstring(s); 
-    break;
-   }
   }
   else
   {
-   switch (tolower(t))
+    double d;
-   {
+    char dummy;
-    case 'i':
+    char *s;
-    {
+    add_char(c);
-     long int l;
+    read_until_blank();
-     if (fscanf (in, "%ld", &l) == EOF)
+    s = add_char(0);
-       lua_pushnil();
+    if (sscanf(s, "%lf %c", &d, &dummy) == 1)
-       else lua_pushnumber(l);
+      lua_pushnumber(d);
-    }
+    else
-    break;
+     lua_pushstring(s);
-    case 'f': case 'g': case 'e':
-    {
-     float f;
-     if (fscanf (in, "%f", &f) == EOF)
-       lua_pushnil();
-       else lua_pushnumber(f);
-    }
-    break;
-    default: 
-    {
-     char s[256];
-     if (fscanf (in, "%s", s) == EOF)
-       lua_pushnil();
-       else lua_pushstring(s);
-    }
-    break;
-   }
   }
- }
+}
+
+static void io_read (void)
+{
+  lua_Object o = lua_getparam (1);
+  if (o == LUA_NOOBJECT) 	/* free format */
+    read_free();
+  else				/* formatted */
+  {
+    int m, dummy1, dummy2;
+    switch (getformat(lua_check_string(1, "read"), &dummy1, &m, &dummy2))
+    {
+      case 's':
+        if (m < 0)
+          read_until_blank();
+        else
+          read_m(m);
+        lua_pushstring(add_char(0));
+        break;
+
+      case 'i':  /* can read as float, since it makes no difference to Lua */
+      case 'f':
+      {
+        double d;
+        int result;
+        if (m < 0)
+          result = fscanf(in, "%lf", &d);
+        else
+        {
+          read_m(m);
+          result = sscanf(add_char(0), "%lf", &d);
+        }
+        if (result == 1)
+          lua_pushnumber(d);
+        else
+          lua_pushnil();
+        break;
+      }
+    }
+  }
+}
+
+
+/*
+** Read characters until a given one. The delimiter is not read.
+*/
+static void io_readuntil (void)
+{
+ int del = *lua_check_string(1, "readuntil");
+ int c = read_until_char(del);
+ if (c != EOF) ungetc(c,in);
+ lua_pushstring(add_char(0));
 }
 
 
@@ -339,131 +357,246 @@ static void io_read (void)
 **			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,"%%");
+static int write_fill (int n, int c)
- if (j == '<' || j == '|') sprintf(strchr(f,0),"-");
+{
- if (m != 0)   sprintf(strchr(f,0),"%d", m);
+  while (n--)
- if (n != 0)   sprintf(strchr(f,0),".%d", n);
+    if (fputc(c, out) == EOF)
- sprintf(strchr(f,0), "%c", t);
+      return 0;
- switch (tolower(t))
+  return 1;
- {
-  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 int write_string (char *s, int just, int m)
+{
+  int status;
+  int l = strlen(s);
+  int pre;  /* number of blanks before string */
+  if (m < 0) m = l;
+  else if (l > m)
+  {
+    write_fill(m, '*');
+    return 0;
+  }
+  pre = (just == '<') ? 0 : (just == '>') ? m-l : (m-l)/2;
+  status = write_fill(pre, ' ');
+  status = status && fprintf(out, "%s", s) >= 0;
+  status = status && write_fill(m-(l+pre), ' ');
+  return status;
+}
+
+static int write_float (int just, int m, int n)
+{
+  char buffer[100];
+  lua_Object p = lua_getparam(1);
+  float number;
+  if (!lua_isnumber(p)) return 0;
+  number = lua_getnumber(p);
+  if (n >= 0)
+    sprintf(buffer, "%.*f", n, number);
+  else
+    sprintf(buffer, "%g", number);
+  return write_string(buffer, just, m);
+}
+
+
+static int write_int (int just, int m, int n)
+{
+  char buffer[100];
+  lua_Object p = lua_getparam(1);
+  int number;
+  if (!lua_isnumber(p)) return 0;
+  number = (int)lua_getnumber(p);
+  if (n >= 0)
+    sprintf(buffer, "%.*d", n, number);
+  else
+    sprintf(buffer, "%d", number);
+  return write_string(buffer, just, m);
+}
+
+
 static void io_write (void)
 {
- lua_Object o1 = lua_getparam (1);
+  int status = 0;
- lua_Object o2 = lua_getparam (2);
+  if (lua_getparam (2) == LUA_NOOBJECT)   /* free format */
- if (o1 == 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_Object o1 = lua_getparam(1);
-   lua_pushnumber(0);
+    if (lua_isnumber(o1))
-   return;
+      status = fprintf (out, "%g", lua_getnumber(o1)) >= 0;
+    else if (lua_isstring(o1))
+      status = fprintf (out, "%s", lua_getstring(o1)) >= 0;
   }
-  lua_pushnumber(fprintf (out, "%s", buildformat(lua_getstring(o2),o1)));
+  else					/* formated */
- }
+  {
+    int just, m, n;
+    switch (getformat (lua_check_string(2, "write"), &just, &m, &n))
+    {
+      case 's':
+      {
+        lua_Object p = lua_getparam(1);
+        if (lua_isstring(p))
+          status = write_string(lua_getstring(p), just, m);
+        else
+          status = 0;
+        break;
+      }
+      case 'f':
+        status = write_float(just, m, n);
+        break;
+      case 'i':
+        status = write_int(just, m, n);
+        break;
+    }
+  }
+  if (status)
+    lua_pushnumber(status);
+  else
+    lua_pushnil();
 }
 
 /*
 ** Execute a executable program using "system".
 ** Return the result of execution.
 */
-void io_execute (void)
+static void io_execute (void)
 {
- lua_Object o = lua_getparam (1);
+  lua_pushnumber(system(lua_check_string(1, "execute")));
- 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.
+** Remove a file. On error return nil.
-** On error put 0 on stack, otherwise put 1.
 */
-void io_remove  (void)
+static void io_remove  (void)
 {
- lua_Object o = lua_getparam (1);
+ if (remove(lua_check_string(1, "remove")) == 0)
- 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
+ else
-   lua_pushnumber (0);
+   lua_pushnil();
- }
- return;
 }
 
+
+/*
+** To get a environment variables
+*/
+static void io_getenv (void)
+{
+ char *env = getenv(lua_check_string(1, "getenv"));
+ if (env == NULL) lua_pushnil();
+ else             lua_pushstring(env); 
+}
+
+/*
+** Return time: hour, min, sec
+*/
+static void io_time (void)
+{
+ time_t t;
+ struct tm *s;
+ 
+ time(&t);
+ s = localtime(&t);
+ lua_pushnumber(s->tm_hour);
+ lua_pushnumber(s->tm_min);
+ lua_pushnumber(s->tm_sec);
+}
+ 
+/*
+** Return date: dd, mm, yyyy
+*/
+static void io_date (void)
+{
+ time_t t;
+ struct tm *s;
+ 
+ time(&t);
+ s = localtime(&t);
+ lua_pushnumber(s->tm_mday);
+ lua_pushnumber(s->tm_mon+1);
+ lua_pushnumber(s->tm_year+1900);
+}
+ 
+/*
+** Beep
+*/
+static void io_beep (void)
+{
+ printf("\a");
+}
+ 
+/*
+** To exit
+*/
+static void io_exit (void)
+{
+ lua_Object o = lua_getparam(1);
+ if (lua_isstring(o))
+  fprintf(stderr, "%s\n", lua_getstring(o));
+ exit(1);
+}
+
+/*
+** To debug a lua program. Start a dialog with the user, interpreting
+   lua commands until an 'cont'.
+*/
+static void io_debug (void)
+{
+  while (1)
+  {
+    char buffer[250];
+    fprintf(stderr, "lua_debug> ");
+    if (gets(buffer) == 0) return;
+    if (strcmp(buffer, "cont") == 0) return;
+    lua_dostring(buffer);
+  }
+}
+
+
+void lua_printstack (FILE *f)
+{
+  int level = 0;
+  lua_Object func;
+  fprintf(f, "Active Stack:\n");
+  while ((func = lua_stackedfunction(level++)) != LUA_NOOBJECT)
+  {
+    char *name;
+    int currentline;
+    fprintf(f, "\t");
+    switch (*getobjname(func, &name))
+    {
+      case 'g':
+        fprintf(f, "function %s", name);
+        break;
+      case 'f':
+        fprintf(f, "fallback %s", name);
+        break;
+      default:
+      {
+        char *filename;
+        int linedefined;
+        lua_funcinfo(func, &filename, &linedefined);
+        if (linedefined == 0)
+          fprintf(f, "main of %s", filename);
+        else if (linedefined < 0)
+          fprintf(f, "%s", filename);
+        else
+          fprintf(f, "function (%s:%d)", filename, linedefined);
+      }
+    }
+    if ((currentline = lua_currentline(func)) > 0)
+      fprintf(f, "  at line %d", currentline);
+    fprintf(f, "\n");
+  }
+}
+
+
+static void errorfb (void)
+{
+  lua_Object o = lua_getparam(1);
+  char *s = lua_isstring(o) ? lua_getstring(o) : "(no messsage)";
+  fprintf(stderr, "lua: %s\n", s);
+  lua_printstack(stderr);
+}
+
+
 /*
 ** Open io library
 */
@@ -473,7 +606,17 @@ void iolib_open (void)
  lua_register ("writeto",  io_writeto);
  lua_register ("appendto", io_appendto);
  lua_register ("read",     io_read);
+ lua_register ("readuntil",io_readuntil);
  lua_register ("write",    io_write);
  lua_register ("execute",  io_execute);
  lua_register ("remove",   io_remove);
+ lua_register ("getenv",   io_getenv);
+ lua_register ("time",     io_time);
+ lua_register ("date",     io_date);
+ lua_register ("beep",     io_beep);
+ lua_register ("exit",     io_exit);
+ lua_register ("debug",    io_debug);
+ lua_register ("print_stack", errorfb);
+ lua_setfallback("error", errorfb);
 }
+

lex.c

@@ -1,32 +1,30 @@
-char *rcs_lex = "$Id: lex.c,v 1.3 1993/12/28 16:42:29 roberto Exp celes $";
+char *rcs_lex = "$Id: lex.c,v 2.20 1995/10/25 13:05:51 roberto Exp roberto $";
-/*$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 <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 
-#include "opcode.h"
+#include "mem.h"
-#include "hash.h"
+#include "tree.h"
-#include "inout.h"
 #include "table.h"
-#include "y.tab.h"
+#include "opcode.h"
+#include "inout.h"
+#include "parser.h"
+#include "ugly.h"
+
+#define MINBUFF 260
+
+#define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b)))
 
 #define next() { current = input(); }
 #define save(x) { *yytextLast++ = (x); }
 #define save_and_next()  { save(current); next(); }
 
 static int current;
-static char yytext[256];
+static char *yytext = NULL;
+static int textsize = 0;
 static char *yytextLast;
 
 static Input input;
@@ -35,6 +33,11 @@ void lua_setinput (Input fn)
 {
   current = ' ';
   input = fn;
+  if (yytext == NULL)
+  {
+    textsize = MINBUFF;
+    yytext = newvector(textsize, char);
+  }
 }
 
 char *lua_lasttext (void)
@@ -44,6 +47,7 @@ char *lua_lasttext (void)
 }
 
 
+/* The reserved words must be listed in lexicographic order */
 static struct
   {
     char *name;
@@ -66,17 +70,18 @@ static struct
       {"until", UNTIL},
       {"while", WHILE} };
 
+
 #define RESERVEDSIZE (sizeof(reserved)/sizeof(reserved[0]))
 
 
-int findReserved (char *name)
+static 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);
+    int comp = lua_strcmp(name, reserved[m].name);
     if (comp < 0)
       h = m-1;
     else if (comp == 0)
@@ -88,15 +93,78 @@ int findReserved (char *name)
 }
 
 
-int yylex ()
+static void growtext (void)
 {
+  int size = yytextLast - yytext;
+  textsize *= 2;
+  yytext = growvector(yytext, textsize, char);
+  yytextLast = yytext + size;
+}
+
+
+static int read_long_string (void)
+{
+  int cont = 0;
+  int spaceleft = textsize - (yytextLast - yytext);
+  while (1)
+  {
+    if (spaceleft <= 2)  /* may read more than 1 char in one cicle */
+    {
+      growtext();
+      spaceleft = textsize - (yytextLast - yytext);
+    }
+    switch (current)
+    {
+      case EOF:
+      case 0:
+        return WRONGTOKEN;
+      case '[':
+        save_and_next(); spaceleft--;
+        if (current == '[')
+        {
+          cont++;
+          save_and_next(); spaceleft--;
+        }
+        continue; 
+      case ']':
+        save_and_next(); spaceleft--;
+        if (current == ']')
+        {
+          if (cont == 0) return STRING;
+          cont--;
+          save_and_next(); spaceleft--;
+        }
+        continue; 
+      case '\n':
+        lua_linenumber++;  /* goes through */
+      default:
+        save_and_next(); spaceleft--;
+    }
+  }
+}
+
+
+int yylex (void)
+{
+  float a;
+  static int linelasttoken = 0;
+  if (lua_debug)
+    luaI_codedebugline(linelasttoken);
+  linelasttoken = lua_linenumber;
   while (1)
   {
     yytextLast = yytext;
+#if 0
+    fprintf(stderr,"'%c' %d\n",current,current);
+#endif
     switch (current)
     {
-      case '\n': lua_linenumber++;
+      case EOF:
+      case 0:
+       return 0;
+      case '\n': linelasttoken = ++lua_linenumber;
       case ' ':
+      case '\r':  /* CR: to avoid problems with DOS/Windows */
       case '\t':
         next();
         continue;
@@ -106,12 +174,12 @@ int yylex ()
 	while (isalnum(current) || current == '_')
           save_and_next();
         *yytextLast = 0;
-	if (strcmp(yytext, "debug") == 0)
+	if (lua_strcmp(yytext, "debug") == 0)
 	{
 	  yylval.vInt = 1;
 	  return DEBUG;
         }
-	else if (strcmp(yytext, "nodebug") == 0)
+	else if (lua_strcmp(yytext, "nodebug") == 0)
 	{
 	  yylval.vInt = 0;
 	  return DEBUG;
@@ -120,10 +188,30 @@ int yylex ()
 
       case '-':
         save_and_next();
-        if (current != '-') return '-';
+        if (current != '-') return '-';  /* else goes through */
+      case '#':
         do { next(); } while (current != '\n' && current != 0);
         continue;
 
+      case '[':
+        save_and_next();
+        if (current != '[') return '[';
+        else
+        {
+          save_and_next();  /* pass the second '[' */
+          if (read_long_string() == WRONGTOKEN)
+            return WRONGTOKEN;
+          save_and_next();  /* pass the second ']' */
+          *(yytextLast-2) = 0;  /* erases ']]' */
+          yylval.vWord = luaI_findconstantbyname(yytext+2);
+          return STRING;
+        }
+
+      case '=':
+        save_and_next();
+        if (current != '=') return '=';
+        else { save_and_next(); return EQ; }
+
       case '<':
         save_and_next();
         if (current != '=') return '<';
@@ -143,11 +231,19 @@ int yylex ()
       case '\'':
       {
         int del = current;
+        int spaceleft = textsize - (yytextLast - yytext);
         next();  /* skip the delimiter */
         while (current != del)
         {
+          if (spaceleft <= 2) /* may read more than 1 char in one cicle */
+          {
+            growtext();
+            spaceleft = textsize - (yytextLast - yytext);
+          }
+          spaceleft--;
           switch (current)
           {
+            case EOF:
             case 0:
             case '\n':
               return WRONGTOKEN;
@@ -158,7 +254,7 @@ int yylex ()
                 case 'n': save('\n'); next(); break;
                 case 't': save('\t'); next(); break;
                 case 'r': save('\r'); next(); break;
-                default : save('\\'); break;
+                default : save(current); next(); break;
               }
               break;
             default:
@@ -167,7 +263,7 @@ int yylex ()
         }
         next();  /* skip the delimiter */
         *yytextLast = 0;
-        yylval.vWord = lua_findconstant (yytext);
+        yylval.vWord = luaI_findconstantbyname(yytext);
         return STRING;
       }
 
@@ -185,12 +281,12 @@ int yylex ()
       case 'Z':
       case '_':
       {
-        int res;
+        Word res;
         do { save_and_next(); } while (isalnum(current) || current == '_');
         *yytextLast = 0;
         res = findReserved(yytext);
         if (res) return res;
-        yylval.pChar = yytext;
+        yylval.pNode = lua_constcreate(yytext);
         return NAME;
       }
 
@@ -203,31 +299,59 @@ int yylex ()
         }
         else if (!isdigit(current)) return '.';
         /* current is a digit: goes through to number */
+	a=0.0;
         goto fraction;
 
       case '0': case '1': case '2': case '3': case '4':
       case '5': case '6': case '7': case '8': case '9':
-      
+	a=0.0;
-        do { save_and_next(); } while (isdigit(current));
+        do { a=10*a+current-'0'; save_and_next(); } while (isdigit(current));
         if (current == '.') save_and_next();
-fraction: while (isdigit(current)) save_and_next();
+fraction:
-        if (current == 'e' || current == 'E')
+	{ float da=0.1;
-        {
+	  while (isdigit(current))
-          save_and_next();
+	  {a+=(current-'0')*da; da/=10.0; save_and_next()};
-          if (current == '+' || current == '-') save_and_next();
+          if (current == 'e' || current == 'E')
-          if (!isdigit(current)) return WRONGTOKEN;
+          {
-          do { save_and_next(); } while (isdigit(current));
+	    int e=0;
+	    int neg;
+	    float ea;
+            save_and_next();
+	    neg=(current=='-');
+            if (current == '+' || current == '-') save_and_next();
+            if (!isdigit(current)) return WRONGTOKEN;
+            do { e=10*e+current-'0'; save_and_next(); } while (isdigit(current));
+	    for (ea=neg?0.1:10.0; e>0; e>>=1) 
+	    {
+	      if (e & 1) a*=ea;
+	      ea*=ea;
+	    }
+          }
+          yylval.vFloat = a;
+          return NUMBER;
         }
-        *yytextLast = 0;
+
-        yylval.vFloat = atof(yytext);
+      case U_and: case U_do: case U_else: case U_elseif: case U_end:
-        return NUMBER;
+      case U_function: case U_if: case U_local: case U_nil: case U_not:
+      case U_or: case U_repeat: case U_return: case U_then:
+      case U_until: case U_while:
+      {
+        int old = current;
+        next();
+        return reserved[old-U_and].token;
+      }
+
+      case U_eq:	next(); return EQ;
+      case U_le:	next(); return LE;
+      case U_ge:	next(); return GE;
+      case U_ne:	next(); return NE;
+      case U_sc:	next(); return CONC;
 
       default: 		/* also end of file */
       {
         save_and_next();
-        return *yytext;      
+        return yytext[0];
       }
     }
   }
 }
-        

lua.c

@@ -3,29 +3,90 @@
 ** Linguagem para Usuarios de Aplicacao
 */
 
-char *rcs_lua="$Id: $";
+char *rcs_lua="$Id: lua.c,v 1.6 1995/10/23 13:54:11 roberto Exp roberto $";
 
 #include <stdio.h>
+#include <string.h>
 
 #include "lua.h"
 #include "lualib.h"
 
+static int lua_argc;
+static char **lua_argv;
 
-void main (int argc, char *argv[])
+/*
+** although this function is POSIX, there is no standard header file that
+** defines it
+*/
+int isatty (int fd);
+
+/*
+%F Allow Lua code to access argv strings.
+%i Receive from Lua the argument number (starting with 1).
+%o Return to Lua the argument, or nil if it does not exist.
+*/
+static void lua_getargv (void)
 {
- int i;
+ lua_Object lo = lua_getparam(1);
- iolib_open ();
+ if (!lua_isnumber(lo))
- strlib_open ();
+  lua_pushnil();
- 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]);
+  int n = (int)lua_getnumber(lo);
+  if (n < 1 || n > lua_argc) lua_pushnil();
+  else                       lua_pushstring(lua_argv[n]);
+ }
+}
+
+
+static void manual_input (void)
+{
+  if (isatty(fileno(stdin)))
+  {
+   char buffer[250];
+   while (gets(buffer) != 0)
+     lua_dostring(buffer);
+  }
+  else
+    lua_dofile(NULL);  /* executes stdin as a file */
+}
+
+
+int main (int argc, char *argv[])
+{
+ int i;
+ int result = 0;
+ iolib_open ();
+ strlib_open ();
+ mathlib_open ();
+
+ lua_register("argv", lua_getargv);
+
+ if (argc < 2)
+   manual_input();
+ else
+ {
+  for (i=1; i<argc; i++)
+   if (strcmp(argv[i], "--") == 0)
+   {
+    lua_argc = argc-i-1;
+    lua_argv = argv+i;
+    break;
+   }
+  for (i=1; i<argc; i++)
+  {
+   if (strcmp(argv[i], "--") == 0)
+    break;
+   else if (strcmp(argv[i], "-") == 0)
+    manual_input();
+   else if (strcmp(argv[i], "-v") == 0)
+    printf("%s  %s\n(written by %s)\n\n",
+            LUA_VERSION, LUA_COPYRIGHT, LUA_AUTHORS);
+   else
+    result = lua_dofile (argv[i]);
+  }
+ }
+ return result;
 }
 
 

lua.h

@@ -2,53 +2,107 @@
 ** LUA - Linguagem para Usuarios de Aplicacao
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: $
+** $Id: lua.h,v 3.20 1995/10/31 16:41:53 roberto Exp roberto $
 */
 
 
 #ifndef lua_h
 #define lua_h
 
+#define LUA_VERSION	"Lua 2.2"
+#define LUA_COPYRIGHT	"Copyright (C) 1994, 1995 TeCGraf"
+#define LUA_AUTHORS 	"W. Celes, R. Ierusalimschy & L. H. de Figueiredo"
+
+
+/* Private Part */
+ 
+typedef enum
+{
+ LUA_T_NIL	= -1,
+ LUA_T_NUMBER	= -2,
+ LUA_T_STRING	= -3,
+ LUA_T_ARRAY	= -4,
+ LUA_T_FUNCTION	= -5,
+ LUA_T_CFUNCTION= -6,
+ LUA_T_MARK	= -7,
+ LUA_T_CMARK	= -8,
+ LUA_T_LINE	= -9,
+ LUA_T_USERDATA = 0
+} lua_Type;
+ 
+
+/* Public Part */
+
+#define LUA_NOOBJECT  0
+
 typedef void (*lua_CFunction) (void);
-typedef struct Object *lua_Object;
+typedef unsigned int lua_Object;
 
-#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+lua_Object     lua_setfallback		(char *name, lua_CFunction fallback);
 
-
-void           lua_errorfunction    	(void (*fn) (char *s));
 void           lua_error		(char *s);
 int            lua_dofile 		(char *filename);
 int            lua_dostring 		(char *string);
-int            lua_call 		(char *functionname, int nparam);
+int            lua_callfunction		(lua_Object function);
+int	       lua_call			(char *funcname);
+
+void	       lua_beginblock		(void);
+void	       lua_endblock		(void);
 
 lua_Object     lua_getparam 		(int number);
+#define	       lua_getresult(_)		lua_getparam(_)
+
 float          lua_getnumber 		(lua_Object object);
 char          *lua_getstring 		(lua_Object object);
-char 	      *lua_copystring 		(lua_Object object);
 lua_CFunction  lua_getcfunction 	(lua_Object object);
 void          *lua_getuserdata  	(lua_Object object);
-lua_Object     lua_getfield         	(lua_Object object, char *field);
+
-lua_Object     lua_getindexed         	(lua_Object object, float index);
+void 	       lua_pushnil 		(void);
+void           lua_pushnumber 		(float n);
+void           lua_pushstring 		(char *s);
+void           lua_pushliteral 		(char *s);
+void           lua_pushcfunction	(lua_CFunction fn);
+void           lua_pushusertag     	(void *u, int tag);
+void           lua_pushobject       	(lua_Object object);
+
 lua_Object     lua_getglobal 		(char *name);
+void           lua_storeglobal		(char *name);
 
-lua_Object     lua_pop 			(void);
+void           lua_storesubscript	(void);
+lua_Object     lua_getsubscript         (void);
 
-int 	       lua_pushnil 		(void);
+int            lua_type 		(lua_Object object);
-int            lua_pushnumber 		(float n);
-int            lua_pushstring 		(char *s);
-int            lua_pushcfunction	(lua_CFunction fn);
-int            lua_pushuserdata     	(void *u);
-int            lua_pushobject       	(lua_Object object);
 
-int            lua_storeglobal		(char *name);
+int	       lua_lock			(void);
-int            lua_storefield		(lua_Object object, char *field);
+lua_Object     lua_getlocked		(int ref);
-int            lua_storeindexed		(lua_Object object, float index);
+void	       lua_pushlocked		(int ref);
+void	       lua_unlock		(int ref);
 
-int            lua_isnil 		(lua_Object object);
+lua_Object     lua_createtable		(void);
-int            lua_isnumber 		(lua_Object object);
+
-int            lua_isstring 		(lua_Object object);
+
-int            lua_istable          	(lua_Object object);
+/* some useful macros */
-int            lua_iscfunction 		(lua_Object object);
+
-int            lua_isuserdata 		(lua_Object object);
+#define lua_lockobject(o)  (lua_pushobject(o), lua_lock())
+
+#define lua_register(n,f)	(lua_pushcfunction(f), lua_storeglobal(n))
+
+#define lua_pushuserdata(u)     lua_pushusertag(u, LUA_T_USERDATA)
+
+#define lua_isnil(_)            (lua_type(_)==LUA_T_NIL)
+#define lua_isnumber(_)         (lua_type(_)==LUA_T_NUMBER)
+#define lua_isstring(_)         (lua_type(_)==LUA_T_STRING)
+#define lua_istable(_)          (lua_type(_)==LUA_T_ARRAY)
+#define lua_isfunction(_)       (lua_type(_)==LUA_T_FUNCTION)
+#define lua_iscfunction(_)      (lua_type(_)==LUA_T_CFUNCTION)
+#define lua_isuserdata(_)       (lua_type(_)>=LUA_T_USERDATA)
+
+
+/* for lua 1.1 compatibility. Avoid using these macros */
+
+#define lua_getindexed(o,n) (lua_pushobject(o), lua_pushnumber(n), lua_getsubscript())
+#define lua_getfield(o,f)   (lua_pushobject(o), lua_pushliteral(f), lua_getsubscript())
+
+#define lua_copystring(o) (strdup(lua_getstring(o)))
 
 #endif

lua.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;
-

luadebug.h

@@ -0,0 +1,20 @@
+/*
+** LUA - Linguagem para Usuarios de Aplicacao
+** Grupo de Tecnologia em Computacao Grafica
+** TeCGraf - PUC-Rio
+** $Id: luadebug.h,v 1.1 1995/10/17 14:12:45 roberto Exp roberto $
+*/
+
+
+#ifndef luadebug_h
+#define luadebug_h
+
+#include "lua.h"
+
+lua_Object lua_stackedfunction(int level);
+void lua_funcinfo (lua_Object func, char **filename, int *linedefined);
+int lua_currentline (lua_Object func);
+char *getobjname (lua_Object o, char **name);
+
+
+#endif

lualib.h

@@ -2,7 +2,7 @@
 ** Libraries to be used in LUA programs
 ** Grupo de Tecnologia em Computacao Grafica
 ** TeCGraf - PUC-Rio
-** $Id: $
+** $Id: lualib.h,v 1.3 1994/12/13 15:59:16 roberto Exp roberto $
 */
 
 #ifndef lualib_h
@@ -12,5 +12,11 @@ void iolib_open   (void);
 void strlib_open  (void);
 void mathlib_open (void);
 
+
+/* auxiliar functions (private) */
+void lua_arg_error(char *funcname);
+char *lua_check_string (int numArg, char *funcname);
+float lua_check_number (int numArg, char *funcname);
+
 #endif
 

luamem.c

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

luamem.h

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

makefile

@@ -1,34 +1,42 @@
-# $Id: makefile,v 1.5 1994/01/10 19:49:56 roberto Exp celes $
+# $Id: makefile,v 1.15 1995/10/17 18:16:58 roberto Exp roberto $
+
+#configuration
+
+# define (undefine) POPEN if your system (does not) support piped I/O
+CONFIG = -DPOPEN
 # Compilation parameters
 CC = gcc
-CFLAGS = -I/usr/5include -Wall -O2
+CFLAGS = $(CONFIG) -I/usr/5include -Wall -Wmissing-prototypes -Wshadow -ansi -O2
+
+#CC = acc
+#CFLAGS = -fast -I/usr/5include
 
 AR = ar
 ARFLAGS	= rvl
 
 # Aplication modules
-LUAMOD =	\
+LUAOBJS = \
-	y.tab 	\
+	parser.o \
-	lex	\
+	lex.o \
-	opcode	\
+	opcode.o \
-	hash	\
+	hash.o \
-	table	\
+	table.o \
-	inout	\
+	inout.o \
-	tree
+	tree.o \
+	fallback.o \
+	mem.o \
+	func.o
 
-LIBMOD = 	\
+LIBOBJS = 	\
-	iolib	\
+	iolib.o \
-	strlib	\
+	mathlib.o \
-	mathlib
+	strlib.o
 
-LUAOBJS	= $(LUAMOD:%=%.o)
-
-LIBOBJS	= $(LIBMOD:%=%.o)
 
 lua : lua.o lua.a lualib.a
-	$(CC) $(CFLAGS) -o $@ lua.c lua.a lualib.a -lm
+	$(CC) $(CFLAGS) -o $@ lua.o lua.a lualib.a -lm
 
-lua.a : y.tab.c $(LUAOBJS)
+lua.a : parser.o $(LUAOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib lua.a
 
@@ -36,18 +44,39 @@ lualib.a : $(LIBOBJS)
 	$(AR) $(ARFLAGS) $@  $?
 	ranlib $@
 
-.KEEP_STATE:
-
 liblua.so.1.0 : lua.o
 	ld -o liblua.so.1.0 $(LUAOBJS)
 
-%.o	: %.c
-	$(CC) $(CFLAGS) -c -o $@ $<
 
+parser.c : lua.stx
+	yacc++ -d lua.stx ; mv -f y.tab.c parser.c ; mv -f y.tab.h parser.h
 
-y.tab.c : lua.stx exscript
+clear	:
-	yacc -d lua.stx ; ex y.tab.c <exscript
+	rcsclean
+	rm -f *.o
+	rm -f parser.c parser.h
+	co lua.h lualib.h luadebug.h
 
 % : RCS/%,v
 	co $@
 
+
+fallback.o : fallback.c mem.h fallback.h opcode.h lua.h types.h tree.h func.h 
+func.o : func.c table.h tree.h types.h opcode.h lua.h func.h mem.h 
+hash.o : hash.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h 
+inout.o : inout.c mem.h opcode.h lua.h types.h tree.h func.h hash.h inout.h \
+  table.h 
+iolib.o : iolib.c lua.h lualib.h luadebug.h
+lex.o : lex.c mem.h tree.h types.h table.h opcode.h lua.h func.h inout.h parser.h \
+  ugly.h 
+lua.o : lua.c lua.h lualib.h 
+mathlib.o : mathlib.c lualib.h lua.h 
+mem.o : mem.c mem.h lua.h 
+opcode.o : opcode.c mem.h opcode.h lua.h types.h tree.h func.h hash.h inout.h \
+  table.h fallback.h luadebug.h
+parser.o : parser.c mem.h opcode.h lua.h types.h tree.h func.h hash.h inout.h \
+  table.h 
+strlib.o : strlib.c lua.h lualib.h 
+table.o : table.c mem.h opcode.h lua.h types.h tree.h func.h hash.h table.h \
+  inout.h fallback.h 
+tree.o : tree.c mem.h lua.h tree.h types.h table.h opcode.h func.h 

mathlib.c

@@ -3,25 +3,23 @@
 ** Mathematics library to LUA
 */
 
-char *rcs_mathlib="$Id: $";
+char *rcs_mathlib="$Id: mathlib.c,v 1.12 1995/10/09 12:48:38 roberto Exp roberto $";
 
 #include <stdio.h>		/* NULL */
 #include <math.h>
 
+#include "lualib.h"
 #include "lua.h"
 
-#define TODEGREE(a) ((a)*180.0/3.14159)
+#ifndef PI
-#define TORAD(a)    ((a)*3.14159/180.0)
+#define PI          3.14159265358979323846
+#endif
+#define TODEGREE(a) ((a)*180.0/PI)
+#define TORAD(a)    ((a)*PI/180.0)
 
 static void math_abs (void)
 {
- double d;
+ double d = lua_check_number(1, "abs"); 
- lua_Object o = lua_getparam (1);
- if (o == 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);
 }
@@ -29,13 +27,7 @@ static void math_abs (void)
 
 static void math_sin (void)
 {
- double d;
+ double d = lua_check_number(1, "sin");
- lua_Object o = lua_getparam (1);
- if (o == 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)));
 }
 
@@ -43,13 +35,7 @@ static void math_sin (void)
 
 static void math_cos (void)
 {
- double d;
+ double d = lua_check_number(1, "cos");
- lua_Object o = lua_getparam (1);
- if (o == 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)));
 }
 
@@ -57,162 +43,147 @@ static void math_cos (void)
 
 static void math_tan (void)
 {
- double d;
+ double d = lua_check_number(1, "tan");
- lua_Object o = lua_getparam (1);
- if (o == 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;
+ double d = lua_check_number(1, "asin");
- 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;
+ double d = lua_check_number(1, "acos");
- 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;
+ double d = lua_check_number(1, "atan");
- 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_atan2 (void)
+{
+ double d1 = lua_check_number(1, "atan2");
+ double d2 = lua_check_number(2, "atan2");
+ lua_pushnumber (TODEGREE(atan2(d1, d2)));
+}
+
+
 static void math_ceil (void)
 {
- double d;
+ double d = lua_check_number(1, "ceil");
- lua_Object o = lua_getparam (1);
- if (o == 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;
+ double d = lua_check_number(1, "floor");
- 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;
+ int d1 = (int)lua_check_number(1, "mod");
- lua_Object o1 = lua_getparam (1);
+ int d2 = (int)lua_check_number(2, "mod");
- lua_Object o2 = lua_getparam (2);
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `mod'"); return; }
- d1 = (int) lua_getnumber(o1);
- d2 = (int) lua_getnumber(o2);
  lua_pushnumber (d1%d2);
 }
 
 
 static void math_sqrt (void)
 {
- double d;
+ double d = lua_check_number(1, "sqrt");
- lua_Object o = lua_getparam (1);
- if (o == 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 int old_pow;
+
 static void math_pow (void)
 {
- double d1, d2;
  lua_Object o1 = lua_getparam (1);
  lua_Object o2 = lua_getparam (2);
- if (!lua_isnumber(o1) || !lua_isnumber(o2))
+ lua_Object op = lua_getparam(3);
- { lua_error ("incorrect arguments to function `pow'"); return; }
+ if (!lua_isnumber(o1) || !lua_isnumber(o2) || *(lua_getstring(op)) != 'p')
- d1 = lua_getnumber(o1);
+ {
- d2 = lua_getnumber(o2);
+   lua_Object old = lua_getlocked(old_pow);
- lua_pushnumber (pow(d1,d2));
+   lua_pushobject(o1);
+   lua_pushobject(o2);
+   lua_pushobject(op);
+   if (lua_callfunction(old) != 0)
+     lua_error(NULL);
+ }
+ else
+ {
+   double d1 = lua_getnumber(o1);
+   double d2 = lua_getnumber(o2);
+   lua_pushnumber (pow(d1,d2));
+ }
 }
 
 static void math_min (void)
 {
  int i=1;
- double d, dmin;
+ double dmin = lua_check_number(i, "min");
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- if ((o = lua_getparam(i++)) == 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))
+  double d = lua_check_number(i, "min");
-  { 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;
+ double dmax = lua_check_number(i, "max");
- lua_Object o;
+ while (lua_getparam(++i) != LUA_NOOBJECT)
- 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))
+  double d = lua_check_number(i, "max");
-  { lua_error ("incorrect arguments to function `max'"); return; }
-  d = lua_getnumber (o);
   if (d > dmax) dmax = d;
  }
  lua_pushnumber (dmax);
 }
 
+static void math_log (void)
+{
+ double d = lua_check_number(1, "log");
+ lua_pushnumber (log(d));
+}
 
 
+static void math_log10 (void)
+{
+ double d = lua_check_number(1, "log10");
+ lua_pushnumber (log10(d));
+}
+
+
+static void math_exp (void)
+{
+ double d = lua_check_number(1, "exp");
+ lua_pushnumber (exp(d));
+}
+
+static void math_deg (void)
+{
+ float d = lua_check_number(1, "deg");
+ lua_pushnumber (d*180./PI);
+}
+
+static void math_rad (void)
+{
+ float d = lua_check_number(1, "rad");
+ lua_pushnumber (d/180.*PI);
+}
+
 /*
 ** Open math library
 */
@@ -225,11 +196,17 @@ void mathlib_open (void)
  lua_register ("asin",  math_asin);
  lua_register ("acos",  math_acos);
  lua_register ("atan",  math_atan);
+ lua_register ("atan2",  math_atan2);
  lua_register ("ceil",  math_ceil);
  lua_register ("floor", math_floor);
  lua_register ("mod",   math_mod);
  lua_register ("sqrt",  math_sqrt);
- lua_register ("pow",   math_pow);
  lua_register ("min",   math_min);
  lua_register ("max",   math_max);
+ lua_register ("log",   math_log);
+ lua_register ("log10", math_log10);
+ lua_register ("exp",   math_exp);
+ lua_register ("deg",   math_deg);
+ lua_register ("rad",   math_rad);
+ old_pow = lua_lockobject(lua_setfallback("arith", math_pow));
 }

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,14 +1,15 @@
 /*
 ** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
+** $Id: opcode.h,v 3.13 1995/10/17 11:58:41 roberto Exp roberto $
 */
 
 #ifndef opcode_h
 #define opcode_h
 
-#ifndef STACKGAP
+#include "lua.h"
-#define STACKGAP	128
+#include "types.h"
-#endif 
+#include "tree.h"
+#include "func.h"
 
 #ifndef real
 #define real float
@@ -16,23 +17,6 @@
 
 #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 
 { 
@@ -42,13 +26,13 @@ typedef enum
  PUSHWORD,
  PUSHFLOAT,
  PUSHSTRING,
+ PUSHFUNCTION,
  PUSHLOCAL0, PUSHLOCAL1, PUSHLOCAL2, PUSHLOCAL3, PUSHLOCAL4,
  PUSHLOCAL5, PUSHLOCAL6, PUSHLOCAL7, PUSHLOCAL8, PUSHLOCAL9,
  PUSHLOCAL,
  PUSHGLOBAL,
  PUSHINDEXED,
- PUSHMARK,
+ PUSHSELF,
- PUSHOBJECT,
  STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
  STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
  STORELOCAL,
@@ -58,15 +42,19 @@ typedef enum
  STORELIST0,
  STORELIST,
  STORERECORD,
+ ADJUST0,
  ADJUST,
  CREATEARRAY,
  EQOP,
  LTOP,
  LEOP,
+ GTOP,
+ GEOP,
  ADDOP,
  SUBOP,
  MULTOP,
  DIVOP,
+ POWOP,
  CONCOP,
  MINUSOP,
  NOTOP,
@@ -78,41 +66,31 @@ typedef enum
  IFFUPJMP,
  POP,
  CALLFUNC,
+ RETCODE0,
  RETCODE,
- HALT,
+ SETLINE
- SETFUNCTION,
- SETLINE,
- RESET
 } OpCode;
 
-typedef enum
+#define MULT_RET	255
-{
+
- 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;
+ Cfunction     f;
- real    	 n;
+ real          n;
- char      	*s;
+ TaggedString *ts;
- Byte      	*b;
+ TFunc         *tf;
  struct Hash    *a;
  void           *u;
+ int	       i;
 } Value;
 
 typedef struct Object
 {
- Type  tag;
+ lua_Type  tag;
  Value value;
 } Object;
 
@@ -124,8 +102,8 @@ typedef struct
 /* Macros to access structure members */
 #define tag(o)		((o)->tag)
 #define nvalue(o)	((o)->value.n)
-#define svalue(o)	((o)->value.s)
+#define svalue(o)	((o)->value.ts->str)
-#define bvalue(o)	((o)->value.b)
+#define tsvalue(o)	((o)->value.ts)
 #define avalue(o)	((o)->value.a)
 #define fvalue(o)	((o)->value.f)
 #define uvalue(o)	((o)->value.u)
@@ -135,30 +113,45 @@ typedef struct
 #define s_tag(i)	(tag(&s_object(i)))
 #define s_nvalue(i)	(nvalue(&s_object(i)))
 #define s_svalue(i)	(svalue(&s_object(i)))
-#define s_bvalue(i)	(bvalue(&s_object(i)))
 #define s_avalue(i)	(avalue(&s_object(i)))
 #define s_fvalue(i)	(fvalue(&s_object(i)))
 #define s_uvalue(i)	(uvalue(&s_object(i)))
 
+typedef union
+{
+ struct {char c1; char c2;} m;
+ Word w;
+} CodeWord;
 #define get_word(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;}
+
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ float f;
+} CodeFloat;
 #define get_float(code,pc)   {code.m.c1 = *pc++; code.m.c2 = *pc++;\
                               code.m.c3 = *pc++; code.m.c4 = *pc++;}
 
+typedef union
+{
+ struct {char c1; char c2; char c3; char c4;} m;
+ TFunc *tf;
+} CodeCode;
+#define get_code(code,pc)    {code.m.c1 = *pc++; code.m.c2 = *pc++;\
+                              code.m.c3 = *pc++; code.m.c4 = *pc++;}
 
 
 /* Exported functions */
-int     lua_execute   (Byte *pc);
-void    lua_markstack (void);
 char   *lua_strdup (char *l);
 
 void    lua_setinput   (Input fn);	/* from "lex.c" module */
 char   *lua_lasttext   (void);		/* from "lex.c" module */
-int     lua_parse      (void); 		/* from "lua.stx" module */
+int     yylex (void);		        /* from "lex.c" module */
-void    lua_type       (void);
+void    lua_parse      (TFunc *tf);	/* from "lua.stx" module */
-void 	lua_obj2number (void);
+void	luaI_codedebugline (int line);  /* from "lua.stx" module */
-void 	lua_print      (void);
+void    lua_travstack (int (*fn)(Object *));
-void 	lua_internaldofile (void);
+Object *luaI_Address (lua_Object o);
-void 	lua_internaldostring (void);
+void	luaI_pushobject (Object *o);
-void    lua_travstack (void (*fn)(Object *));
+void    luaI_gcFB       (Object *o);
 
 #endif

strlib.c

@@ -3,34 +3,72 @@
 ** String library to LUA
 */
 
-char *rcs_strlib="$Id: strlib.c,v 1.1 1993/12/17 18:41:19 celes Exp celes $";
+char *rcs_strlib="$Id: strlib.c,v 1.13 1995/10/09 12:49:21 roberto Exp roberto $";
 
-#include <stdlib.h>
 #include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
 #include <ctype.h>
 
-#include "mm.h"
-
-
 #include "lua.h"
+#include "lualib.h"
+
+
+void lua_arg_error(char *funcname)
+{
+  char buff[100];
+  sprintf(buff, "incorrect arguments to function `%s'", funcname);
+  lua_error(buff);
+}
+
+char *lua_check_string (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  if (!(lua_isstring(o) || lua_isnumber(o)))
+    lua_arg_error(funcname);
+  return lua_getstring(o);
+}
+
+float lua_check_number (int numArg, char *funcname)
+{
+  lua_Object o = lua_getparam(numArg);
+  if (!lua_isnumber(o))
+    lua_arg_error(funcname);
+  return lua_getnumber(o);
+}
+
+static char *newstring (char *s)
+{
+  char *ns = (char *)malloc(strlen(s)+1);
+  if (ns == 0)
+    lua_error("not enough memory for new string");
+  strcpy(ns, s);
+  return ns;
+}
+
 
 /*
 ** Return the position of the first caracter of a substring into a string
 ** LUA interface:
-**			n = strfind (string, substring)
+**			n = strfind (string, substring, init, end)
 */
 static void str_find (void)
 {
- char *s1, *s2, *f;
+ char *s1 = lua_check_string(1, "strfind");
- lua_Object o1 = lua_getparam (1);
+ char *s2 = lua_check_string(2, "strfind");
- lua_Object o2 = lua_getparam (2);
+ int init = (lua_getparam(3) == LUA_NOOBJECT) ? 0 :
- if (!lua_isstring(o1) || !lua_isstring(o2))
+                                 (int)lua_check_number(3, "strfind")-1;
- { lua_error ("incorrect arguments to function `strfind'"); return; }
+ char *f = strstr(s1+init,s2);
- s1 = lua_getstring(o1);
- s2 = lua_getstring(o2);
- f = strstr(s1,s2);
  if (f != NULL)
-  lua_pushnumber (f-s1+1);
+ {
+  int pos = f-s1+1;
+  if (lua_getparam (4) == LUA_NOOBJECT)
+   lua_pushnumber (pos);
+  else if ((int)lua_check_number(4, "strfind") >= pos+strlen(s2)-1)
+   lua_pushnumber (pos);
+  else
+   lua_pushnil();
+ }
  else
   lua_pushnil();
 }
@@ -42,10 +80,8 @@ static void str_find (void)
 */
 static void str_len (void)
 {
- lua_Object o = lua_getparam (1);
+ char *s = lua_check_string(1, "strlen");
- if (!lua_isstring(o))
+ lua_pushnumber(strlen(s));
- { lua_error ("incorrect arguments to function `strlen'"); return; }
- lua_pushnumber(strlen(lua_getstring(o)));
 }
 
 
@@ -56,26 +92,36 @@ static void str_len (void)
 */
 static void str_sub (void)
 {
- int start, end;
+ char *s = lua_check_string(1, "strsub");
- char *s;
+ int start = (int)lua_check_number(2, "strsub");
- lua_Object o1 = lua_getparam (1);
+ int end = (lua_getparam(3) == LUA_NOOBJECT) ? strlen(s) :
- lua_Object o2 = lua_getparam (2);
+                                    (int)lua_check_number(3, "strsub");
- lua_Object o3 = lua_getparam (3);
- if (!lua_isstring(o1) || !lua_isnumber(o2))
- { lua_error ("incorrect arguments to function `strsub'"); 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("");
+  lua_pushliteral("");
  else
  {
+  char temp = s[end];
   s[end] = 0;
   lua_pushstring (&s[start-1]);
+  s[end] = temp;
  }
- free (s);
+}
+
+/*
+** Convert a string according to given function.
+*/
+typedef int (*strfunc)(int s);
+static void str_apply (strfunc f, char *funcname)
+{
+ char *s, *c;
+ c = s = newstring(lua_check_string(1, funcname));
+ while (*c != 0)
+ {
+  *c = f(*c);
+  c++;
+ }
+ lua_pushstring(s);
+ free(s);
 }
 
 /*
@@ -85,18 +131,7 @@ static void str_sub (void)
 */
 static void str_lower (void)
 {
- char *s, *c;
+  str_apply(tolower, "strlower");
- 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);
 }
 
 
@@ -107,20 +142,40 @@ static void str_lower (void)
 */
 static void str_upper (void)
 {
- char *s, *c;
+  str_apply(toupper, "strupper");
- 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);
 }
 
+/*
+** get ascii value of a character in a string
+*/
+static void str_ascii (void)
+{
+  char *s = lua_check_string(1, "ascii");
+  lua_Object o2 = lua_getparam(2);
+  int pos;
+  pos = (o2 == LUA_NOOBJECT) ? 0 : (int)lua_check_number(2, "ascii")-1;
+  if (pos<0 || pos>=strlen(s))
+    lua_arg_error("ascii");
+  lua_pushnumber(s[pos]);
+}
+
+/*
+** converts one or more integers to chars in a string
+*/
+#define maxparams 50
+static void str_int2str (void)
+{
+  char s[maxparams+1];
+  int i = 0;
+  while (lua_getparam(++i) != LUA_NOOBJECT)
+  {
+    if (i > maxparams)
+      lua_error("too many parameters to function `int2str'");
+    s[i-1] = (int)lua_check_number(i, "int2str");
+  }
+  s[i-1] = 0;
+  lua_pushstring(s);
+}
 
 /*
 ** Open string library
@@ -132,4 +187,6 @@ void strlib_open (void)
  lua_register ("strsub", str_sub);
  lua_register ("strlower", str_lower);
  lua_register ("strupper", str_upper);
+ lua_register ("ascii", str_ascii);
+ lua_register ("int2str", str_int2str);
 }

table.c

@@ -3,71 +3,69 @@
 ** Module to control static tables
 */
 
-char *rcs_table="$Id: table.c,v 2.1 1994/04/20 22:07:57 celes Exp celes $";
+char *rcs_table="$Id: table.c,v 2.37 1995/10/26 14:21:56 roberto Exp roberto $";
 
-#include <stdlib.h>
+/*#include <string.h>*/
-#include <string.h>
-
-#include "mm.h"
 
+#include "mem.h"
 #include "opcode.h"
 #include "tree.h"
 #include "hash.h"
-#include "inout.h"
 #include "table.h"
+#include "inout.h"
 #include "lua.h"
+#include "fallback.h"
+#include "luadebug.h"
 
-#define streq(s1,s2)	(s1[0]==s2[0]&&strcmp(s1+1,s2+1)==0)
 
 #define BUFFER_BLOCK 256
 
-Symbol *lua_table;
+Symbol *lua_table = NULL;
 static Word lua_ntable = 0;
-static Word lua_maxsymbol = 0;
+static Long lua_maxsymbol = 0;
 
-char **lua_constant;
+TaggedString **lua_constant = NULL;
 static Word lua_nconstant = 0;
-static Word lua_maxconstant = 0;
+static Long lua_maxconstant = 0;
 
 
+#define GARBAGE_BLOCK 1024
+#define MIN_GARBAGE_BLOCK (GARBAGE_BLOCK/2)
 
-#define MAXFILE 	20
+static void lua_nextvar (void);
-char  		       *lua_file[MAXFILE];
+static void setglobal (void);
-int      		lua_nfile;
+static void getglobal (void);
-
-/* 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;
+ Word n;
  lua_maxsymbol = BUFFER_BLOCK;
- lua_table = (Symbol *) calloc(lua_maxsymbol, sizeof(Symbol));
+ lua_table = newvector(lua_maxsymbol, Symbol);
- if (lua_table == NULL)
+ n = luaI_findsymbolbyname("next");
- {
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_next;
-  lua_error ("symbol table: not enough memory");
+ n = luaI_findsymbolbyname("dofile");
-  return;
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
- }
+ n = luaI_findsymbolbyname("setglobal");
- n = lua_findsymbol("type"); 
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = setglobal;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_type;
+ n = luaI_findsymbolbyname("getglobal");
- n = lua_findsymbol("tonumber");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = getglobal;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_obj2number;
+ n = luaI_findsymbolbyname("nextvar");
- n = lua_findsymbol("next");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_nextvar;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_next;
+ n = luaI_findsymbolbyname("type"); 
- n = lua_findsymbol("nextvar");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_type;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_nextvar;
+ n = luaI_findsymbolbyname("tonumber");
- n = lua_findsymbol("print");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_obj2number;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_print;
+ n = luaI_findsymbolbyname("print");
- n = lua_findsymbol("dofile");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_print;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldofile;
+ n = luaI_findsymbolbyname("dostring");
- n = lua_findsymbol("dostring");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
- s_tag(n) = T_CFUNCTION; s_fvalue(n) = lua_internaldostring;
+ n = luaI_findsymbolbyname("setfallback");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_setfallback;
+ n = luaI_findsymbolbyname("error");
+ s_tag(n) = LUA_T_CFUNCTION; s_fvalue(n) = luaI_error;
 }
 
 
@@ -77,124 +75,102 @@ static void lua_initsymbol (void)
 void lua_initconstant (void)
 {
  lua_maxconstant = BUFFER_BLOCK;
- lua_constant = (char **) calloc(lua_maxconstant, sizeof(char *));
+ lua_constant = newvector(lua_maxconstant, TaggedString *);
- 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)
+Word luaI_findsymbol (TreeNode *t)
 {
- char *n; 
  if (lua_table == NULL)
   lua_initsymbol(); 
- n = lua_varcreate(s);
+ if (t->varindex == NOT_USED)
- if (n == NULL)
- {
-  lua_error ("create symbol: not enough memory");
-  return -1;
- }
- if (indexstring(n) == UNMARKED_STRING)
  {
   if (lua_ntable == lua_maxsymbol)
   {
+   if (lua_maxsymbol >= MAX_WORD)
+     lua_error("symbol table overflow");
    lua_maxsymbol *= 2;
-   if (lua_maxsymbol > MAX_WORD)
+   if (lua_maxsymbol >= MAX_WORD)
-   {
+     lua_maxsymbol = MAX_WORD; 
-    lua_error("symbol table overflow");
+   lua_table = growvector(lua_table, lua_maxsymbol, Symbol);
-    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;
+  t->varindex = lua_ntable;
-  s_tag(lua_ntable) = T_NIL;
+  s_tag(lua_ntable) = LUA_T_NIL;
   lua_ntable++;
  }
- return indexstring(n);
+ return t->varindex;
+}
+
+
+Word luaI_findsymbolbyname (char *name)
+{
+  return luaI_findsymbol(lua_constcreate(name));
 }
 
 
 /*
-** Given a name, search it at constant table and return its index. If not
+** Given a tree node, check it is has a correspondent constant index. If not,
-** found, allocate it.
+** allocate it.
-** On error, return -1.
 */
-int lua_findconstant (char *s)
+Word luaI_findconstant (TreeNode *t)
 {
- char *n;
  if (lua_constant == NULL)
   lua_initconstant();
- n = lua_constcreate(s);
+ if (t->constindex == NOT_USED)
- if (n == NULL)
- {
-  lua_error ("create constant: not enough memory");
-  return -1;
- }
- if (indexstring(n) == UNMARKED_STRING)
  {
   if (lua_nconstant == lua_maxconstant)
   {
+   if (lua_maxconstant >= MAX_WORD)
+     lua_error("constant table overflow");
    lua_maxconstant *= 2;
-   if (lua_maxconstant > MAX_WORD)
+   if (lua_maxconstant >= MAX_WORD)
-   {
+     lua_maxconstant = MAX_WORD;
-    lua_error("constant table overflow");
+   lua_constant = growvector(lua_constant, lua_maxconstant, TaggedString *);
-    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;
+  t->constindex = lua_nconstant;
-  lua_constant[lua_nconstant] = n;
+  lua_constant[lua_nconstant] = &(t->ts);
   lua_nconstant++;
  }
- return indexstring(n);
+ return t->constindex;
+}
+
+
+Word  luaI_findconstantbyname (char *name)
+{
+  return luaI_findconstant(lua_constcreate(name));
 }
 
 
 /*
 ** Traverse symbol table objects
 */
-void lua_travsymbol (void (*fn)(Object *))
+static char *lua_travsymbol (int (*fn)(Object *))
 {
- int i;
+ Word i;
  for (i=0; i<lua_ntable; i++)
-  fn(&s_object(i));
+  if (fn(&s_object(i)))
+    return luaI_nodebysymbol(i)->ts.str;
+ return NULL;
 }
 
 
 /*
 ** Mark an object if it is a string or a unmarked array.
 */
-void lua_markobject (Object *o)
+int lua_markobject (Object *o)
 {
- if (tag(o) == T_STRING && indexstring(svalue(o)) == UNMARKED_STRING)
+ if (tag(o) == LUA_T_STRING && !tsvalue(o)->marked)
-  indexstring(svalue(o)) = MARKED_STRING;
+   tsvalue(o)->marked = 1;
- else if (tag(o) == T_ARRAY)
+ else if (tag(o) == LUA_T_ARRAY)
-  lua_hashmark (avalue(o));
+   lua_hashmark (avalue(o));
+ else if ((o->tag == LUA_T_FUNCTION || o->tag == LUA_T_MARK)
+           && !o->value.tf->marked)
+   o->value.tf->marked = 1;
+ return 0;
 }
 
 
@@ -204,106 +180,103 @@ void lua_markobject (Object *o)
 */
 void lua_pack (void)
 {
- /* mark stack strings */
+  static Long block = GARBAGE_BLOCK; /* when garbage collector will be called */
- lua_travstack(lua_markobject);
+  static Long nentity = 0;  /* counter of new entities (strings and arrays) */
- 
+  Long recovered = 0;
- /* mark symbol table strings */
+  if (nentity++ < block) return;
- lua_travsymbol(lua_markobject);
+  lua_travstack(lua_markobject); /* mark stack objects */
-
+  lua_travsymbol(lua_markobject); /* mark symbol table objects */
- lua_strcollector();
+  luaI_travlock(lua_markobject); /* mark locked objects */
- lua_hashcollector();
+  luaI_travfallbacks(lua_markobject);  /* mark fallbacks */
-
+  recovered += lua_strcollector();
- lua_nentity = 0;      /* reset counter */
+  recovered += lua_hashcollector();
+  recovered += luaI_funccollector();
+  nentity = 0;				/* reset counter */
+  block=(16*block-7*recovered)/12;	/* adapt block size */
+  if (block < MIN_GARBAGE_BLOCK) block = MIN_GARBAGE_BLOCK;
 } 
 
 
-/*
-** 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)
+static void lua_nextvar (void)
 {
- char *varname, *next;
+ Word next;
- Object *o = lua_getparam (1);
+ lua_Object o = lua_getparam(1);
- if (o == NULL)
+ if (o == LUA_NOOBJECT)
- { lua_error ("too few arguments to function `nextvar'"); return; }
+   lua_error("too few arguments to function `nextvar'");
- if (lua_getparam (2) != NULL)
+ if (lua_getparam(2) != LUA_NOOBJECT)
- { lua_error ("too many arguments to function `nextvar'"); return; }
+   lua_error("too many arguments to function `nextvar'");
- if (tag(o) == T_NIL)
+ if (lua_isnil(o))
+   next = 0;
+ else if (!lua_isstring(o))
  {
-  varname = 0;
+   lua_error("incorrect argument to function `nextvar'"); 
- }
+   return;  /* to avoid warnings */
- else if (tag(o) != T_STRING) 
- { 
-  lua_error ("incorrect argument to function `nextvar'"); 
-  return;
  }
  else
- {
+   next = luaI_findsymbolbyname(lua_getstring(o)) + 1;
-  varname = svalue(o);
+ while (next < lua_ntable && s_tag(next) == LUA_T_NIL) next++;
- }
+ if (next >= lua_ntable)
- next = lua_varnext(varname);
- if (next == NULL)
  {
   lua_pushnil();
   lua_pushnil();
  }
  else
  {
+  TreeNode *t = luaI_nodebysymbol(next);
   Object name;
-  tag(&name) = T_STRING;
+  tag(&name) = LUA_T_STRING;
-  svalue(&name) = next;
+  tsvalue(&name) = &(t->ts);
-  if (lua_pushobject (&name)) return;
+  luaI_pushobject(&name);
-  if (lua_pushobject (&s_object(indexstring(next)))) return;
+  luaI_pushobject(&s_object(next));
  }
 }
+
+
+static void setglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  lua_Object value = lua_getparam(2);
+  if (!lua_isstring(name))
+    lua_error("incorrect argument to function `setglobal'");
+  lua_pushobject(value);
+  lua_storeglobal(lua_getstring(name));
+}
+
+
+static void getglobal (void)
+{
+  lua_Object name = lua_getparam(1);
+  if (!lua_isstring(name))
+    lua_error("incorrect argument to function `getglobal'");
+  lua_pushobject(lua_getglobal(lua_getstring(name)));
+}
+
+
+static Object *functofind;
+static int checkfunc (Object *o)
+{
+  if (o->tag == LUA_T_FUNCTION)
+    return
+       ((functofind->tag == LUA_T_FUNCTION || functofind->tag == LUA_T_MARK)
+            && (functofind->value.tf == o->value.tf));
+  if (o->tag == LUA_T_CFUNCTION)
+    return
+       ((functofind->tag == LUA_T_CFUNCTION || functofind->tag == LUA_T_CMARK)
+            && (functofind->value.f == o->value.f));
+  return 0;
+}
+
+
+char *getobjname (lua_Object o, char **name)
+{ /* try to find a name for given function */
+  functofind = luaI_Address(o);
+  if ((*name = luaI_travfallbacks(checkfunc)) != NULL)
+    return "fallback";
+  else if ((*name = lua_travsymbol(checkfunc)) != NULL)
+    return "global";
+  else return "";
+}
+

table.h

@@ -1,32 +1,29 @@
 /*
 ** Module to control static tables
 ** TeCGraf - PUC-Rio
-** $Id: table.h,v 2.1 1994/04/20 22:07:57 celes Exp celes $
+** $Id: table.h,v 2.12 1995/10/17 11:58:41 roberto Exp roberto $
 */
 
 #ifndef table_h
 #define table_h
 
+#include "tree.h"
+#include "opcode.h"
+
 extern Symbol *lua_table;
-extern char  **lua_constant;
+extern TaggedString **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);
+Word  luaI_findsymbolbyname (char *name);
-int   lua_findconstant    (char *s);
+Word  luaI_findsymbol      (TreeNode *t);
-void  lua_travsymbol      (void (*fn)(Object *));
+Word  luaI_findconstant    (TreeNode *t);
-void  lua_markobject      (Object *o);
+Word  luaI_findconstantbyname (char *name);
+int   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

@@ -3,208 +3,121 @@
 ** TecCGraf - PUC-Rio
 */
  
-char *rcs_tree="$Id: $";
+char *rcs_tree="$Id: tree.c,v 1.13 1995/01/12 14:19:04 roberto Exp roberto $";
 
 
-#include <stdlib.h>
 #include <string.h>
 
+#include "mem.h"
 #include "lua.h"
 #include "tree.h"
+#include "table.h"
 
 
 #define lua_strcmp(a,b)	(a[0]<b[0]?(-1):(a[0]>b[0]?(1):strcmp(a,b))) 
 
 
-typedef struct TreeNode
+typedef struct StringNode {
-{
+  struct StringNode *next;
- struct TreeNode *right;
+  TaggedString ts;
- struct TreeNode *left;
+} StringNode;
- Word            index;
+
- char            str[1];        /* \0 byte already reserved */
+static StringNode *string_root = NULL;
-} 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. 
+** Insert a new constant/variable at the tree. 
 */
-static char *tree_create (TreeNode **node, char *str)
+static TreeNode *tree_create (TreeNode **node, char *str)
 {
  if (*node == NULL)
  {
-  *node = (TreeNode *) malloc (sizeof(TreeNode)+strlen(str));
+  *node = (TreeNode *) luaI_malloc(sizeof(TreeNode)+strlen(str));
-  if (*node == NULL)
-   lua_error ("memoria insuficiente\n");
   (*node)->left = (*node)->right = NULL;
-  strcpy((*node)->str, str);
+  strcpy((*node)->ts.str, str);
-  (*node)->index = UNMARKED_STRING;
+  (*node)->ts.marked = 0;
-  return (*node)->str;
+  (*node)->ts.hash = 0;
+  (*node)->varindex = (*node)->constindex = NOT_USED;
+  return *node;
  }
  else
  {
-  int c = lua_strcmp(str, (*node)->str);
+  int c = lua_strcmp(str, (*node)->ts.str);
   if (c < 0) 
    return tree_create(&(*node)->left, str);
   else if (c > 0)
    return tree_create(&(*node)->right, str);
   else
-   return (*node)->str;
+   return *node;
  }
 }
 
-char *lua_strcreate (char *str) 
+TaggedString *lua_createstring (char *str) 
 {
- return tree_create(&string_root, str);
+  StringNode *newString;
+  if (str == NULL) return NULL;
+  lua_pack();
+  newString = (StringNode *)luaI_malloc(sizeof(StringNode)+strlen(str));
+  newString->ts.marked = 0;
+  newString->ts.hash = 0;
+  strcpy(newString->ts.str, str);
+  newString->next = string_root;
+  string_root = newString;
+  return &(newString->ts);
 }
 
-char *lua_constcreate (char *str) 
+
+TreeNode *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
+** This function traverse the string list freeing unindexed strings
 */
-void lua_strcollector (void)
+Long lua_strcollector (void)
 {
- string_root = lua_travcollector(string_root);
+  StringNode *curr = string_root, *prev = NULL;
-}
+  Long counter = 0;
-
+  while (curr)
-/*
-** 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);
+    StringNode *next = curr->next;
-   return result != NULL ? result : node->right;
+    if (!curr->ts.marked)
+    {
+      if (prev == NULL) string_root = next;
+      else prev->next = next;
+      luaI_free(curr);
+      ++counter;
+    }
+    else
+    {
+      curr->ts.marked = 0;
+      prev = curr;
+    }
+    curr = next;
   }
-  else
+  return counter;
-   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
+** Traverse the constant tree looking for a specific symbol number
 */
-static char *tree_name (TreeNode *node, Word index)
+static TreeNode *nodebysymbol (TreeNode *root, Word symbol)
 {
- if (node == NULL) return NULL;
+  TreeNode *t;
- if (node->index == index) return node->str;
+  if (root == NULL) return NULL;
- else
+  if (root->varindex == symbol) return root;
- {
+  t = nodebysymbol(root->left, symbol);
-  char *result = tree_name(node->left, index);
+  if (t) return t;
-  return result != NULL ? result : tree_name(node->right, index);
+  return nodebysymbol(root->right, symbol);
- }
 }
-char *lua_varname (Word index)
+
+TreeNode *luaI_nodebysymbol (Word symbol)
 {
- return tree_name(variable_root, index);
+  return nodebysymbol(constant_root, symbol); 
 }
+

tree.h

@@ -1,27 +1,37 @@
 /*
 ** tree.h
 ** TecCGraf - PUC-Rio
-** $Id: $
+** $Id: tree.h,v 1.9 1995/01/12 14:19:04 roberto Exp roberto $
 */
 
 #ifndef tree_h
 #define tree_h
 
-#include "opcode.h"
+#include "types.h"
+
+#define NOT_USED  0xFFFE
 
 
-#define UNMARKED_STRING	0xFFFF
+typedef struct TaggedString
-#define MARKED_STRING   0xFFFE
+{
-#define MAX_WORD        0xFFFD
+  unsigned long hash;  /* 0 if not initialized */
+  char marked;   /* for garbage collection */
+  char str[1];   /* \0 byte already reserved */
+} TaggedString;
  
-#define indexstring(s) (*(((Word *)s)-1))
+typedef struct TreeNode
+{
+ struct TreeNode *right;
+ struct TreeNode *left;
+ unsigned short varindex;  /* != NOT_USED  if this is a symbol */
+ unsigned short constindex;  /* != NOT_USED  if this is a constant */
+ TaggedString ts;
+} TreeNode;
 
 
-char *lua_strcreate    (char *str);
+TaggedString *lua_createstring (char *str);
-char *lua_constcreate  (char *str);
+TreeNode *lua_constcreate  (char *str);
-char *lua_varcreate    (char *str);
+Long lua_strcollector (void);
-void  lua_strcollector (void);
+TreeNode *luaI_nodebysymbol (Word symbol);
-char *lua_varnext      (char *n);
-char *lua_varname      (Word index);
 
 #endif

types.h

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

ugly.h

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