%{ char *rcs_luastx = "$Id: lua.stx,v 2.5 1994/07/19 21:27:18 celes Exp $"; #include #include #include #include "mm.h" #include "opcode.h" #include "hash.h" #include "inout.h" #include "table.h" #include "lua.h" #define LISTING 0 #ifndef CODE_BLOCK #define CODE_BLOCK 256 #endif static Long maxcode; static Long maxmain; static Long maxcurr ; static Byte *code = NULL; static Byte *initcode; static Byte *basepc; static Long maincode; static Long pc; #define MAXVAR 32 static long varbuffer[MAXVAR]; /* variables in an assignment list; it's long to store negative Word values */ static int nvarbuffer=0; /* number of variables at a list */ static Word localvar[STACKGAP]; /* store local variable names */ static int nlocalvar=0; /* number of local variables */ #define MAXFIELDS FIELDS_PER_FLUSH*2 static Word fields[MAXFIELDS]; /* fieldnames to be flushed */ static int nfields=0; static int ntemp; /* number of temporary var into stack */ static int err; /* flag to indicate error */ /* Internal functions */ static void code_byte (Byte c) { if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */ { maxcurr *= 2; basepc = (Byte *)realloc(basepc, maxcurr*sizeof(Byte)); if (basepc == NULL) { lua_error ("not enough memory"); err = 1; } } basepc[pc++] = c; } static void code_word (Word n) { CodeWord code; code.w = n; code_byte(code.m.c1); code_byte(code.m.c2); } static void code_float (float n) { CodeFloat code; code.f = n; code_byte(code.m.c1); code_byte(code.m.c2); code_byte(code.m.c3); code_byte(code.m.c4); } static void code_word_at (Byte *p, Word n) { CodeWord code; code.w = n; *p++ = code.m.c1; *p++ = code.m.c2; } static void push_field (Word name) { if (nfields < STACKGAP-1) fields[nfields++] = name; else { lua_error ("too many fields in a constructor"); err = 1; } } static void flush_record (int n) { int i; if (n == 0) return; code_byte(STORERECORD); code_byte(n); for (i=0; i NUMBER %token FUNCTION STRING %token NAME %token DEBUG %type PrepJump %type expr, exprlist, exprlist1, varlist1, typeconstructor %type fieldlist, localdeclist %type ffieldlist, ffieldlist1 %type lfieldlist, lfieldlist1 %type var, objectname %left AND OR %left '=' NE '>' '<' LE GE %left CONC %left '+' '-' %left '*' '/' %left UNARY NOT %% /* beginning of rules section */ functionlist : /* empty */ | functionlist { pc=maincode; basepc=initcode; maxcurr=maxmain; nlocalvar=0; } stat sc { maincode=pc; initcode=basepc; maxmain=maxcurr; } | functionlist function | functionlist setdebug ; function : FUNCTION NAME { if (code == NULL) /* first function */ { code = (Byte *) calloc(CODE_BLOCK, sizeof(Byte)); if (code == NULL) { lua_error("not enough memory"); err = 1; } maxcode = CODE_BLOCK; } pc=0; basepc=code; maxcurr=maxcode; nlocalvar=0; $$ = lua_findsymbol($2); } '(' parlist ')' { if (lua_debug) { code_byte(SETFUNCTION); code_word(lua_nfile-1); code_word($3); } lua_codeadjust (0); } block END { if (lua_debug) code_byte(RESET); code_byte(RETCODE); code_byte(nlocalvar); s_tag($3) = T_FUNCTION; s_bvalue($3) = calloc (pc, sizeof(Byte)); if (s_bvalue($3) == NULL) { lua_error("not enough memory"); err = 1; } memcpy (s_bvalue($3), basepc, pc*sizeof(Byte)); code = basepc; maxcode=maxcurr; #if LISTING PrintCode(code,code+pc); #endif } ; statlist : /* empty */ | statlist stat sc ; stat : { ntemp = 0; if (lua_debug) { code_byte(SETLINE); code_word(lua_linenumber); } } stat1 sc : /* empty */ | ';' ; stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END { { Long elseinit = $6+sizeof(Word)+1; if (pc - elseinit == 0) /* no else */ { pc -= sizeof(Word)+1; elseinit = pc; } else { basepc[$6] = JMP; code_word_at(basepc+$6+1, pc - elseinit); } basepc[$4] = IFFJMP; code_word_at(basepc+$4+1,elseinit-($4+sizeof(Word)+1)); } } | WHILE {$$=pc;} expr1 DO PrepJump block PrepJump END { basepc[$5] = IFFJMP; code_word_at(basepc+$5+1, pc - ($5 + sizeof(Word)+1)); basepc[$7] = UPJMP; code_word_at(basepc+$7+1, pc - ($2)); } | REPEAT {$$=pc;} block UNTIL expr1 PrepJump { basepc[$6] = IFFUPJMP; code_word_at(basepc+$6+1, pc - ($2)); } | varlist1 '=' exprlist1 { { int i; if ($3 == 0 || nvarbuffer != ntemp - $1 * 2) lua_codeadjust ($1 * 2 + nvarbuffer); for (i=nvarbuffer-1; i>=0; i--) lua_codestore (i); if ($1 > 1 || ($1 == 1 && varbuffer[0] != 0)) lua_codeadjust (0); } } | functioncall { lua_codeadjust (0); } | typeconstructor { lua_codeadjust (0); } | LOCAL localdeclist decinit { add_nlocalvar($2); lua_codeadjust (0); } ; elsepart : /* empty */ | ELSE block | ELSEIF expr1 THEN PrepJump block PrepJump elsepart { { Long elseinit = $6+sizeof(Word)+1; if (pc - elseinit == 0) /* no else */ { pc -= sizeof(Word)+1; elseinit = pc; } else { basepc[$6] = JMP; code_word_at(basepc+$6+1, pc - elseinit); } basepc[$4] = IFFJMP; code_word_at(basepc+$4+1, elseinit - ($4 + sizeof(Word)+1)); } } ; block : {$$ = nlocalvar;} statlist {ntemp = 0;} ret { if (nlocalvar != $1) { nlocalvar = $1; lua_codeadjust (0); } } ; ret : /* empty */ | { if (lua_debug){code_byte(SETLINE);code_word(lua_linenumber);}} RETURN exprlist sc { if (lua_debug) code_byte(RESET); code_byte(RETCODE); code_byte(nlocalvar); } ; PrepJump : /* empty */ { $$ = pc; code_byte(0); /* open space */ code_word (0); } expr1 : expr { if ($1 == 0) {lua_codeadjust (ntemp+1); incr_ntemp();}} ; expr : '(' expr ')' { $$ = $2; } | expr1 '=' expr1 { code_byte(EQOP); $$ = 1; ntemp--;} | expr1 '<' expr1 { code_byte(LTOP); $$ = 1; ntemp--;} | expr1 '>' expr1 { code_byte(LEOP); code_byte(NOTOP); $$ = 1; ntemp--;} | expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; ntemp--;} | expr1 LE expr1 { code_byte(LEOP); $$ = 1; ntemp--;} | expr1 GE expr1 { code_byte(LTOP); code_byte(NOTOP); $$ = 1; ntemp--;} | expr1 '+' expr1 { code_byte(ADDOP); $$ = 1; ntemp--;} | expr1 '-' expr1 { code_byte(SUBOP); $$ = 1; ntemp--;} | expr1 '*' expr1 { code_byte(MULTOP); $$ = 1; ntemp--;} | expr1 '/' expr1 { code_byte(DIVOP); $$ = 1; ntemp--;} | expr1 CONC expr1 { code_byte(CONCOP); $$ = 1; ntemp--;} | '+' expr1 %prec UNARY { $$ = 1; } | '-' expr1 %prec UNARY { code_byte(MINUSOP); $$ = 1;} | typeconstructor { $$ = $1; } | '@' '(' dimension ')' { code_byte(CREATEARRAY); $$ = 1; } | var { lua_pushvar ($1); $$ = 1;} | NUMBER { code_number($1); $$ = 1; } | STRING { code_byte(PUSHSTRING); code_word($1); $$ = 1; incr_ntemp(); } | NIL {code_byte(PUSHNIL); $$ = 1; incr_ntemp();} | functioncall { $$ = 0; if (lua_debug) { code_byte(SETLINE); code_word(lua_linenumber); } } | NOT expr1 { code_byte(NOTOP); $$ = 1;} | expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1 { basepc[$3] = ONFJMP; code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); $$ = 1; } | expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1 { basepc[$3] = ONTJMP; code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1)); $$ = 1; } ; typeconstructor: '@' { code_byte(PUSHWORD); $$ = pc; code_word(0); incr_ntemp(); code_byte(CREATEARRAY); } objectname fieldlist { code_word_at(basepc+$2, $4); if ($3 < 0) /* there is no function to be called */ { $$ = 1; } else { lua_pushvar ($3+1); code_byte(PUSHMARK); incr_ntemp(); code_byte(PUSHOBJECT); incr_ntemp(); code_byte(CALLFUNC); ntemp -= 4; $$ = 0; if (lua_debug) { code_byte(SETLINE); code_word(lua_linenumber); } } } ; dimension : /* empty */ { code_byte(PUSHNIL); incr_ntemp();} | expr1 ; functioncall : functionvalue {code_byte(PUSHMARK); $$ = ntemp; incr_ntemp();} '(' exprlist ')' { code_byte(CALLFUNC); ntemp = $2-1;} functionvalue : var {lua_pushvar ($1); } ; exprlist : /* empty */ { $$ = 1; } | exprlist1 { $$ = $1; } ; exprlist1 : expr { $$ = $1; } | exprlist1 ',' {if (!$1){lua_codeadjust (ntemp+1); incr_ntemp();}} expr {$$ = $4;} ; parlist : /* empty */ | parlist1 ; parlist1 : NAME { localvar[nlocalvar]=lua_findsymbol($1); add_nlocalvar(1); } | parlist1 ',' NAME { localvar[nlocalvar]=lua_findsymbol($3); add_nlocalvar(1); } ; objectname : /* empty */ {$$=-1;} | NAME {$$=lua_findsymbol($1);} ; fieldlist : '{' ffieldlist '}' { flush_record($2%FIELDS_PER_FLUSH); $$ = $2; } | '[' lfieldlist ']' { flush_list($2/FIELDS_PER_FLUSH, $2%FIELDS_PER_FLUSH); $$ = $2; } ; ffieldlist : /* empty */ { $$ = 0; } | ffieldlist1 { $$ = $1; } ; ffieldlist1 : ffield {$$=1;} | ffieldlist1 ',' ffield { $$=$1+1; if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH); } ; ffield : NAME {$$ = lua_findconstant($1);} '=' expr1 { push_field($2); } ; lfieldlist : /* empty */ { $$ = 0; } | lfieldlist1 { $$ = $1; } ; lfieldlist1 : expr1 {$$=1;} | lfieldlist1 ',' expr1 { $$=$1+1; if ($$%FIELDS_PER_FLUSH == 0) flush_list($$/FIELDS_PER_FLUSH - 1, FIELDS_PER_FLUSH); } ; varlist1 : var { nvarbuffer = 0; varbuffer[nvarbuffer] = $1; incr_nvarbuffer(); $$ = ($1 == 0) ? 1 : 0; } | varlist1 ',' var { varbuffer[nvarbuffer] = $3; incr_nvarbuffer(); $$ = ($3 == 0) ? $1 + 1 : $1; } ; var : NAME { Word s = lua_findsymbol($1); int local = lua_localname (s); if (local == -1) /* global var */ $$ = s + 1; /* return positive value */ else $$ = -(local+1); /* return negative value */ } | var {lua_pushvar ($1);} '[' expr1 ']' { $$ = 0; /* indexed variable */ } | var {lua_pushvar ($1);} '.' NAME { code_byte(PUSHSTRING); code_word(lua_findconstant($4)); incr_ntemp(); $$ = 0; /* indexed variable */ } ; localdeclist : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;} | localdeclist ',' NAME { localvar[nlocalvar+$1]=lua_findsymbol($3); $$ = $1+1; } ; decinit : /* empty */ | '=' exprlist1 ; setdebug : DEBUG {lua_debug = $1;} %% /* ** Search a local name and if find return its index. If do not find return -1 */ static int lua_localname (Word n) { int i; for (i=nlocalvar-1; i >= 0; i--) if (n == localvar[i]) return i; /* local var */ return -1; /* global var */ } /* ** Push a variable given a number. If number is positive, push global variable ** indexed by (number -1). If negative, push local indexed by ABS(number)-1. ** Otherwise, if zero, push indexed variable (record). */ static void lua_pushvar (long number) { if (number > 0) /* global var */ { code_byte(PUSHGLOBAL); code_word(number-1); incr_ntemp(); } else if (number < 0) /* local var */ { number = (-number) - 1; if (number < 10) code_byte(PUSHLOCAL0 + number); else { code_byte(PUSHLOCAL); code_byte(number); } incr_ntemp(); } else { code_byte(PUSHINDEXED); ntemp--; } } static void lua_codeadjust (int n) { code_byte(ADJUST); code_byte(n + nlocalvar); } static void lua_codestore (int i) { if (varbuffer[i] > 0) /* global var */ { code_byte(STOREGLOBAL); code_word(varbuffer[i]-1); } else if (varbuffer[i] < 0) /* local var */ { int number = (-varbuffer[i]) - 1; if (number < 10) code_byte(STORELOCAL0 + number); else { code_byte(STORELOCAL); code_byte(number); } } else /* indexed var */ { int j; int upper=0; /* number of indexed variables upper */ int param; /* number of itens until indexed expression */ for (j=i+1; j