new way to call functions, plus several small changes. This is

a temporary version!

1 files changed, 633 insertions, 665 deletions

diff --git a/opcode.c b/opcode.c
index 9531f558..268fe18f 100644
--- a/opcode.c
+++ b/opcode.c
@@ -3,11 +3,12 @@
 ** TecCGraf - PUC-Rio
 */
 
-char *rcs_opcode="$Id: opcode.c,v 2.11 1994/11/01 17:54:31 roberto Exp roberto $";
+char *rcs_opcode="$Id: opcode.c,v 2.12 1994/11/01 18:25:20 roberto Exp roberto $";
 
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
+#include <setjmp.h>
 #include <math.h>
 #ifdef __GNUC__
 #include <floatingpoint.h>
@@ -19,57 +20,69 @@ char *rcs_opcode="$Id: opcode.c,v 2.11 1994/11/01 17:54:31 roberto Exp roberto $
 #include "table.h"
 #include "lua.h"
 
-#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0))
-#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0))
+#define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0))
+#define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0))
 
 
 #define STACK_BUFFER (STACKGAP+128)
 
 static Long    maxstack;
 static Object *stack=NULL;
-static Object *top, *base;
+static Object *top;
+
+static int CBase;  /* when Lua calls C or C calls Lua, points to the */
+                   /* first slot after the last parameter. */
+static int CnResults = 0; /* when Lua calls C, has the number of parameters; */
+                          /* when C calls Lua, has the number of results. */
+
+static jmp_buf *errorJmp;
+
+static int lua_execute (Byte *pc, int base);
+
+
+
+/*
+** Reports an error, and jumps up to the available recover label
+*/
+void lua_error (char *s)
+{
+  fprintf (stderr, "lua: %s\n", s);
+  if (errorJmp)
+    longjmp(*errorJmp, 1);
+  else
+    exit(1);
+}
 
 
 /*
 ** Init stack
 */
-static int lua_initstack (void)
+static void lua_initstack (void)
 {
  maxstack = STACK_BUFFER;
  stack = (Object *)calloc(maxstack, sizeof(Object));
  if (stack == NULL)
- {
-  lua_error("stack - not enough memory");
-  return 1;
- }
- tag(stack) = T_MARK;
- top = base = stack+1;
- return 0;
+   lua_error("stack - not enough memory");
+ top = stack;
 }
 
 
 /*
 ** Check stack overflow and, if necessary, realloc vector
 */
-static int lua_checkstack (Word n)
+static void lua_checkstack (Word n)
 {
  if (stack == NULL)
   return lua_initstack();
  if (n > maxstack)
  {
-  Word t = top-stack;
-  Word b = base-stack;
+  int t = top-stack;
   maxstack *= 2;
   stack = (Object *)realloc(stack, maxstack*sizeof(Object));
   if (stack == NULL)
-  {
-   lua_error("stack - not enough memory");
-   return 1;
-  }
+    lua_error("stack - not enough memory");
   top = stack + t;
-  base = stack + b;
  }
- return 0;
 }
 
 
@@ -82,10 +95,7 @@ static char *lua_strconc (char *l, char *r)
  static char buffer[1024];
  int n = strlen(l)+strlen(r)+1;
  if (n > 1024)
- {
-  lua_error ("string too large");
-  return NULL;
- }
+   lua_error ("string too large");
  return strcat(strcpy(buffer,l),r);
 }
 
@@ -99,59 +109,46 @@ static int ToReal (char* s, float* f)
 /*
 ** Convert, if possible, to a number object.
 ** Return 0 if success, not 0 if error.
-*/ 
+*/
 static int lua_tonumber (Object *obj)
 {
- if (tag(obj) != T_STRING)
- {
-  lua_reportbug ("unexpected type at conversion to number");
-  return 1;
- }
+ if (tag(obj) != LUA_T_STRING)
+   return 1;;
  if (!ToReal(svalue(obj), &nvalue(obj)))
- {
-  lua_reportbug ("string to number convertion failed");
-  return 2;
- }
- tag(obj) = T_NUMBER;
+   return 2;
+ tag(obj) = LUA_T_NUMBER;
  return 0;
 }
 
 /*
 ** Test if it is possible to convert an object to a number object.
 ** If possible, return the converted object, otherwise return nil object.
-*/ 
+*/
 static Object *lua_convtonumber (Object *obj)
 {
  static Object cvt;
- 
- if (tag(obj) == T_NUMBER)
+ if (tag(obj) == LUA_T_NUMBER)
  {
   cvt = *obj;
   return &cvt;
  }
-  
- if (tag(obj) == T_STRING && ToReal(svalue(obj), &nvalue(&cvt)))
-  tag(&cvt) = T_NUMBER;
- else 
-  tag(&cvt) = T_NIL;
-
+ if (tag(obj) == LUA_T_STRING && ToReal(svalue(obj), &nvalue(&cvt)))
+  tag(&cvt) = LUA_T_NUMBER;
+ else
+  tag(&cvt) = LUA_T_NIL;
  return &cvt;
 }
 
 
