lua/lua.stx
Waldemar Celes b1e9b37883 Implementacao de funcoes para tratar Lua function em C e
correcoes de bugs nas tabelas dinamicas.
1994-08-03 11:15:46 -03:00

961 lines
21 KiB
Plaintext

%{
char *rcs_luastx = "$Id: lua.stx,v 2.5 1994/07/19 21:27:18 celes Exp $";
#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
if (m < 255)
{
code_byte(STORELIST);
code_byte(m);
}
else
{
lua_error ("list constructor too long");
err = 1;
}
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(PUSHWORD);
$<vLong>$ = pc; code_word(0);
incr_ntemp();
code_byte(CREATEARRAY);
}
objectname fieldlist
{
code_word_at(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