%{ char *rcs_luastx = "$Id: lua.stx,v 2.4 1994/04/20 16:22:21 celes Exp celes $"; #include <stdio.h> #include <stdlib.h> #include <string.h> #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<n; i++) code_word(fields[--nfields]); ntemp -= n; } static void flush_list (int m, int n) { if (n == 0) return; if (m == 0) code_byte(STORELIST0); else { code_byte(STORELIST); code_byte(m); } 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) nlocalvar += n; else { lua_error ("too many local variables or expression too complicate"); err = 1; } } static void incr_nvarbuffer (void) { if (nvarbuffer < MAXVAR-1) nvarbuffer++; else { lua_error ("variable buffer overflow"); err = 1; } } static void code_number (float f) { Word i = (Word)f; if (f == (float)i) /* f has an (short) integer value */ { if (i <= 2) code_byte(PUSH0 + i); else if (i <= 255) { code_byte(PUSHBYTE); code_byte(i); } else { code_byte(PUSHWORD); code_word(i); } } else { code_byte(PUSHFLOAT); code_float(f); } incr_ntemp(); } %} %union { int vInt; float vFloat; char *pChar; Word vWord; Long vLong; Byte *pByte; } %start functionlist %token WRONGTOKEN %token NIL %token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END %token RETURN %token LOCAL %token <vFloat> NUMBER %token <vWord> FUNCTION STRING %token <pChar> NAME %token <vInt> DEBUG %type <vLong> PrepJump %type <vInt> expr, exprlist, exprlist1, varlist1, typeconstructor %type <vInt> fieldlist, localdeclist %type <vInt> ffieldlist, ffieldlist1 %type <vInt> lfieldlist, lfieldlist1 %type <vLong> 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; $<vWord>$ = lua_findsymbol($2); } '(' parlist ')' { if (lua_debug) { code_byte(SETFUNCTION); code_word(lua_nfile-1); code_word($<vWord>3); } lua_codeadjust (0); } block END { if (lua_debug) code_byte(RESET); code_byte(RETCODE); code_byte(nlocalvar); s_tag($<vWord>3) = T_FUNCTION; s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte)); if (s_bvalue($<vWord>3) == NULL) { lua_error("not enough memory"); err = 1; } memcpy (s_bvalue($<vWord>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 {$<vLong>$=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 - ($<vLong>2)); } | REPEAT {$<vLong>$=pc;} block UNTIL expr1 PrepJump { basepc[$6] = IFFUPJMP; code_word_at(basepc+$6+1, pc - ($<vLong>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 : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret { if (nlocalvar != $<vInt>1) { nlocalvar = $<vInt>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(PUSHBYTE); $<vLong>$ = pc; code_byte(0); incr_ntemp(); code_byte(CREATEARRAY); } objectname fieldlist { basepc[$<vLong>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); $<vInt>$ = ntemp; incr_ntemp();} '(' exprlist ')' { code_byte(CALLFUNC); ntemp = $<vInt>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 {$<vWord>$ = lua_findconstant($1);} '=' expr1 { push_field($<vWord>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 <nvarbuffer; j++) if (varbuffer[j] == 0) upper++; param = upper*2 + i; if (param == 0) code_byte(STOREINDEXED0); else { code_byte(STOREINDEXED); code_byte(param); } } } void yyerror (char *s) { static char msg[256]; sprintf (msg,"%s near \"%s\" at line %d in file \"%s\"", s, lua_lasttext (), lua_linenumber, lua_filename()); lua_error (msg); err = 1; } int yywrap (void) { return 1; } /* ** Parse LUA code and execute global statement. ** Return 0 on success or 1 on error. */ int lua_parse (void) { Byte *init = initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte)); maincode = 0; maxmain = CODE_BLOCK; if (init == NULL) { lua_error("not enough memory"); return 1; } err = 0; if (yyparse () || (err==1)) return 1; initcode[maincode++] = HALT; init = initcode; #if LISTING PrintCode(init,init+maincode); #endif if (lua_execute (init)) return 1; free(init); return 0; } #if LISTING static void PrintCode (Byte *code, Byte *end) { Byte *p = code; printf ("\n\nCODE\n"); while (p != end) { switch ((OpCode)*p) { case PUSHNIL: printf ("%d PUSHNIL\n", (p++)-code); break; case PUSH0: case PUSH1: case PUSH2: printf ("%d PUSH%c\n", p-code, *p-PUSH0+'0'); p++; break; case PUSHBYTE: printf ("%d PUSHBYTE %d\n", p-code, *(++p)); p++; break; case PUSHWORD: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d PUSHWORD %d\n", n, c.w); } break; case PUSHFLOAT: { CodeFloat c; int n = p-code; p++; get_float(c,p); printf ("%d PUSHFLOAT %f\n", n, c.f); } break; case PUSHSTRING: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d PUSHSTRING %d\n", n, c.w); } break; case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8: case PUSHLOCAL9: printf ("%d PUSHLOCAL%c\n", p-code, *p-PUSHLOCAL0+'0'); p++; break; case PUSHLOCAL: printf ("%d PUSHLOCAL %d\n", p-code, *(++p)); p++; break; case PUSHGLOBAL: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d PUSHGLOBAL %d\n", n, c.w); } break; case PUSHINDEXED: printf ("%d PUSHINDEXED\n", (p++)-code); break; case PUSHMARK: printf ("%d PUSHMARK\n", (p++)-code); break; case PUSHOBJECT: printf ("%d PUSHOBJECT\n", (p++)-code); break; case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: case STORELOCAL3: case STORELOCAL4: case STORELOCAL5: case STORELOCAL6: case STORELOCAL7: case STORELOCAL8: case STORELOCAL9: printf ("%d STORELOCAL%c\n", p-code, *p-STORELOCAL0+'0'); p++; break; case STORELOCAL: printf ("%d STORELOCAL %d\n", p-code, *(++p)); p++; break; case STOREGLOBAL: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d STOREGLOBAL %d\n", n, c.w); } break; case STOREINDEXED0: printf ("%d STOREINDEXED0\n", (p++)-code); break; case STOREINDEXED: printf ("%d STOREINDEXED %d\n", p-code, *(++p)); p++; break; case STORELIST0: printf("%d STORELIST0 %d\n", p-code, *(++p)); p++; break; case STORELIST: printf("%d STORELIST %d %d\n", p-code, *(p+1), *(p+2)); p+=3; break; case STORERECORD: printf("%d STORERECORD %d\n", p-code, *(++p)); p += *p*sizeof(Word) + 1; break; case ADJUST: printf ("%d ADJUST %d\n", p-code, *(++p)); p++; break; case CREATEARRAY: printf ("%d CREATEARRAY\n", (p++)-code); break; case EQOP: printf ("%d EQOP\n", (p++)-code); break; case LTOP: printf ("%d LTOP\n", (p++)-code); break; case LEOP: printf ("%d LEOP\n", (p++)-code); break; case ADDOP: printf ("%d ADDOP\n", (p++)-code); break; case SUBOP: printf ("%d SUBOP\n", (p++)-code); break; case MULTOP: printf ("%d MULTOP\n", (p++)-code); break; case DIVOP: printf ("%d DIVOP\n", (p++)-code); break; case CONCOP: printf ("%d CONCOP\n", (p++)-code); break; case MINUSOP: printf ("%d MINUSOP\n", (p++)-code); break; case NOTOP: printf ("%d NOTOP\n", (p++)-code); break; case ONTJMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d ONTJMP %d\n", n, c.w); } break; case ONFJMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d ONFJMP %d\n", n, c.w); } break; case JMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d JMP %d\n", n, c.w); } break; case UPJMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d UPJMP %d\n", n, c.w); } break; case IFFJMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d IFFJMP %d\n", n, c.w); } break; case IFFUPJMP: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d IFFUPJMP %d\n", n, c.w); } break; case POP: printf ("%d POP\n", (p++)-code); break; case CALLFUNC: printf ("%d CALLFUNC\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: { CodeWord c1, c2; int n = p-code; p++; get_word(c1,p); get_word(c2,p); printf ("%d SETFUNCTION %d %d\n", n, c1.w, c2.w); } break; case SETLINE: { CodeWord c; int n = p-code; p++; get_word(c,p); printf ("%d SETLINE %d\n", n, c.w); } break; case RESET: printf ("%d RESET\n", (p++)-code); break; default: printf ("%d Cannot happen: code %d\n", (p++)-code, *(p-1)); break; } } } #endif