-
 /*
 ** Convert, if possible, to a string tag
 ** Return 0 in success or not 0 on error.
-*/ 
+*/
 static int lua_tostring (Object *obj)
 {
  static char s[256];
- if (tag(obj) != T_NUMBER)
- {
-  lua_reportbug ("unexpected type at conversion to string");
-  return 1;
- }
+ if (tag(obj) != LUA_T_NUMBER)
+   lua_reportbug ("unexpected type at conversion to string");
  if ((int) nvalue(obj) == nvalue(obj))
   sprintf (s, "%d", (int) nvalue(obj));
  else
@@ -159,487 +156,67 @@ static int lua_tostring (Object *obj)
  svalue(obj) = lua_createstring(s);
  if (svalue(obj) == NULL)
   return 1;
- tag(obj) = T_STRING;
+ tag(obj) = LUA_T_STRING;
  return 0;
 }
 
 
 /*
-** Execute the given opcode. Return 0 in success or 1 on error.
+** Adjust stack. Set top to the given value, pushing NILs if needed.
 */
-int lua_execute (Byte *pc)
+static void adjust_top (Object *newtop)
 {
- Word oldbase;
-
- if (stack == NULL)
-  lua_initstack();
-
- oldbase = base-stack;
- base = top;
- while (1)
- {
-  OpCode opcode;
-  switch (opcode = (OpCode)*pc++)
-  {
-   case PUSHNIL: tag(top++) = T_NIL; break;
-   
-   case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break;
-   case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break;
-   case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break;
-
-   case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break;
-   
-   case PUSHWORD: 
-   {
-    CodeWord code;
-    get_word(code,pc);
-    tag(top) = T_NUMBER; nvalue(top++) = code.w;
-   }
-   break;
-   
-   case PUSHFLOAT:
-   {
-    CodeFloat code;
-    get_float(code,pc);
-    tag(top) = T_NUMBER; nvalue(top++) = code.f;
-   }
-   break;
+  while (top < newtop) tag(top++) = LUA_T_NIL;
+  top = newtop;  /* top could be bigger than newtop */
+}
 
-   case PUSHSTRING:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    tag(top) = T_STRING; svalue(top++) = lua_constant[code.w];
-   }
-   break;
 
-   case PUSHFUNCTION:
-   {
-    CodeCode code;
-    get_code(code,pc);
-    tag(top) = T_FUNCTION; bvalue(top++) = code.b;
-   }
-   break;
-   
-   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
-   case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
-   case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
-   case PUSHLOCAL9: *top++ = *(base + (int)(opcode-PUSHLOCAL0)); break;
-   
-   case PUSHLOCAL: *top++ = *(base + (*pc++)); break;
-   
-   case PUSHGLOBAL: 
-   {
-    CodeWord code;
-    get_word(code,pc);
-    *top++ = s_object(code.w);
-   }
-   break;
-   
-   case PUSHINDEXED:
-   {
-    int s = lua_pushsubscript();
-    if (s == 1) return 1;
-   }
-   break;
-   
-   case PUSHMARK: tag(top++) = T_MARK; break;
-   case PUSHMARKMET: 
-   {
-     Object receiver = *(top-2);
-     if (lua_pushsubscript() == 1) return 1;
-     tag(top++) = T_MARK;
-     *(top++) = receiver;
-     break;
-   }
-   
-   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
-   case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
-   case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
-   case STORELOCAL9: *(base + (int)(opcode-STORELOCAL0)) = *(--top); break;
-    
-   case STORELOCAL: *(base + (*pc++)) = *(--top); break;
-   
-   case STOREGLOBAL:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    s_object(code.w) = *(--top);
-   }
-   break;
-
-   case STOREINDEXED0:
-   {
-    int s = lua_storesubscript();
-    if (s == 1) return 1;
-   }
-   break;
-   
-   case STOREINDEXED:
-   {
-    int n = *pc++;
-    if (tag(top-3-n) != T_ARRAY)
-    {
-     lua_reportbug ("indexed expression not a table");
-     return 1;
-    }
-    {
-     Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
-     if (h == NULL) return 1;
-     *h = *(top-1);
-    }
-    top--;
-   }
-   break;
-   
-   case STORELIST0:
-   case STORELIST:
-   {
-    int m, n;
-    Object *arr;
-    if (opcode == STORELIST0) m = 0;
-    else m = *(pc++) * FIELDS_PER_FLUSH;
-    n = *(pc++);
-    arr = top-n-1;
-    if (tag(arr) != T_ARRAY)
-    {
-     lua_reportbug ("internal error - table expected");
-     return 1;
-    }
-    while (n)
-    {
-     tag(top) = T_NUMBER; nvalue(top) = n+m;
-     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
-     top--;
-     n--;
-    }
-   }
-   break;
-   
-   case STORERECORD:
-   {
-    int n = *(pc++);
-    Object *arr = top-n-1;
-    if (tag(arr) != T_ARRAY)
-    {
-     lua_reportbug ("internal error - table expected");
-     return 1;
-    }
-    while (n)
-    {
-     CodeWord code;
-     get_word(code,pc);
-     tag(top) = T_STRING; svalue(top) = lua_constant[code.w];
-     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
-     top--;
-     n--;
-    }
-   }
-   break;
-   
-   case ADJUST:
-   {
-    Object *newtop = base + *(pc++);
-    while (top < newtop) tag(top++) = T_NIL;
-    top = newtop;  /* top could be bigger than newtop */
-   }
-   break;
-   
-   case CREATEARRAY:
-   {
-    CodeWord size;
-    get_word(size,pc);
-    top++;
-    avalue(top-1) = lua_createarray(size.w);
-    if (avalue(top-1) == NULL)
-     return 1;
-    tag(top-1) = T_ARRAY;
-   }
-   break;
-   
-   case EQOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    --top;
-    if (tag(l) != tag(r)) 
-     tag(top-1) = T_NIL;
-    else
-    {
-     switch (tag(l))
-     {
-      case T_NIL:       tag(top-1) = T_NUMBER; break;
-      case T_NUMBER:    tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break;
-      case T_ARRAY:     tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break;
-      case T_FUNCTION:  tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break;
-      case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break;
-      case T_USERDATA:  tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break;
-      case T_STRING:    tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break;
-      case T_MARK:      return 1;
-     }
-    }
-    nvalue(top-1) = 1;
-   }
-   break;
-    
-   case LTOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    --top;
-    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
-     tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL;
-    else
-    {
-     if (tostring(l) || tostring(r))
-      return 1;
-     tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL;
-    }
-    nvalue(top-1) = 1; 
-   }
-   break;
-   
-   case LEOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    --top;
-    if (tag(l) == T_NUMBER && tag(r) == T_NUMBER)
-     tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL;
-    else
-    {
-     if (tostring(l) || tostring(r))
-      return 1;
-     tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL;
-    }
-    nvalue(top-1) = 1; 
-   }
-   break;
-   
-   case ADDOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tonumber(r) || tonumber(l))
-     return 1;
-    nvalue(l) += nvalue(r);
-    --top;
-   }
-   break; 
-   
-   case SUBOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tonumber(r) || tonumber(l))
-     return 1;
-    nvalue(l) -= nvalue(r);
-    --top;
-   }
-   break; 
-   
-   case MULTOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tonumber(r) || tonumber(l))
-     return 1;
-    nvalue(l) *= nvalue(r);
-    --top;
-   }
-   break; 
-   
-   case DIVOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tonumber(r) || tonumber(l))
-     return 1;
-    nvalue(l) /= nvalue(r);
-    --top;
-   }
-   break; 
-   
-   case POWOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tonumber(r) || tonumber(l))
-     return 1;
-    nvalue(l) = pow(nvalue(l), nvalue(r));
-    --top;
-   }
-   break;
-   
-   case CONCOP:
-   {
-    Object *l = top-2;
-    Object *r = top-1;
-    if (tostring(r) || tostring(l))
-     return 1;
-    svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
-    if (svalue(l) == NULL)
-     return 1;
-    --top;
-   }
-   break; 
-   
-   case MINUSOP:
-    if (tonumber(top-1))
-     return 1;
-    nvalue(top-1) = - nvalue(top-1);
-   break; 
-   
-   case NOTOP:
-    tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL;
-   break; 
-   
-   case ONTJMP:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    if (tag(top-1) != T_NIL) pc += code.w;
-   }
-   break;
-   
-   case ONFJMP:    
-   {
-    CodeWord code;
-    get_word(code,pc);
-    if (tag(top-1) == T_NIL) pc += code.w;
-   }
-   break;
-   
-   case JMP:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    pc += code.w;
-   }
-   break;
-    
-   case UPJMP:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    pc -= code.w;
-   }
-   break;
-   
-   case IFFJMP:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    top--;
-    if (tag(top) == T_NIL) pc += code.w;
-   }
-   break;
+/*
+** Call a C function. CBase will point to the top of the stack,
+** and CnResults is the number of parameters. Returns an index
+** to the first result from C.
+*/
+static int callC (lua_CFunction func, int base)
+{
+  int oldBase = CBase;
+  int oldCnResults = CnResults;
+  int firstResult;
+  CnResults = (top-stack) - base;
+  CBase = base+CnResults;  /* incorporate parameters on the stack */
+  (*func)();
+  firstResult = CBase;
+  CBase = oldBase;
+  CnResults = oldCnResults;
+  return firstResult;
+}
 
