%{
char *rcs_luastx = "$Id: lua.stx,v 3.15 1994/12/27 20:04:29 celes Exp celes $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "mem.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "tree.h"
#include "table.h"
#include "lua.h"
/* to avoid warnings generated by yacc */
int yyparse (void);
#define malloc luaI_malloc
#define realloc luaI_realloc
#define free luaI_free
#ifndef LISTING
#define LISTING 0
#endif
#ifndef CODE_BLOCK
#define CODE_BLOCK 256
#endif
static int maxcode;
static int maxmain;
static Long maxcurr; /* to allow maxcurr *= 2 without overflow */
static Byte *funcCode = NULL;
static Byte **initcode;
static Byte *basepc;
static int maincode;
static int 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;
/* Internal functions */
static void code_byte (Byte c)
{
if (pc>maxcurr-2) /* 1 byte free to code HALT of main code */
{
if (maxcurr >= MAX_INT)
lua_error("code size overflow");
maxcurr *= 2;
if (maxcurr >= MAX_INT)
maxcurr = MAX_INT;
basepc = growvector(basepc, maxcurr, Byte);
}
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_code (Byte *b)
{
CodeCode code;
code.b = b;
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");
}
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]);
}
static void flush_list (int m, int n)
{
if (n == 0) return;
if (m == 0)
code_byte(STORELIST0);
else
if (m < 255)
{
code_byte(STORELIST);
code_byte(m);
}
else
lua_error ("list constructor too long");
code_byte(n);
}
static void add_nlocalvar (int n)
{
if (MAX_TEMPS+nlocalvar+MAXVAR+n < STACKGAP)
nlocalvar += n;
else
lua_error ("too many local variables");
}
static void incr_nvarbuffer (void)
{
if (nvarbuffer < MAXVAR-1)
nvarbuffer++;
else
lua_error ("variable buffer overflow");
}
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);
}
}
/*
** 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);
}
else if (number < 0) /* local var */
{
number = (-number) - 1;
if (number < 10) code_byte(PUSHLOCAL0 + number);
else
{
code_byte(PUSHLOCAL);
code_byte(number);
}
}
else
{
code_byte(PUSHINDEXED);
}
}
static void lua_codeadjust (int n)
{
if (n+nlocalvar == 0)
code_byte(ADJUST0);
else
{
code_byte(ADJUST);
code_byte(n+nlocalvar);
}
}
static void init_function (TreeNode *func)
{
if (funcCode == NULL) /* first function */
{
funcCode = newvector(CODE_BLOCK, Byte);
maxcode = CODE_BLOCK;
}
pc=0; basepc=funcCode; maxcurr=maxcode;
nlocalvar=0;
if (lua_debug)
{
code_byte(SETFUNCTION);
code_code((Byte *)strdup(lua_file[lua_nfile-1]));
code_word(luaI_findconstant(func));
}
}
static void codereturn (void)
{
if (lua_debug) code_byte(RESET);
if (nlocalvar == 0)
code_byte(RETCODE0);
else
{
code_byte(RETCODE);
code_byte(nlocalvar);
}
}
static void codedebugline (void)
{
if (lua_debug)
{
code_byte(SETLINE);
code_word(lua_linenumber);
}
}
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)
{
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);
}
}
}
static void codeIf (Long thenAdd, Long elseAdd)
{
Long elseinit = elseAdd+sizeof(Word)+1;
if (pc == elseinit) /* no else */
{
pc -= sizeof(Word)+1;
elseinit = pc;
}
else
{
basepc[elseAdd] = JMP;
code_word_at(basepc+elseAdd+1, pc-elseinit);
}
basepc[thenAdd] = IFFJMP;
code_word_at(basepc+thenAdd+1,elseinit-(thenAdd+sizeof(Word)+1));
}
static 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);
}
/*
** Parse LUA code.
*/
void lua_parse (Byte **code)
{
initcode = code;
*initcode = newvector(CODE_BLOCK, Byte);
maincode = 0;
maxmain = CODE_BLOCK;
if (yyparse ()) lua_error("parse error");
(*initcode)[maincode++] = RETCODE0;
#if LISTING
{ static void PrintCode (Byte *c, Byte *end);
PrintCode(*initcode,*initcode+maincode); }
#endif
}
%}
%union
{
int vInt;
float vFloat;
char *pChar;
Word vWord;
Long vLong;
Byte *pByte;
TreeNode *pNode;
}
%start functionlist
%token WRONGTOKEN
%token NIL
%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
%token RETURN
%token LOCAL
%token FUNCTION
%token <vFloat> NUMBER
%token <vWord> STRING
%token <pNode> NAME
%token <vInt> DEBUG
%type <vLong> PrepJump
%type <vInt> expr, exprlist, exprlist1, varlist1, funcParams, funcvalue
%type <vInt> fieldlist, localdeclist, decinit
%type <vInt> ffieldlist1
%type <vInt> lfieldlist1
%type <vLong> var, singlevar
%type <pByte> body
%left AND OR
%left EQ NE '>' '<' LE GE
%left CONC
%left '+' '-'
%left '*' '/'
%left UNARY NOT
%right '^'
%% /* 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 method
| functionlist setdebug
;
function : FUNCTION NAME
{
init_function($2);
}
body
{
Word func = luaI_findsymbol($2);
s_tag(func) = LUA_T_FUNCTION;
s_bvalue(func) = $4;
}
;
method : FUNCTION NAME ':' NAME
{
init_function($4);
localvar[nlocalvar]=luaI_findsymbolbyname("self");
add_nlocalvar(1);
}
body
{
/* assign function to table field */
pc=maincode; basepc=*initcode; maxcurr=maxmain;
nlocalvar=0;
lua_pushvar(luaI_findsymbol($2)+1);
code_byte(PUSHSTRING);
code_word(luaI_findconstant($4));
code_byte(PUSHFUNCTION);
code_code($6);
code_byte(STOREINDEXED0);
maincode=pc; *initcode=basepc; maxmain=maxcurr;
}
;
body : '(' parlist ')' block END
{
codereturn();
$$ = newvector(pc, Byte);
memcpy($$, basepc, pc*sizeof(Byte));
funcCode = basepc; maxcode=maxcurr;
#if LISTING
PrintCode(funcCode,funcCode+pc);
#endif
}
;
statlist : /* empty */
| statlist stat sc
;
sc : /* empty */ | ';' ;
stat : { codedebugline(); } stat1 ;
cond : { codedebugline(); } expr1 ;
stat1 : IF expr1 THEN PrepJump block PrepJump elsepart END
{ codeIf($4, $6); }
| 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 cond PrepJump
{
basepc[$6] = IFFUPJMP;
code_word_at(basepc+$6+1, pc - ($<vLong>2));
}
| varlist1 '=' exprlist1
{
{
int i;
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 { code_byte(0); }
| LOCAL localdeclist decinit
{ add_nlocalvar($2);
adjust_mult_assign($2, $3, 0);
}
;
elsepart : /* empty */
| ELSE block
| ELSEIF cond THEN PrepJump block PrepJump elsepart
{ codeIf($4, $6); }
;
block : {$<vInt>$ = nlocalvar;} statlist ret
{
if (nlocalvar != $<vInt>1)
{
nlocalvar = $<vInt>1;
lua_codeadjust (0);
}
}
;
ret : /* empty */
| RETURN { codedebugline(); } exprlist sc
{
if ($3 < 0) code_byte(MULT_RET);
codereturn();
}
;
PrepJump : /* empty */
{
$$ = pc;
code_byte(0); /* open space */
code_word (0);
}
expr1 : expr { if ($1 == 0) code_byte(1); }
;
expr : '(' expr ')' { $$ = $2; }
| expr1 EQ expr1 { code_byte(EQOP); $$ = 1; }
| expr1 '<' expr1 { code_byte(LTOP); $$ = 1; }
| expr1 '>' expr1 { code_byte(GTOP); $$ = 1; }
| expr1 NE expr1 { code_byte(EQOP); code_byte(NOTOP); $$ = 1; }
| expr1 LE expr1 { code_byte(LEOP); $$ = 1; }
| expr1 GE expr1 { code_byte(GEOP); $$ = 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 { code_byte(MINUSOP); $$ = 1;}
| table { $$ = 1; }
| varexp { $$ = 1;}
| NUMBER { code_number($1); $$ = 1; }
| STRING
{
code_byte(PUSHSTRING);
code_word($1);
$$ = 1;
}
| NIL {code_byte(PUSHNIL); $$ = 1; }
| functioncall { $$ = 0; }
| NOT expr1 { code_byte(NOTOP); $$ = 1;}
| 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); } expr1
{
basepc[$3] = ONTJMP;
code_word_at(basepc+$3+1, pc - ($3 + sizeof(Word)+1));
$$ = 1;
}
;
table :
{
code_byte(CREATEARRAY);
$<vLong>$ = pc; code_word(0);
}
'{' fieldlist '}'
{
code_word_at(basepc+$<vLong>1, $3);
}
;
functioncall : funcvalue funcParams
{ code_byte(CALLFUNC); code_byte($1+$2); }
;
funcvalue : varexp { $$ = 0; }
| varexp ':' NAME
{
code_byte(PUSHSELF);
code_word(luaI_findconstant($3));
$$ = 1;
}
;
funcParams : '(' exprlist ')'
{ if ($2<0) { code_byte(1); $$ = -$2; } else $$ = $2; }
| table { $$ = 1; }
;
exprlist : /* empty */ { $$ = 0; }
| exprlist1 { $$ = $1; }
;
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 */ { lua_codeadjust(0); }
| parlist1 { lua_codeadjust(0); }
;
parlist1 : NAME
{
localvar[nlocalvar]=luaI_findsymbol($1);
add_nlocalvar(1);
}
| parlist1 ',' NAME
{
localvar[nlocalvar]=luaI_findsymbol($3);
add_nlocalvar(1);
}
;
fieldlist : /* empty */ { $$ = 0; }
| lfieldlist1 lastcomma
{ $$ = $1; flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
| ffieldlist1 lastcomma
{ $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
| lfieldlist1 ';'
{ flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
ffieldlist1 lastcomma
{ $$ = $1+$4; flush_record($4%FIELDS_PER_FLUSH); }
;
lastcomma : /* empty */
| ','
;
ffieldlist1 : ffield {$$=1;}
| ffieldlist1 ',' ffield
{
$$=$1+1;
if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
}
;
ffield : NAME '=' expr1
{
push_field(luaI_findconstant($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 : singlevar { $$ = $1; }
| varexp '[' expr1 ']'
{
$$ = 0; /* indexed variable */
}
| varexp '.' NAME
{
code_byte(PUSHSTRING);
code_word(luaI_findconstant($3));
$$ = 0; /* indexed variable */
}
;
singlevar : NAME
{
Word s = luaI_findsymbol($1);
int local = lua_localname (s);
if (local == -1) /* global var */
$$ = s + 1; /* return positive value */
else
$$ = -(local+1); /* return negative value */
}
;
varexp : var { lua_pushvar($1); }
;
localdeclist : NAME {localvar[nlocalvar]=luaI_findsymbol($1); $$ = 1;}
| localdeclist ',' NAME
{
localvar[nlocalvar+$1]=luaI_findsymbol($3);
$$ = $1+1;
}
;
decinit : /* empty */ { $$ = 0; }
| '=' exprlist1 { $$ = $2; }
;
setdebug : DEBUG {lua_debug = $1;}
%%
#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 PUSHFUNCTION:
{
CodeCode c;
int n = p-code;
p++;
get_code(c,p);
printf ("%d PUSHFUNCTION %p\n", n, c.b);
}
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 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 PUSHSELF:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d PUSHSELF %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 ADJUST0: printf ("%d ADJUST0\n", (p++)-code); break;
case ADJUST:
printf ("%d ADJUST %d\n", p-code, *(++p));
p++;
break;
case CREATEARRAY:
{
CodeWord c;
int n = p-code;
p++;
get_word(c,p);
printf ("%d CREATEARRAY %d\n", n, c.w);
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 POWOP: printf ("%d POWOP\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 %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 SETFUNCTION:
{
CodeCode c1;
CodeWord c2;
int n = p-code;
p++;
get_code(c1,p);
get_word(c2,p);
printf ("%d SETFUNCTION %s %d\n", n, (char *)c1.b, 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