commit fbf887ec2be8b293d6f3ffc88b42c5a9e87bf022
parent ae77864844d6b933eb8be68694cbb8498af165dc
Author: Roberto Ierusalimschy <roberto@inf.puc-rio.br>
Date: Wed, 2 Nov 1994 18:30:34 -0200
new way to call functions, plus several small changes. This is
a temporary version!
Diffstat:
| M | lua.h | | | 29 | ++++++++++++++++++++++++----- |
| M | lua.stx | | | 190 | ++++++++++++++++++++++++++++++++++++++++++++----------------------------------- |
| M | opcode.c | | | 1412 | +++++++++++++++++++++++++++++++++++++++---------------------------------------- |
| M | opcode.h | | | 41 | +++++++++++++++-------------------------- |
4 files changed, 834 insertions(+), 838 deletions(-)
diff --git a/lua.h b/lua.h
@@ -2,13 +2,29 @@
** LUA - Linguagem para Usuarios de Aplicacao
** Grupo de Tecnologia em Computacao Grafica
** TeCGraf - PUC-Rio
-** $Id: lua.h,v 1.4 1994/08/24 15:29:02 celes Exp roberto $
+** $Id: lua.h,v 1.5 1994/11/01 17:54:31 roberto Exp $
*/
#ifndef lua_h
#define lua_h
+/* Private Part */
+
+typedef enum
+{
+ LUA_T_MARK,
+ LUA_T_NIL,
+ LUA_T_NUMBER,
+ LUA_T_STRING,
+ LUA_T_ARRAY,
+ LUA_T_FUNCTION,
+ LUA_T_CFUNCTION,
+ LUA_T_USERDATA
+} Type;
+
+
+/* Public Part */
typedef void (*lua_CFunction) (void);
typedef struct Object *lua_Object;
@@ -19,8 +35,7 @@ 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 nparam);
+int lua_callfunction (lua_Object function);
lua_Object lua_getparam (int number);
float lua_getnumber (lua_Object object);
@@ -33,8 +48,6 @@ lua_Object lua_getfield (lua_Object object, char *field);
lua_Object lua_getindexed (lua_Object object, float index);
lua_Object lua_getglobal (char *name);
-lua_Object lua_pop (void);
-
int lua_pushnil (void);
int lua_pushnumber (float n);
int lua_pushstring (char *s);
@@ -57,4 +70,10 @@ int lua_isfunction (lua_Object object);
int lua_iscfunction (lua_Object object);
int lua_isuserdata (lua_Object object);
+
+/* for lua 1.1 */
+
+#define lua_call(f) lua_callfunction(lua_getglobal(f))
+
+
#endif
diff --git a/lua.stx b/lua.stx
@@ -1,6 +1,6 @@
%{
-char *rcs_luastx = "$Id: lua.stx,v 2.11 1994/10/21 19:00:12 roberto Exp roberto $";
+char *rcs_luastx = "$Id: lua.stx,v 2.12 1994/11/01 18:25:20 roberto Exp roberto $";
#include <stdio.h>
#include <stdlib.h>
@@ -37,7 +37,6 @@ static int nlocalvar=0; /* number of local variables */
#define MAXFIELDS FIELDS_PER_FLUSH*2
static Word fields[MAXFIELDS]; /* fieldnames to be flushed */
static int nfields=0;
-static int ntemp; /* number of temporary var into stack */
static int err; /* flag to indicate error */
/* Internal functions */
@@ -112,7 +111,6 @@ static void flush_record (int n)
code_byte(n);
for (i=0; i<n; i++)
code_word(fields[--nfields]);
- ntemp -= n;
}
static void flush_list (int m, int n)
@@ -132,27 +130,15 @@ static void flush_list (int m, int n)
err = 1;
}
code_byte(n);
- ntemp-=n;
-}
-
-static void incr_ntemp (void)
-{
- if (ntemp+nlocalvar+MAXVAR+1 < STACKGAP)
- ntemp++;
- else
- {
- lua_error ("stack overflow");
- err = 1;
- }
}
static void add_nlocalvar (int n)
{
- if (ntemp+nlocalvar+MAXVAR+n < STACKGAP)
+ if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
nlocalvar += n;
else
{
- lua_error ("too many local variables or expression too complicate");
+ lua_error ("too many local variables");
err = 1;
}
}
@@ -190,7 +176,6 @@ static void code_number (float f)
code_byte(PUSHFLOAT);
code_float(f);
}
- incr_ntemp();
}
static void init_function (void)
@@ -235,8 +220,8 @@ static void init_function (void)
%token <vInt> DEBUG
%type <vLong> PrepJump
-%type <vInt> expr, exprlist, exprlist1, varlist1, funcvalue
-%type <vInt> fieldlist, localdeclist
+%type <vInt> expr, exprlist, exprlist1, varlist1, funcParams, funcvalue
+%type <vInt> fieldlist, localdeclist, decinit
%type <vInt> ffieldlist1
%type <vInt> lfieldlist1
%type <vLong> var, singlevar
@@ -290,8 +275,8 @@ function : FUNCTION NAME
END
{
if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
- s_tag($<vWord>3) = T_FUNCTION;
+ codereturn();
+ s_tag($<vWord>3) = LUA_T_FUNCTION;
s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte));
if (s_bvalue($<vWord>3) == NULL)
{
@@ -330,7 +315,7 @@ method : FUNCTION NAME { $<vWord>$ = lua_findsymbol($2); } ':' NAME
{
Byte *b;
if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
+ codereturn();
b = calloc (pc, sizeof(Byte));
if (b == NULL)
{
@@ -362,7 +347,6 @@ statlist : /* empty */
;
stat : {
- ntemp = 0;
if (lua_debug)
{
code_byte(SETLINE); code_word(lua_linenumber);
@@ -414,16 +398,18 @@ stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
{
{
int i;
- if ($3 == 0 || nvarbuffer != ntemp - $1 * 2)
- lua_codeadjust ($1 * 2 + nvarbuffer);
+ adjust_mult_assign(nvarbuffer, $3, $1 * 2 + nvarbuffer);
for (i=nvarbuffer-1; i>=0; i--)
lua_codestore (i);
if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0))
lua_codeadjust (0);
}
}
- | functioncall { lua_codeadjust (0); }
- | LOCAL localdeclist decinit { add_nlocalvar($2); lua_codeadjust (0); }
+ | functioncall { code_byte(0); }
+ | LOCAL localdeclist decinit
+ { add_nlocalvar($2);
+ adjust_mult_assign($2, $3, 0);
+ }
;
elsepart : /* empty */
@@ -448,7 +434,7 @@ elsepart : /* empty */
}
;
-block : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret
+block : {$<vInt>$ = nlocalvar;} statlist ret
{
if (nlocalvar != $<vInt>1)
{
@@ -462,8 +448,9 @@ ret : /* empty */
| { if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}}
RETURN exprlist sc
{
+ if ($3 < 0) code_byte(MULT_RET);
if (lua_debug) code_byte(RESET);
- code_byte(RETCODE); code_byte(nlocalvar);
+ codereturn();
}
;
@@ -474,22 +461,22 @@ PrepJump : /* empty */
code_word (0);
}
-expr1 : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}}
+expr1 : expr { if ($1 == 0) code_byte(1); }
;
expr : '(' expr ')' { $$ = $2; }
- | expr1 EQ expr1 { code_byte(EQOP); $$ = 1; ntemp--;}
- | expr1 '<' expr1 { code_byte(LTOP); $$ = 1; ntemp--;}
- | expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 LE expr1 { code_byte(LEOP); $$ = 1; ntemp--;}
- | expr1 GE expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;}
- | expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; ntemp--;}
- | expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; ntemp--;}
- | expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;}
- | expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; ntemp--;}
- | expr1 '^' expr1 { code_byte(POWOP); $$ = 1; ntemp--;}
- | expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; ntemp--;}
+ | expr1 EQ expr1 { code_byte(EQOP); $$ = 1; }
+ | expr1 '<' expr1 { code_byte(LTOP); $$ = 1; }
+ | expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; }
+ | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; }
+ | expr1 LE expr1 { code_byte(LEOP); $$ = 1; }
+ | expr1 GE expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; }
+ | expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; }
+ | expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; }
+ | expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; }
+ | expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; }
+ | expr1 '^' expr1 { code_byte(POWOP); $$ = 1; }
+ | expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; }
| '+' expr1 %prec UNARY { $$ = 1; }
| '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 1;}
| table { $$ = 1; }
@@ -500,9 +487,8 @@ expr : '(' expr ')' { $$ = $2; }
code_byte(PUSHSTRING);
code_word(lua_findconstant($1));
$$ = 1;
- incr_ntemp();
}
- | NIL {code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
+ | NIL {code_byte(PUSHNIL); $$ = 1; }
| functioncall
{
$$ = 0;
@@ -512,13 +498,13 @@ expr : '(' expr ')' { $$ = $2; }
}
}
| NOT expr1 { code_byte(NOTOP); $$ = 1;}
- | expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1
+ | expr1 AND PrepJump {code_byte(POP); } expr1
{
basepc[$3] = ONFJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
$$ = 1;
}
- | expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1
+ | expr1 OR PrepJump {code_byte(POP); } expr1
{
basepc[$3] = ONTJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
@@ -537,33 +523,35 @@ table :
}
;
-functioncall : funcvalue funcParams { code_byte(CALLFUNC); ntemp = $1-1; }
+functioncall : funcvalue funcParams
+ { code_byte(CALLFUNC); code_byte($1+$2); }
;
-funcvalue : varexp
- {
- $$ = ntemp; code_byte(PUSHMARK); incr_ntemp();
- }
+
+funcvalue : varexp { $$ = 0; }
| varexp ':' NAME
{
code_byte(PUSHSTRING);
code_word(lua_findconstant($3));
- incr_ntemp();
- $$ = ntemp-1;
- code_byte(PUSHMARKMET);
- incr_ntemp();
+ code_byte(PUSHSELF);
+ $$ = 1;
}
;
+
funcParams : '(' exprlist ')'
- | table
+ { if ($2<0) { code_byte(1); $$ = -$2; } else $$ = $2; }
+ | table { $$ = 1; }
;
-
-exprlist : /* empty */ { $$ = 1; }
+
+exprlist : /* empty */ { $$ = 0; }
| exprlist1 { $$ = $1; }
;
-exprlist1 : expr { $$ = $1; }
- | exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}}
- expr {$$ = $4;}
+exprlist1 : expr { if ($1 == 0) $$ = -1; else $$ = 1; }
+ | exprlist1 ',' { if ($1 < 0) code_byte(1); } expr
+ {
+ int r = $1 < 0 ? -$1 : $1;
+ $$ = ($4 == 0) ? -(r+1) : r+1;
+ }
;
parlist : /* empty */
@@ -641,7 +629,7 @@ var : singlevar { $$ = $1; }
| varexp '.' NAME
{
code_byte(PUSHSTRING);
- code_word(lua_findconstant($3)); incr_ntemp();
+ code_word(lua_findconstant($3));
$$ = 0; /* indexed variable */
}
;
@@ -668,8 +656,8 @@ localdeclist : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;}
}
;
-decinit : /* empty */
- | '=' exprlist1
+decinit : /* empty */ { $$ = 0; }
+ | '=' exprlist1 { $$ = $2; }
;
setdebug : DEBUG {lua_debug = $1;}
@@ -698,7 +686,6 @@ static void lua_pushvar (long number)
{
code_byte(PUSHGLOBAL);
code_word(number-1);
- incr_ntemp();
}
else if (number < 0) /* local var */
{
@@ -709,19 +696,50 @@ static void lua_pushvar (long number)
code_byte(PUSHLOCAL);
code_byte(number);
}
- incr_ntemp();
}
else
{
code_byte(PUSHINDEXED);
- ntemp--;
}
}
static void lua_codeadjust (int n)
{
- code_byte(ADJUST);
- code_byte(n + nlocalvar);
+ if (n+nlocalvar == 0)
+ code_byte(ADJUST0);
+ else
+ {
+ code_byte(ADJUST);
+ code_byte(n+nlocalvar);
+ }
+}
+
+static void codereturn (void)
+{
+ if (nlocalvar == 0)
+ code_byte(RETCODE0);
+ else
+ {
+ code_byte(RETCODE);
+ code_byte(nlocalvar);
+ }
+}
+
+static void adjust_mult_assign (int vars, int exps, int temps)
+{
+ if (exps < 0)
+ {
+ int r = vars - (-exps-1);
+ if (r >= 0)
+ code_byte(r);
+ else
+ {
+ code_byte(0);
+ lua_codeadjust(temps);
+ }
+ }
+ else if (vars != exps)
+ lua_codeadjust(temps);
}
static void lua_codestore (int i)
@@ -775,10 +793,9 @@ int yywrap (void)
/*
-** Parse LUA code and execute global statement.
-** Return 0 on success or 1 on error.
+** Parse LUA code and returns global statements.
*/
-int lua_parse (void)
+Byte *lua_parse (void)
{
Byte *init = initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
maincode = 0;
@@ -786,18 +803,17 @@ int lua_parse (void)
if (init == NULL)
{
lua_error("not enough memory");
- return 1;
+ return NULL;
}
err = 0;
- if (yyparse () || (err==1)) return 1;
- initcode[maincode++] = HALT;
+ if (yyparse () || (err==1)) return NULL;
+ initcode[maincode++] = RETCODE0;
init = initcode;
#if LISTING
- PrintCode(init,init+maincode);
+{ static void PrintCode (Byte *code, Byte *end);
+ PrintCode(init,init+maincode); }
#endif
- if (lua_execute (init)) return 1;
- free(init);
- return 0;
+ return init;
}
@@ -876,7 +892,6 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break;
- case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break;
case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3:
case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7:
case STORELOCAL8: case STORELOCAL9:
@@ -896,6 +911,7 @@ static void PrintCode (Byte *code, Byte *end)
printf ("%d STOREGLOBAL %d\n", n, c.w);
}
break;
+ case PUSHSELF: printf ("%d PUSHSELF\n", (p++)-code); break;
case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break;
case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p));
p++;
@@ -912,6 +928,7 @@ static void PrintCode (Byte *code, Byte *end)
printf("%d STORERECORD %d\n", p-code, *(++p));
p += *p*sizeof(Word) + 1;
break;
+ case ADJUST0: printf ("%d ADJUST0\n", (p++)-code); break;
case ADJUST:
printf ("%d ADJUST %d\n", p-code, *(++p));
p++;
@@ -922,7 +939,7 @@ static void PrintCode (Byte *code, Byte *end)
int n = p-code;
p++;
get_word(c,p);
- printf ("%d CREATEARRAY\n", n, c.w);
+ printf ("%d CREATEARRAY %d\n", n, c.w);
break;
}
case EQOP: printf ("%d EQOP\n", (p++)-code); break;
@@ -990,16 +1007,19 @@ static void PrintCode (Byte *code, Byte *end)
}
break;
case POP: printf ("%d POP\n", (p++)-code); break;
- case CALLFUNC: printf ("%d CALLFUNC\n", (p++)-code); break;
+ case CALLFUNC:
+ printf ("%d CALLFUNC %d %d\n", p-code, *(p+1), *(p+2));
+ p+=3;
+ break;
+ case RETCODE0: printf ("%d RETCODE0\n", (p++)-code); break;
case RETCODE:
printf ("%d RETCODE %d\n", p-code, *(++p));
p++;
break;
- case HALT: printf ("%d HALT\n", (p++)-code); break;
case SETFUNCTION:
{
CodeCode c1;
- CodeWord c1;
+ CodeWord c2;
int n = p-code;
p++;
get_code(c1,p);
diff --git 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,551 +156,159 @@ 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;
+ while (top < newtop) tag(top++) = LUA_T_NIL;
+ top = newtop; /* top could be bigger than newtop */
+}
- if (stack == NULL)
- lua_initstack();
- oldbase = base-stack;
- base = top;
- while (1)
+/*
+** 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;
+}
+
+
+/*
+** 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);
+ }
+}
+
+
+/*
+** Function to index the values on the top
+*/
+int lua_pushsubscript (void)
+{
+ --top;
+ if (tag(top-1) != LUA_T_ARRAY)
{
- OpCode opcode;
- switch (opcode = (OpCode)*pc++)
+ lua_reportbug ("indexed expression not a table");
+ return 1;
+ }
+ {
+ Object *h = lua_hashget (avalue(top-1), top);
+ if (h == NULL) return 1;
+ *(top-1) = *h;
+ }
+ return 0;
+}
+
+
+/*
+** Function to store indexed based on values at the top
+*/
+int lua_storesubscript (void)
+{
+ if (tag(top-3) != LUA_T_ARRAY)
+ {
+ lua_reportbug ("indexed expression not a table");
+ return 1;
+ }
+ {
+ Object *h = lua_hashdefine (avalue(top-3), top-2);
+ if (h == NULL) return 1;
+ *h = *(top-1);
+ }
+ top -= 3;
+ return 0;
+}
+
+
+/*
+** Traverse all objects on stack
+*/
+void lua_travstack (void (*fn)(Object *))
+{
+ Object *o;
+ for (o = top-1; o >= stack; o--)
+ fn (o);
+}
+
+
+/*
+** Executes a main procedure. Uses as Base the top of the stack, as it
+** uses no parameters and left no results.
+*/
+static void do_main (Byte *main)
+{
+ if (main)
{
- 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;
+ Object f;
+ tag(&f) = LUA_T_FUNCTION; bvalue(&f) = main;
+ do_call(&f, top-stack, 0, top-stack);
+ free(main);
+ }
+}
- 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;
-
- 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;
- }
- }
-}
-
-
-/*
-** Function to index the values on the top
-*/
-int lua_pushsubscript (void)
-{
- --top;
- if (tag(top-1) != T_ARRAY)
- {
- lua_reportbug ("indexed expression not a table");
- return 1;
- }
- {
- Object *h = lua_hashget (avalue(top-1), top);
- if (h == NULL) return 1;
- *(top-1) = *h;
- }
- return 0;
-}
-
-
-/*
-** Function to store indexed based on values at the top
-*/
-int lua_storesubscript (void)
-{
- if (tag(top-3) != T_ARRAY)
- {
- lua_reportbug ("indexed expression not a table");
- return 1;
- }
- {
- Object *h = lua_hashdefine (avalue(top-3), top-2);
- if (h == NULL) return 1;
- *h = *(top-1);
- }
- top -= 3;
- return 0;
-}
-
-
-/*
-** Traverse all objects on stack
-*/
-void lua_travstack (void (*fn)(Object *))
-{
- Object *o;
- for (o = top-1; o >= stack; o--)
- fn (o);
-}
-
-/*
-** Open file, generate opcode and execute global statement. Return 0 on
-** success or 1 on error.
-*/
-int lua_dofile (char *filename)
-{
- if (lua_openfile (filename)) return 1;
- if (lua_parse ()) { lua_closefile (); return 1; }
- lua_closefile ();
- return 0;
-}
+/*
+** Open file, generate opcode and execute global statement. Return 0 on
+** success or 1 on error.
+*/
+int lua_dofile (char *filename)
+{
+ 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;
+}
/*
** Generate opcode stored on string and execute global statement. Return 0 on
@@ -711,43 +316,43 @@ int lua_dofile (char *filename)
*/
int lua_dostring (char *string)
{
- if (lua_openstring (string)) return 1;
- if (lua_parse ()) return 1;
- lua_closestring();
- return 0;
-}
-
-/*
-** Execute the given function. Return 0 on success or 1 on error.
-*/
-int lua_call (char *functionname, int nparam)
-{
- static Byte startcode[] = {CALLFUNC, HALT};
- int i;
- Object func = s_object(lua_findsymbol(functionname));
- if (tag(&func) != T_FUNCTION) return 1;
- for (i=1; i<=nparam; i++)
- *(top-i+2) = *(top-i);
- top += 2;
- tag(top-nparam-1) = T_MARK;
- *(top-nparam-2) = func;
- return (lua_execute (startcode));
+ 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;
+ }
+ }
+}
diff --git a/opcode.h b/opcode.h
@@ -1,11 +1,13 @@
/*
** TeCGraf - PUC-Rio
-** $Id: opcode.h,v 2.3 1994/08/05 19:31:09 celes Exp celes $
+** $Id: opcode.h,v 2.4 1994/10/17 19:00:40 celes Exp roberto $
*/
#ifndef opcode_h
#define opcode_h
+#include "lua.h"
+
#ifndef STACKGAP
#define STACKGAP 128
#endif
@@ -16,6 +18,8 @@
#define FIELDS_PER_FLUSH 40
+#define MAX_TEMPS 20
+
typedef unsigned char Byte;
typedef unsigned short Word;
@@ -54,8 +58,7 @@ typedef enum
PUSHLOCAL,
PUSHGLOBAL,
PUSHINDEXED,
- PUSHMARK,
- PUSHMARKMET,
+ PUSHSELF,
STORELOCAL0, STORELOCAL1, STORELOCAL2, STORELOCAL3, STORELOCAL4,
STORELOCAL5, STORELOCAL6, STORELOCAL7, STORELOCAL8, STORELOCAL9,
STORELOCAL,
@@ -65,6 +68,7 @@ typedef enum
STORELIST0,
STORELIST,
STORERECORD,
+ ADJUST0,
ADJUST,
CREATEARRAY,
EQOP,
@@ -86,34 +90,25 @@ typedef enum
IFFUPJMP,
POP,
CALLFUNC,
+ RETCODE0,
RETCODE,
- HALT,
SETFUNCTION,
SETLINE,
RESET
} OpCode;
-typedef enum
-{
- T_MARK,
- T_NIL,
- T_NUMBER,
- T_STRING,
- T_ARRAY,
- T_FUNCTION,
- T_CFUNCTION,
- T_USERDATA
-} Type;
+#define MULT_RET 255
+
typedef void (*Cfunction) (void);
typedef int (*Input) (void);
typedef union
{
- Cfunction f;
- real n;
- char *s;
- Byte *b;
+ Cfunction f;
+ real n;
+ char *s;
+ Byte *b;
struct Hash *a;
void *u;
} Value;
@@ -157,18 +152,12 @@ typedef struct
/* Exported functions */
-int lua_execute (Byte *pc);
-void lua_markstack (void);
char *lua_strdup (char *l);
void lua_setinput (Input fn); /* from "lex.c" module */
char *lua_lasttext (void); /* from "lex.c" module */
-int lua_parse (void); /* from "lua.stx" module */
-void lua_type (void);
+Byte *lua_parse (void); /* from "lua.stx" module */
void lua_obj2number (void);
-void lua_print (void);
-void lua_internaldofile (void);
-void lua_internaldostring (void);
void lua_travstack (void (*fn)(Object *));
#endif