-   case IFFUPJMP:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    top--;
-    if (tag(top) == T_NIL) pc -= code.w;
-   }
-   break;
 
-   case POP: --top; break;
-   
-   case CALLFUNC:
-   {
-    Byte *newpc;
-    Object *b = top-1;
-    while (tag(b) != T_MARK) b--;
-    if (tag(b-1) == T_FUNCTION)
-    {
-     lua_debugline = 0;                 /* always reset debug flag */
-     newpc = bvalue(b-1);
-     bvalue(b-1) = pc;                  /* store return code */
-     nvalue(b) = (base-stack);          /* store base value */
-     base = b+1;
-     pc = newpc;
-     if (lua_checkstack(STACKGAP+(base-stack)))
-      return 1;
-    }
-    else if (tag(b-1) == T_CFUNCTION)
-    {
-     int nparam; 
-     lua_debugline = 0;                 /* always reset debug flag */
-     nvalue(b) = (base-stack);          /* store base value */
-     base = b+1;
-     nparam = top-base;                 /* number of parameters */
-     (fvalue(b-1))();                   /* call C function */
-     
-     /* shift returned values */
-     { 
-      int i;
-      int nretval = top - base - nparam;
-      top = base - 2;
-      base = stack + (int) nvalue(base-1);
-      for (i=0; i<nretval; i++)
-      {
-       *top = *(top+nparam+2);
-       ++top;
-      }
-     }
-    }
-    else
-    {
-     lua_reportbug ("call expression not a function");
-     return 1;
-    }
-   }
-   break;
-   
-   case RETCODE:
-   {
-    int i;
-    int shift = *pc++;
-    int nretval = top - base - shift;
-    top = base - 2;
-    pc = bvalue(base-2);
-    base = stack + (int) nvalue(base-1);
-    for (i=0; i<nretval; i++)
-    {
-     *top = *(top+shift+2);
-     ++top;
-    }
-   }
-   break;
-   
-   case HALT:
-    base = stack+oldbase;
-   return 0;            /* success */
-   
-   case SETFUNCTION:
-   {
-    CodeCode file; 
-    CodeWord func;
-    get_code(file,pc);
-    get_word(func,pc);
-    if (lua_pushfunction ((char *)file.b, func.w))
-     return 1;
-   }
-   break;
-   
-   case SETLINE:
-   {
-    CodeWord code;
-    get_word(code,pc);
-    lua_debugline = code.w;
-   }
-   break;
-   
-   case RESET:
-    lua_popfunction ();
-   break;
-   
-   default:
-    lua_error ("internal error - opcode didn't match");
-   return 1;
+/*
+** Call a function (C or Lua). The parameters must be on the stack,
+** between [stack+base,top). When returns, the results are on the stack,
+** between [stack+whereRes,top). The number of results is nResults, unless
+** nResults=MULT_RET.
+*/
+static void do_call (Object *func, int base, int nResults, int whereRes)
+{
+  int firstResult;
+  if (tag(func) == LUA_T_CFUNCTION)
+    firstResult = callC(fvalue(func), base);
+  else if (tag(func) == LUA_T_FUNCTION)
+    firstResult = lua_execute(bvalue(func), base);
+  else
+   lua_reportbug ("call expression not a function");
+  /* adjust the number of results */
+  if (nResults != MULT_RET && top - (stack+firstResult) != nResults)
+    adjust_top(stack+firstResult+nResults);
+  /* move results to the given position */
+  if (firstResult != whereRes)
+  {
+    int i = top - (stack+firstResult);  /* number of results */
+    top -= firstResult-whereRes;
+    while (i--)
+      *(stack+whereRes+i) = *(stack+firstResult+i);
   }
- }
 }
 
 
