From fbf887ec2be8b293d6f3ffc88b42c5a9e87bf022 Mon Sep 17 00:00:00 2001 From: Roberto Ierusalimschy Date: Wed, 2 Nov 1994 18:30:53 -0200 Subject: [PATCH] new way to call functions, plus several small changes. This is a temporary version! --- lua.h | 29 +- lua.stx | 190 ++++---- opcode.c | 1302 ++++++++++++++++++++++++++---------------------------- opcode.h | 41 +- 4 files changed, 779 insertions(+), 783 deletions(-) diff --git a/lua.h b/lua.h index a93ef30e..f9a0a500 100644 --- 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 index ceed9c4b..5f13f6ba 100644 --- 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 #include @@ -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 DEBUG %type PrepJump -%type expr, exprlist, exprlist1, varlist1, funcvalue -%type fieldlist, localdeclist +%type expr, exprlist, exprlist1, varlist1, funcParams, funcvalue +%type fieldlist, localdeclist, decinit %type ffieldlist1 %type lfieldlist1 %type var, singlevar @@ -290,8 +275,8 @@ function : FUNCTION NAME END { if (lua_debug) code_byte(RESET); - code_byte(RETCODE); code_byte(nlocalvar); - s_tag($3) = T_FUNCTION; + codereturn(); + s_tag($3) = LUA_T_FUNCTION; s_bvalue($3) = calloc (pc, sizeof(Byte)); if (s_bvalue($3) == NULL) { @@ -330,7 +315,7 @@ method : FUNCTION NAME { $$ = 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 : {$$ = nlocalvar;} statlist {ntemp = 0;} ret +block : {$$ = nlocalvar;} statlist ret { if (nlocalvar != $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 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 #include #include +#include #include #ifdef __GNUC__ #include @@ -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; + 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) - { - OpCode opcode; - switch (opcode = (OpCode)*pc++) +/* +** 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) { - 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; - - 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 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)); } @@ -866,24 +471,13 @@ Object *lua_getglobal (char *name) return &s_object(n); } -/* -** Pop and return an object -*/ -Object *lua_pop (void) -{ - if (top <= base) return NULL; - top--; - return top; -} - /* ** Push a nil object */ int lua_pushnil (void) { - if (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; + + 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; + + 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; + } } } -/* -** 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(); -} - -/* -** 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(); -} - - diff --git a/opcode.h b/opcode.h index f021dac8..4a35ca12 100644 --- 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