lua.lua/lua.stx

%{

char *rcs_luastx = "$Id: $";

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "table.h"
#include "lua.h"

#ifndef ALIGNMENT
#define ALIGNMENT	(sizeof(void *))
#endif

#ifndef MAXCODE
#define MAXCODE 1024
#endif
static long   buffer[MAXCODE];
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];
static Byte    nvarbuffer=0;	     /* number of variables at a list */

static Word    localvar[STACKGAP];
static Byte    nlocalvar=0;	     /* number of local variables */
static int     ntemp;		     /* number of temporary var into stack */
static int     err;		     /* flag to indicate error */

/* Internal functions */
#define align(n)  align_n(sizeof(n))

static void code_byte (Byte c)
{
 if (pc-basepc>MAXCODE-1)
 {
  lua_error ("code buffer overflow");
  err = 1;
 }
 *pc++ = c;
}

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 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 align_n (unsigned size)
{
 if (size > ALIGNMENT) size = ALIGNMENT;
 while (((pc+1-code)%size) != 0)	/* +1 to include BYTECODE */
  code_byte (NOP);
}

static void code_number (float f)
{ int i = f;
  if (f == i)  /* f has an integer value */
  {
   if (i <= 2) code_byte(PUSH0 + i);
   else if (i <= 255)
   {
    code_byte(PUSHBYTE);
    code_byte(i);
   }
   else
   {
    align(Word);
    code_byte(PUSHWORD);
    code_word(i);
   }
  }
  else
  {
   align(float);
   code_byte(PUSHFLOAT);
   code_float(f);
  }
  incr_ntemp();
}

%}


%union 
{
 int   vInt;
 long  vLong;
 float vFloat;
 Word  vWord;
 Byte *pByte;
}

%start functionlist

%token NIL
%token IF THEN ELSE ELSEIF WHILE DO REPEAT UNTIL END
%token RETURN
%token LOCAL
%token <vFloat> NUMBER
%token <vWord>  FUNCTION NAME STRING
%token <vInt>   DEBUG

%type <pByte> 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=basepc=maincode; nlocalvar=0;} stat sc {maincode=pc;}
	     | functionlist function
	     | functionlist setdebug
	     ;
	     
function     : FUNCTION NAME {pc=basepc=code; nlocalvar=0;} '(' parlist ')' 
	       {
	        if (lua_debug)
		{
		 align(Word);
	         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));
	       }
	       ;

statlist : /* empty */
	 | statlist stat sc
	 ;