@@ -649,7 +226,7 @@ int lua_execute (Byte *pc)
 int lua_pushsubscript (void)
 {
  --top;
- if (tag(top-1) != T_ARRAY)
+ if (tag(top-1) != LUA_T_ARRAY)
  {
   lua_reportbug ("indexed expression not a table");
   return 1;
@@ -668,7 +245,7 @@ int lua_pushsubscript (void)
 */
 int lua_storesubscript (void)
 {
- if (tag(top-3) != T_ARRAY)
+ if (tag(top-3) != LUA_T_ARRAY)
  {
   lua_reportbug ("indexed expression not a table");
   return 1;
@@ -693,61 +270,89 @@ void lua_travstack (void (*fn)(Object *))
   fn (o);
 }
 
+
 /*
-** Open file, generate opcode and execute global statement. Return 0 on
-** success or 1 on error.
+** Executes a main procedure. Uses as Base the top of the stack, as it
+** uses no parameters and left no results.
 */
-int lua_dofile (char *filename)
+static void do_main (Byte *main)
 {
- if (lua_openfile (filename)) return 1;
- if (lua_parse ()) { lua_closefile (); return 1; }
- lua_closefile ();
- return 0;
+  if (main)
+  {
+    Object f;
+    tag(&f) = LUA_T_FUNCTION; bvalue(&f) = main;
+    do_call(&f, top-stack, 0, top-stack);
+    free(main);
+  }
 }
 
+
 /*
-** Generate opcode stored on string and execute global statement. Return 0 on
+** Open file, generate opcode and execute global statement. Return 0 on
 ** success or 1 on error.
 */
-int lua_dostring (char *string)
+int lua_dofile (char *filename)
 {
- if (lua_openstring (string)) return 1;
- if (lua_parse ()) return 1;
- lua_closestring();
- return 0;
+  jmp_buf myErrorJmp;
+  int status;
+  jmp_buf *oldErr = errorJmp;
+  errorJmp = &myErrorJmp;
+  if (setjmp(myErrorJmp) == 0)
+  {
+    lua_openfile (filename);
+    do_main(lua_parse());
+    status = 0;
+  }
+  else
+    status = 1;
+  lua_closefile();
+  errorJmp = oldErr;
+  return status;
 }
 
 /*
-** Execute the given function. Return 0 on success or 1 on error.
+** Generate opcode stored on string and execute global statement. Return 0 on
+** success or 1 on error.
 */
-int lua_call (char *functionname, int nparam)
+int lua_dostring (char *string)
 {
- static Byte startcode[] = {CALLFUNC, HALT};
- int i; 
- Object func = s_object(lua_findsymbol(functionname));
- if (tag(&func) != T_FUNCTION) return 1;
- for (i=1; i<=nparam; i++)
-  *(top-i+2) = *(top-i);
- top += 2;
- tag(top-nparam-1) = T_MARK;
- *(top-nparam-2) = func;
- return (lua_execute (startcode));
+  jmp_buf myErrorJmp;
+  int status;
+  jmp_buf *oldErr = errorJmp;
+  errorJmp = &myErrorJmp;
+  if (setjmp(myErrorJmp) == 0)
+  {
+    lua_openstring(string);
+    do_main(lua_parse());
+    status = 0;
+  }
+  else
+    status = 1;
+  lua_closestring();
+  errorJmp = oldErr;
+  return status;
 }
 
 /*
 ** Execute the given lua function. Return 0 on success or 1 on error.
 */
-int lua_callfunction (Object *function, int nparam)
+int lua_callfunction (Object *function)
 {
- static Byte startcode[] = {CALLFUNC, HALT};
- int i; 
- if (tag(function) != T_FUNCTION) return 1;
- for (i=1; i<=nparam; i++)
-  *(top-i+2) = *(top-i);
- top += 2;
- tag(top-nparam-1) = T_MARK;
- *(top-nparam-2) = *function;
- return (lua_execute (startcode));
+  jmp_buf myErrorJmp;
+  int status;
+  jmp_buf *oldErr = errorJmp;
+  errorJmp = &myErrorJmp;
+  if (setjmp(myErrorJmp) == 0)
+  {
+    do_call(function, CBase, MULT_RET, CBase);
+    CnResults = (top-stack) - CBase;  /* number of results */
+    CBase += CnResults;  /* incorporate results on the stack */
+    status = 0;
+  }
+  else
+    status = 1;
+  errorJmp = oldErr;
+  return status;
 }
 
 /*
@@ -756,8 +361,8 @@ int lua_callfunction (Object *function, int nparam)
 */
 Object *lua_getparam (int number)
 {
- if (number <= 0 || number > top-base) return NULL;
- return (base+number-1);
+ if (number <= 0 || number > CnResults) return NULL;
+ return (stack+(CBase-CnResults+number-1));
 }
 
 /*
@@ -765,7 +370,7 @@ Object *lua_getparam (int number)
 */
 real lua_getnumber (Object *object)
 {
- if (object == NULL || tag(object) == T_NIL) return 0.0;
+ if (object == NULL || tag(object) == LUA_T_NIL) return 0.0;
  if (tonumber (object)) return 0.0;
  else                   return (nvalue(object));
 }
@@ -775,7 +380,7 @@ real lua_getnumber (Object *object)
 */
 char *lua_getstring (Object *object)
 {
- if (object == NULL || tag(object) == T_NIL) return NULL;
+ if (object == NULL || tag(object) == LUA_T_NIL) return NULL;
  if (tostring (object)) return NULL;
  else                   return (svalue(object));
 }
@@ -785,7 +390,7 @@ char *lua_getstring (Object *object)
 */
 char *lua_copystring (Object *object)
 {
- if (object == NULL || tag(object) == T_NIL) return NULL;
+ if (object == NULL || tag(object) == LUA_T_NIL) return NULL;
  if (tostring (object)) return NULL;
  else                   return (strdup(svalue(object)));
 }
@@ -796,7 +401,7 @@ char *lua_copystring (Object *object)
 lua_CFunction lua_getcfunction (Object *object)
 {
  if (object == NULL) return NULL;
- if (tag(object) != T_CFUNCTION) return NULL;
+ if (tag(object) != LUA_T_CFUNCTION) return NULL;
  else                            return (fvalue(object));
 }
 
@@ -806,7 +411,7 @@ lua_CFunction lua_getcfunction (Object *object)
 void *lua_getuserdata (Object *object)
 {
  if (object == NULL) return NULL;
- if (tag(object) != T_USERDATA) return NULL;
+ if (tag(object) != LUA_T_USERDATA) return NULL;
  else                           return (uvalue(object));
 }
 
@@ -816,7 +421,7 @@ void *lua_getuserdata (Object *object)
 void *lua_gettable (Object *object)
 {
  if (object == NULL) return NULL;
- if (tag(object) != T_ARRAY) return NULL;
+ if (tag(object) != LUA_T_ARRAY) return NULL;
  else                        return (avalue(object));
 }
 
@@ -827,12 +432,12 @@ void *lua_gettable (Object *object)
 Object *lua_getfield (Object *object, char *field)
 {
  if (object == NULL) return NULL;
- if (tag(object) != T_ARRAY)
+ if (tag(object) != LUA_T_ARRAY)
   return NULL;
  else
  {
   Object ref;
-  tag(&ref) = T_STRING;
+  tag(&ref) = LUA_T_STRING;
   svalue(&ref) = lua_constant[lua_findconstant(field)];
   return (lua_hashget(avalue(object), &ref));
  }
@@ -845,12 +450,12 @@ Object *lua_getfield (Object *object, char *field)
 Object *lua_getindexed (Object *object, float index)
 {
  if (object == NULL) return NULL;
- if (tag(object) != T_ARRAY)
+ if (tag(object) != LUA_T_ARRAY)
   return NULL;
  else
  {
   Object ref;
-  tag(&ref) = T_NUMBER;
+  tag(&ref) = LUA_T_NUMBER;
   nvalue(&ref) = index;
   return (lua_hashget(avalue(object), &ref));
  }
@@ -867,23 +472,12 @@ Object *lua_getglobal (char *name)
 }
 
 /*
-** Pop and return an object
-*/
-Object *lua_pop (void)
-{
- if (top <= base) return NULL;
- top--;
- return top;
-}
-
-/*
 ** Push a nil object
 */
 int lua_pushnil (void)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top++) = T_NIL;
+ lua_checkstack(top-stack+1);
+ tag(top++) = LUA_T_NIL;
  return 0;
 }
 
@@ -892,9 +486,8 @@ int lua_pushnil (void)
 */
 int lua_pushnumber (real n)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top) = T_NUMBER; nvalue(top++) = n;
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_NUMBER; nvalue(top++) = n;
  return 0;
 }
 
