%{ char *rcs_luastx = "$Id: lua.stx,v 1.3 1993/12/28 16:42:29 roberto Exp roberto $"; #include #include #include #include "opcode.h" #include "hash.h" #include "inout.h" #include "table.h" #include "lua.h" #define LISTING 0 #ifndef ALIGNMENT #define ALIGNMENT (sizeof(void *)) #endif #ifndef MAXCODE #define MAXCODE 1024 #endif static long buffer[MAXCODE*sizeof(Byte)/sizeof(long)]; static Byte *code = (Byte *)buffer; static long mainbuffer[MAXCODE]; static Byte *maincode = (Byte *)mainbuffer; static Byte *basepc; static Byte *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-basepc>MAXCODE-1) { lua_error ("code buffer overflow"); err = 1; } *pc++ = c; } #define align(t,n) align_n(sizeof(t),n) static void align_n (unsigned size, int gap) { if (size > ALIGNMENT) size = ALIGNMENT; while (((pc+gap-code)%size) != 0) /* +gap to include BYTECODEs */ code_byte (NOP); } static void code_word (Word n) { if (pc-basepc>MAXCODE-sizeof(Word)) { lua_error ("code buffer overflow"); err = 1; } *((Word *)pc) = n; pc += sizeof(Word); } static void code_float (float n) { if (pc-basepc>MAXCODE-sizeof(float)) { lua_error ("code buffer overflow"); err = 1; } *((float *)pc) = n; pc += sizeof(float); } 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; align(Word,2); /* two bytes before the actual word */ code_byte(STORERECORD); code_byte(n); for (i=0; i NUMBER %token FUNCTION NAME STRING %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=basepc=maincode; nlocalvar=0;} stat sc { maincode=pc; #if LISTING PrintCode(basepc,maincode); #endif } | functionlist function | functionlist setdebug ; function : FUNCTION NAME {pc=basepc=code; nlocalvar=0;} '(' parlist ')' { if (lua_debug) { align(Word,1); code_byte(SETFUNCTION); code_word($1); code_word($2); } lua_codeadjust (0); } block END { if (lua_debug) code_byte(RESET); code_byte(RETCODE); code_byte(nlocalvar); s_tag($2) = T_FUNCTION; s_bvalue($2) = calloc (pc-code, sizeof(Byte)); memcpy (s_bvalue($2), code, (pc-code)*sizeof(Byte)); #if LISTING PrintCode(code,pc); #endif } ; statlist : /* empty */ | statlist stat sc ; stat : { ntemp = 0; if (lua_debug) { align(Word,1); code_byte(SETLINE); code_word(lua_linenumber); } } stat1 sc : /* empty */ | ';' ; stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END { { Byte *elseinit = $6 + sizeof(Word)+1; if (pc - elseinit == 0) /* no else */ { pc -= sizeof(Word)+1; /* if (*(pc-1) == NOP) --pc; */ elseinit = pc; } else { *($6) = JMP; *((Word *)($6+1)) = pc - elseinit; } *($4) = IFFJMP; *((Word *)($4+1)) = elseinit - ($4 + sizeof(Word)+1); } } | WHILE {$$ = pc;} expr1 DO PrepJump block PrepJump END { *($5) = IFFJMP; *((Word *)($5+1)) = pc - ($5 + sizeof(Word)+1); *($7) = UPJMP; *((Word *)($7+1)) = pc - $2; } | REPEAT {$$ = pc;} block UNTIL expr1 PrepJump { *($6) = IFFUPJMP; *((Word *)($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 { { Byte *elseinit = $6 + sizeof(Word)+1; if (pc - elseinit == 0) /* no else */ { pc -= sizeof(Word)+1; /* if (*(pc-1) == NOP) --pc; */ elseinit = pc; } else { *($6) = JMP; *((Word *)($6+1)) = pc - elseinit; } *($4) = IFFJMP; *((Word *)($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){align(Word,1);code_byte(SETLINE);code_word(lua_linenumber);}} RETURN exprlist sc { if (lua_debug) code_byte(RESET); code_byte(RETCODE); code_byte(nlocalvar); } ; PrepJump : /* empty */ { align(Word,1); $$ = 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 { align(Word,1); code_byte(PUSHSTRING); code_word($1); $$ = 1; incr_ntemp(); } | NIL {code_byte(PUSHNIL); $$ = 1; incr_ntemp();} | functioncall { $$ = 0; if (lua_debug) { align(Word,1); code_byte(SETLINE); code_word(lua_linenumber); } } | NOT expr1 { code_byte(NOTOP); $$ = 1;} | expr1 AND PrepJump {code_byte(POP); ntemp--;} expr1 { *($3) = ONFJMP; *((Word *)($3+1)) = pc - ($3 + sizeof(Word)+1); $$ = 1; } | expr1 OR PrepJump {code_byte(POP); ntemp--;} expr1 { *($3) = ONTJMP; *((Word *)($3+1)) = pc - ($3 + sizeof(Word)+1); $$ = 1; } ; typeconstructor: '@' { code_byte(PUSHBYTE); $$ = pc; code_byte(0); incr_ntemp(); code_byte(CREATEARRAY); } objectname fieldlist { *($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) { align(Word,1); 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]=$1; add_nlocalvar(1);} | parlist1 ',' NAME {localvar[nlocalvar]=$3; add_nlocalvar(1);} ; objectname : /* empty */ {$$=-1;} | NAME {$$=$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 '=' expr1 { push_field($1); } ; 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 { int local = lua_localname ($1); if (local == -1) /* global var */ $$ = $1 + 1; /* return positive value */ else $$ = -(local+1); /* return negative value */ } | var {lua_pushvar ($1);} '[' expr1 ']' { $$ = 0; /* indexed variable */ } | var {lua_pushvar ($1);} '.' NAME { align(Word,1); code_byte(PUSHSTRING); code_word(lua_findconstant (s_name($4))); incr_ntemp(); $$ = 0; /* indexed variable */ } ; localdeclist : NAME {localvar[nlocalvar]=$1; $$ = 1;} | localdeclist ',' NAME {localvar[nlocalvar+$1]=$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 */ { align(Word,1); 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 */ { align(Word,1); 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