stat	 : {
            ntemp = 0; 
            if (lua_debug)
            {
             align(Word); 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 {$<pByte>$ = pc;} expr1 DO PrepJump block PrepJump END
     	
       {
        *($5) = IFFJMP;
        *((Word *)($5+1)) = pc - ($5 + sizeof(Word)+1);
        
        *($7) = UPJMP;
        *((Word *)($7+1)) = pc - $<pByte>2;
       }
     
       | REPEAT {$<pByte>$ = pc;} block UNTIL expr1 PrepJump
     	
       {
        *($6) = IFFUPJMP;
        *((Word *)($6+1)) = pc - $<pByte>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    : {$<vInt>$ = nlocalvar;} statlist {ntemp = 0;} ret 
         {
	  if (nlocalvar != $<vInt>1)
	  {
           nlocalvar = $<vInt>1;
	   lua_codeadjust (0);
	  }
         }
         ;

ret	: /* empty */
        | { if (lua_debug){align(Word);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); 
	  $$ = 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);
      code_byte(PUSHSTRING);
      code_word($1);
      $$ = 1;
      incr_ntemp();
     }
     |	NIL		{code_byte(PUSHNIL); $$ = 1; incr_ntemp();}
     |	functioncall
     {
      $$ = 0;
      if (lua_debug)
      {
       align(Word); 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);
      $<pByte>$ = pc; code_byte(0);
      incr_ntemp();
      code_byte(CREATEARRAY);
     }
      objectname fieldlist 
     {
      *($<pByte>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); 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]=$1; add_nlocalvar(1);}
	  |	parlist1 ',' NAME {localvar[nlocalvar]=$3; add_nlocalvar(1);}
	  ;
		
objectname :	/* empty */ 	{$$=-1;}
	   |	NAME		{$$=$1;}
	   ;
	   
fieldlist  : '{' ffieldlist '}'  { $$ = $2; }
           | '[' lfieldlist ']'  { $$ = $2; }
	   ;

ffieldlist : /* empty */   { $$ = 0; }
           | ffieldlist1   { $$ = $1; }
           ;

ffieldlist1 : ffield			{$$=1;}
	   | ffieldlist1 ',' ffield	{$$=$1+1;}
	   ; 

ffield      : NAME 
           {
            align(Word); 
            code_byte(PUSHSTRING);
	    code_word(lua_findconstant (s_name($1)));
            incr_ntemp();
	   }
            '=' expr1
	   {
	    code_byte(STOREFIELD);
	    ntemp-=2;
	   }
           ;

lfieldlist : /* empty */   { $$ = 0; }
           | lfieldlist1   { $$ = $1; }
           ;

lfieldlist1 : { code_number(1); } lfield  {$$=1;}
	    | lfieldlist1 ',' { code_number($1+1); } lfield
              {$$=$1+1;}
            ;

lfield      : expr1
	   {
	    code_byte(STOREFIELD);
	    ntemp-=2;
	   }
           ;
		
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);
	   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);
  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);
  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 *initcode = maincode;
 err = 0;
 if (yyparse () || (err==1)) return 1;
 *maincode++ = HALT;
 if (lua_execute (initcode)) return 1;
 maincode = initcode;
 return 0;
}


#if 0

static void PrintCode (void)
{
 Byte *p = code;
 printf ("\n\nCODE\n");
 while (p != pc)
 {
  switch ((OpCode)*p)
  {
   case NOP:		printf ("%d    NOP\n", (p++)-code); break;
   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:
    			printf ("%d    PUSHWORD   %d\n", p-code, *((Word *)(p+1)));
    			p += 1 + sizeof(Word);
   			break;
   case PUSHFLOAT:
    			printf ("%d    PUSHFLOAT  %f\n", p-code, *((float *)(p+1)));
    			p += 1 + sizeof(float);
   			break;
   case PUSHSTRING:
    			printf ("%d    PUSHSTRING   %d\n", p-code, *((Word *)(p+1)));
    			p += 1 + sizeof(Word);
   			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:
    			printf ("%d    PUSHGLOBAL   %d\n", p-code, *((Word *)(p+1)));
    			p += 1 + sizeof(Word);
   			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    STORELOCAK   %d\n", p-code, *(++p));
    			p++;
   			break;
   case STOREGLOBAL:
    			printf ("%d    STOREGLOBAL   %d\n", p-code, *((Word *)(p+1)));
    			p += 1 + sizeof(Word);
   			break;
   case STOREINDEXED0:  printf ("%d    STOREINDEXED0\n", (p++)-code); break;
   case STOREINDEXED:   printf ("%d    STOREINDEXED   %d\n", p-code, *(++p));
    			p++;
   			break;
   case STOREFIELD:     printf ("%d    STOREFIELD\n", (p++)-code); 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:	   
    			printf ("%d    ONTJMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			break;
   case ONFJMP:	   
    			printf ("%d    ONFJMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			break;
   case JMP:	   
    			printf ("%d    JMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			break;
   case UPJMP:
    			printf ("%d    UPJMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			break;
   case IFFJMP:
    			printf ("%d    IFFJMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			break;
   case IFFUPJMP:
    			printf ("%d    IFFUPJMP  %d\n", p-code, *((Word *)(p+1)));
    			p += sizeof(Word) + 1;
   			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;
   default:		printf ("%d    Cannot happen\n", (p++)-code); break;
  }
 }
}
#endif