@@ -903,9 +496,8 @@ int lua_pushnumber (real n)
 */
 int lua_pushstring (char *s)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top) = T_STRING; 
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_STRING;
  svalue(top++) = lua_createstring(s);
  return 0;
 }
@@ -915,9 +507,8 @@ int lua_pushstring (char *s)
 */
 int lua_pushcfunction (lua_CFunction fn)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top) = T_CFUNCTION; fvalue(top++) = fn;
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_CFUNCTION; fvalue(top++) = fn;
  return 0;
 }
 
@@ -926,9 +517,8 @@ int lua_pushcfunction (lua_CFunction fn)
 */
 int lua_pushuserdata (void *u)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top) = T_USERDATA; uvalue(top++) = u;
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_USERDATA; uvalue(top++) = u;
  return 0;
 }
 
@@ -937,9 +527,8 @@ int lua_pushuserdata (void *u)
 */
 int lua_pushtable (void *t)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
- tag(top) = T_ARRAY; avalue(top++) = t;
+ lua_checkstack(top-stack+1);
+ tag(top) = LUA_T_ARRAY; avalue(top++) = t;
  return 0;
 }
 
@@ -948,21 +537,20 @@ int lua_pushtable (void *t)
 */
 int lua_pushobject (Object *o)
 {
- if (lua_checkstack(top-stack+1) == 1)
-  return 1;
+ lua_checkstack(top-stack+1);
  *top++ = *o;
  return 0;
 }
 
 /*
-** Store top of the stack at a global variable array field. 
+** Store top of the stack at a global variable array field.
 ** Return 1 on error, 0 on success.
 */
 int lua_storeglobal (char *name)
 {
  int n = lua_findsymbol (name);
  if (n < 0) return 1;
- if (tag(top-1) == T_MARK) return 1;
+ if (tag(top-1) == LUA_T_MARK) return 1;
  s_object(n) = *(--top);
  return 0;
 }
@@ -973,16 +561,16 @@ int lua_storeglobal (char *name)
 */
 int lua_storefield (lua_Object object, char *field)
 {
- if (tag(object) != T_ARRAY)
+ if (tag(object) != LUA_T_ARRAY)
   return 1;
  else
  {
   Object ref, *h;
-  tag(&ref) = T_STRING;
+  tag(&ref) = LUA_T_STRING;
   svalue(&ref) = lua_createstring(field);
   h = lua_hashdefine(avalue(object), &ref);
   if (h == NULL) return 1;
-  if (tag(top-1) == T_MARK) return 1;
+  if (tag(top-1) == LUA_T_MARK) return 1;
   *h = *(--top);
  }
  return 0;
@@ -994,16 +582,16 @@ int lua_storefield (lua_Object object, char *field)
 */
 int lua_storeindexed (lua_Object object, float index)
 {
- if (tag(object) != T_ARRAY)
+ if (tag(object) != LUA_T_ARRAY)
   return 1;
  else
  {
   Object ref, *h;
-  tag(&ref) = T_NUMBER;
+  tag(&ref) = LUA_T_NUMBER;
   nvalue(&ref) = index;
   h = lua_hashdefine(avalue(object), &ref);
   if (h == NULL) return 1;
-  if (tag(top-1) == T_MARK) return 1;
+  if (tag(top-1) == LUA_T_MARK) return 1;
   *h = *(--top);
  }
  return 0;
@@ -1015,7 +603,7 @@ int lua_storeindexed (lua_Object object, float index)
 */
 int lua_isnil (Object *object)
 {
- return (object != NULL && tag(object) == T_NIL);
+ return (object != NULL && tag(object) == LUA_T_NIL);
 }
 
 /*
@@ -1023,7 +611,7 @@ int lua_isnil (Object *object)
 */
 int lua_isnumber (Object *object)
 {
- return (object != NULL && tag(object) == T_NUMBER);
+ return (object != NULL && tag(object) == LUA_T_NUMBER);
 }
 
 /*
@@ -1031,7 +619,7 @@ int lua_isnumber (Object *object)
 */
 int lua_isstring (Object *object)
 {
- return (object != NULL && tag(object) == T_STRING);
+ return (object != NULL && tag(object) == LUA_T_STRING);
 }
 
 /*
@@ -1039,7 +627,7 @@ int lua_isstring (Object *object)
 */
 int lua_istable (Object *object)
 {
- return (object != NULL && tag(object) == T_ARRAY);
+ return (object != NULL && tag(object) == LUA_T_ARRAY);
 }
 
 /*
@@ -1047,15 +635,15 @@ int lua_istable (Object *object)
 */
 int lua_isfunction (Object *object)
 {
- return (object != NULL && tag(object) == T_FUNCTION);
+ return (object != NULL && tag(object) == LUA_T_FUNCTION);
 }
- 
+
 /*
 ** Given an object handle, return if it is a cfunction one.
 */
 int lua_iscfunction (Object *object)
 {
- return (object != NULL && tag(object) == T_CFUNCTION);
+ return (object != NULL && tag(object) == LUA_T_CFUNCTION);
 }
 
 /*
@@ -1063,21 +651,10 @@ int lua_iscfunction (Object *object)
 */
 int lua_isuserdata (Object *object)
 {
- return (object != NULL && tag(object) == T_USERDATA);
-}
-
-/*
-** Internal function: return an object type. 
-*/
-void lua_type (void)
-{
- Object *o = lua_getparam(1);
-
- if (lua_constant == NULL)
-  lua_initconstant();
- lua_pushstring (lua_constant[tag(o)]);
+ return (object != NULL && tag(object) == LUA_T_USERDATA);
 }
 
+ 
 /*
 ** Internal function: convert an object to a number
 */
@@ -1087,48 +664,439 @@ void lua_obj2number (void)
  lua_pushobject (lua_convtonumber(o));
 }
 
+
+
 /*
-** Internal function: print object values
+** Execute the given opcode, until a RET. Parameters are between
+** [stack+base,top). Returns n such that the the results are between
+** [stack+n,top).
 */
-void lua_print (void)
+static int lua_execute (Byte *pc, int base)
 {
- int i=1;
- Object *obj;
- while ((obj=lua_getparam (i++)) != NULL)
+ lua_debugline = 0;  /* reset debug flag */
+ if (stack == NULL)
+  lua_initstack();
+ while (1)
  {
-  if      (lua_isnumber(obj))    printf("%g\n",lua_getnumber (obj));
-  else if (lua_isstring(obj))    printf("%s\n",lua_getstring (obj));
-  else if (lua_isfunction(obj))  printf("function: %p\n",bvalue(obj));
-  else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj));
-  else if (lua_isuserdata(obj))  printf("userdata: %p\n",lua_getuserdata (obj));
-  else if (lua_istable(obj))     printf("table: %p\n",obj);
-  else if (lua_isnil(obj))       printf("nil\n");
-  else                           printf("invalid value to print\n");
- }
-}
+  OpCode opcode;
+  switch (opcode = (OpCode)*pc++)
+  {
+   case PUSHNIL: tag(top++) = LUA_T_NIL; break;
 
-/*
-** Internal function: do a file
-*/
-void lua_internaldofile (void)
-{
- lua_Object obj = lua_getparam (1);
- if (lua_isstring(obj) && !lua_dofile(lua_getstring(obj)))
-  lua_pushnumber(1);
- else
-  lua_pushnil();
-}
+   case PUSH0: tag(top) = LUA_T_NUMBER; nvalue(top++) = 0; break;
+   case PUSH1: tag(top) = LUA_T_NUMBER; nvalue(top++) = 1; break;
+   case PUSH2: tag(top) = LUA_T_NUMBER; nvalue(top++) = 2; break;
 
-/*
-** 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();
-}
+   case PUSHBYTE: tag(top) = LUA_T_NUMBER; nvalue(top++) = *pc++; break;
+
+   case PUSHWORD:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    tag(top) = LUA_T_NUMBER; nvalue(top++) = code.w;
+   }
+   break;
+
+   case PUSHFLOAT:
+   {
+    CodeFloat code;
+    get_float(code,pc);
+    tag(top) = LUA_T_NUMBER; nvalue(top++) = code.f;
+   }
+   break;
+
+   case PUSHSTRING:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    tag(top) = LUA_T_STRING; svalue(top++) = lua_constant[code.w];
+   }
+   break;
+
+   case PUSHFUNCTION:
+   {
+    CodeCode code;
+    get_code(code,pc);
+    tag(top) = LUA_T_FUNCTION; bvalue(top++) = code.b;
+   }
+   break;
+
+   case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2:
+   case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5:
+   case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8:
+   case PUSHLOCAL9: *top++ = *((stack+base) + (int)(opcode-PUSHLOCAL0)); break;
+
+   case PUSHLOCAL: *top++ = *((stack+base) + (*pc++)); break;
+
+   case PUSHGLOBAL:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    *top++ = s_object(code.w);
+   }
+   break;
+
+   case PUSHINDEXED:
+   {
+    int s = lua_pushsubscript();
+    if (s == 1) return 1;
+   }
+   break;
+
+   case PUSHSELF:
+   {
+     Object receiver = *(top-2);
+     if (lua_pushsubscript() == 1) return 1;
+     *(top++) = receiver;
+     break;
+   }
+
+   case STORELOCAL0: case STORELOCAL1: case STORELOCAL2:
+   case STORELOCAL3: case STORELOCAL4: case STORELOCAL5:
+   case STORELOCAL6: case STORELOCAL7: case STORELOCAL8:
+   case STORELOCAL9:
+     *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top);
+     break;
+
+   case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break;
+
+   case STOREGLOBAL:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    s_object(code.w) = *(--top);
+   }
+   break;
+
+   case STOREINDEXED0:
+   {
+    int s = lua_storesubscript();
+    if (s == 1) return 1;
+   }
+   break;
+
+   case STOREINDEXED:
+   {
+    int n = *pc++;
+    if (tag(top-3-n) != LUA_T_ARRAY)
+    {
+     lua_reportbug ("indexed expression not a table");
+     return 1;
+    }
+    {
+     Object *h = lua_hashdefine (avalue(top-3-n), top-2-n);
+     if (h == NULL) return 1;
+     *h = *(top-1);
+    }
+    top--;
+   }
+   break;
+
+   case STORELIST0:
+   case STORELIST:
+   {
+    int m, n;
+    Object *arr;
+    if (opcode == STORELIST0) m = 0;
+    else m = *(pc++) * FIELDS_PER_FLUSH;
+    n = *(pc++);
+    arr = top-n-1;
+    if (tag(arr) != LUA_T_ARRAY)
+    {
+     lua_reportbug ("internal error - table expected");
+     return 1;
+    }
+    while (n)
+    {
+     tag(top) = LUA_T_NUMBER; nvalue(top) = n+m;
+     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
+     top--;
+     n--;
+    }
+   }
+   break;
+
+   case STORERECORD:
+   {
+    int n = *(pc++);
+    Object *arr = top-n-1;
+    if (tag(arr) != LUA_T_ARRAY)
+    {
+     lua_reportbug ("internal error - table expected");
+     return 1;
+    }
+    while (n)
+    {
+     CodeWord code;
+     get_word(code,pc);
+     tag(top) = LUA_T_STRING; svalue(top) = lua_constant[code.w];
+     *(lua_hashdefine (avalue(arr), top)) = *(top-1);
+     top--;
+     n--;
+    }
+   }
+   break;
+
+   case ADJUST0:
+     adjust_top((stack+base));
+     break;
+
+   case ADJUST:
+     adjust_top((stack+base) + *(pc++));
+     break;
+
+   case CREATEARRAY:
+   {
+    CodeWord size;
+    get_word(size,pc);
+    top++;
+    avalue(top-1) = lua_createarray(size.w);
+    if (avalue(top-1) == NULL)
+     return 1;
+    tag(top-1) = LUA_T_ARRAY;
+   }
+   break;
+
+   case EQOP:
+   {
+    int res;
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) != tag(r))
+     res = 0;
+    else
+    {
+     switch (tag(l))
+     {
+      case LUA_T_NIL:
+        res = 0; break;
+      case LUA_T_NUMBER:
+        res = (nvalue(l) == nvalue(r)); break;
+      case LUA_T_ARRAY:
+        res = (avalue(l) == avalue(r)); break;
+      case LUA_T_FUNCTION:
+        res = (bvalue(l) == bvalue(r)); break;
+      case LUA_T_CFUNCTION:
+       res = (fvalue(l) == fvalue(r)); break;
+      case LUA_T_STRING:
+        res = (strcmp (svalue(l), svalue(r)) == 0); break;
+      default:
+        res = (uvalue(l) == uvalue(r)); break;
+     }
+    }
+    tag(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
+    nvalue(top-1) = 1;
+   }
+   break;
+
+   case LTOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER)
+     tag(top-1) = (nvalue(l) < nvalue(r)) ? LUA_T_NUMBER : LUA_T_NIL;
+    else
+    {
+     if (tostring(l) || tostring(r))
+      return 1;
+     tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? LUA_T_NUMBER : LUA_T_NIL;
+    }
+    nvalue(top-1) = 1;
+   }
+   break;
+
+   case LEOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    --top;
+    if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER)
+     tag(top-1) = (nvalue(l) <= nvalue(r)) ? LUA_T_NUMBER : LUA_T_NIL;
+    else
+    {
+     if (tostring(l) || tostring(r))
+      return 1;
+     tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? LUA_T_NUMBER : LUA_T_NIL;
+    }
+    nvalue(top-1) = 1;
+   }
+   break;
+
+   case ADDOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) += nvalue(r);
+    --top;
+   }
+   break;
+
+   case SUBOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) -= nvalue(r);
+    --top;
+   }
+   break;
 
+   case MULTOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) *= nvalue(r);
+    --top;
+   }
+   break;
+
+   case DIVOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) /= nvalue(r);
+    --top;
+   }
+   break;
+
+   case POWOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tonumber(r) || tonumber(l))
+     return 1;
+    nvalue(l) = pow(nvalue(l), nvalue(r));
+    --top;
+   }
+   break;
+
+   case CONCOP:
+   {
+    Object *l = top-2;
+    Object *r = top-1;
+    if (tostring(r) || tostring(l))
+     return 1;
+    svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r)));
+    if (svalue(l) == NULL)
+     return 1;
+    --top;
+   }
+   break;
+
+   case MINUSOP:
+    if (tonumber(top-1))
+     return 1;
+    nvalue(top-1) = - nvalue(top-1);
+   break;
+
+   case NOTOP:
+    tag(top-1) = tag(top-1) == LUA_T_NIL ? LUA_T_NUMBER : LUA_T_NIL;
+   break;
+
+   case ONTJMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    if (tag(top-1) != LUA_T_NIL) pc += code.w;
+   }
+   break;
+
+   case ONFJMP: 
+   {
+    CodeWord code;
+    get_word(code,pc);
+    if (tag(top-1) == LUA_T_NIL) pc += code.w;
+   }
+   break;
+
+   case JMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    pc += code.w;
+   }
+   break;
+
+   case UPJMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    pc -= code.w;
+   }
+   break;
+
+   case IFFJMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    top--;
+    if (tag(top) == LUA_T_NIL) pc += code.w;
+   }
+   break;
+
+   case IFFUPJMP:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    top--;
+    if (tag(top) == LUA_T_NIL) pc -= code.w;
+   }
+   break;
+
+   case POP: --top; break;
+
+   case CALLFUNC:
+   {
+     int nParams = *(pc++);
+     int nResults = *(pc++);
+     Object *func = top-1-nParams; /* function is below parameters */
+     int newBase = (top-stack)-nParams;
+     do_call(func, newBase, nResults, newBase-1);
+   }
+   break;
+
+   case RETCODE0:
+     return base;
+
+   case RETCODE:
+     return base+*pc;
+
+   case SETFUNCTION:
+   {
+    CodeCode file;
+    CodeWord func;
+    get_code(file,pc);
+    get_word(func,pc);
+    if (lua_pushfunction ((char *)file.b, func.w))
+     return 1;
+   }
+   break;
+
+   case SETLINE:
+   {
+    CodeWord code;
+    get_word(code,pc);
+    lua_debugline = code.w;
+   }
+   break;
+
+   case RESET:
+    lua_popfunction ();
+   break;
+
+   default:
+    lua_error ("internal error - opcode doesn't match");
+   return 1;
+  }
+ }
+}