lua/lua.stx

%{

char *rcs_luastx = "$Id: lua.stx,v 3.47 1997/06/19 17:46:12 roberto Exp roberto $";

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

#include "luadebug.h"
#include "luamem.h"
#include "lex.h"
#include "opcode.h"
#include "hash.h"
#include "inout.h"
#include "tree.h"
#include "table.h"
#include "lua.h"
#include "func.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 1000
#endif

#define MAXLOCALS 32

/* state needed to generate code for a given function */
struct State {
  TFunc *f;  /* current function header */
  int codesize;
  int pc;  /* next position to code */
  TaggedString *localvar[MAXLOCALS];  /* store local variable names */
  int nlocalvar;  /* number of active local variables */
  int nvars;  /* total number of local variables (for debugging information) */
  int maxvars;  /* = -1 if no debug information */
} stateMain, stateFunc, *currState;


#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 */


#define MAXFIELDS FIELDS_PER_FLUSH*2

int lua_debug = 0;

/* Internal functions */

static void yyerror (char *s)
{
  luaI_syntaxerror(s);
}

static void check_space (int i)
{
  if (currState->pc+i >= currState->codesize)
    currState->codesize = growvector(&currState->f->code, currState->codesize,
                                     Byte, codeEM, MAX_INT);
}

static void code_byte (Byte c)
{
  check_space(1);
  currState->f->code[currState->pc++] = c;
}

static void code_float (real n)
{
  check_space(sizeof(real));
  memcpy(currState->f->code+currState->pc, &n, sizeof(real));
  currState->pc += sizeof(real);
}

static void code_code (TFunc *tf)
{
  check_space(sizeof(TFunc *));
  memcpy(currState->f->code+currState->pc, &tf, sizeof(TFunc *));
  currState->pc += sizeof(TFunc *);
}

static void code_word_at (int pc, int n)
{
  Word w = n;
  if (w != n)
    yyerror("block too big");
  memcpy(currState->f->code+pc, &w, sizeof(Word));
}

static void code_word (Word n)
{
  check_space(sizeof(Word));
  memcpy(currState->f->code+currState->pc, &n, sizeof(Word));
  currState->pc += sizeof(Word);
}

static void flush_record (int n)
{
  if (n == 0) return;
  code_byte(STOREMAP);
  code_byte(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
   yyerror ("list constructor too long");
  code_byte(n);
}


static void luaI_registerlocalvar (TaggedString *varname, int line)
{
  if (currState->maxvars != -1) {  /* debug information? */
    if (currState->nvars >= currState->maxvars)
      currState->maxvars = growvector(&currState->f->locvars,
                                      currState->maxvars, LocVar, "", MAX_WORD);
    currState->f->locvars[currState->nvars].varname = varname;
    currState->f->locvars[currState->nvars].line = line;
    currState->nvars++;
  }
}


static void luaI_unregisterlocalvar (int line)
{
  luaI_registerlocalvar(NULL, line);
}


static void store_localvar (TaggedString *name, int n)
{
  if (currState->nlocalvar+n < MAXLOCALS)
    currState->localvar[currState->nlocalvar+n] = name;
  else
    yyerror ("too many local variables");
  luaI_registerlocalvar(name, lua_linenumber);
}

static void add_localvar (TaggedString *name)
{
  store_localvar(name, 0);
  currState->nlocalvar++;
}

static void add_varbuffer (Long var)
{
 if (nvarbuffer < MAXVAR)
  varbuffer[nvarbuffer++] = var;
 else
  yyerror ("variable buffer overflow");
}

static void code_string (Word w)
{
  code_byte(PUSHSTRING);
  code_word(w);
}

static void code_constant (TaggedString *s)
{
  code_string(luaI_findconstant(s));
}

static void code_number (float f)
{ 
  Word i;
  if (f >= 0 && f <= (float)MAX_WORD && (float)(i=(Word)f) == f) {
   /* 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 (TaggedString *n)
{
 int i;
 for (i=currState->nlocalvar-1; i >= 0; i--)
  if (n == currState->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)
{
  n += currState->nlocalvar;
  if (n == 0)
    code_byte(ADJUST0);
  else {
    code_byte(ADJUST);
    code_byte(n);
  }
}


static void init_state (TFunc *f)
{
  luaI_initTFunc(f);
  currState->nlocalvar = 0;
  currState->f = f;
  currState->pc = 0;
  currState->codesize = CODE_BLOCK;
  f->code = newvector(CODE_BLOCK, Byte);
  if (lua_debug) {
    currState->nvars = 0;
    currState->maxvars = 0;
  }
  else
    currState->maxvars = -1;  /* flag no debug information */
}


static void init_func (void)
{
  currState = &stateFunc;
  init_state(new(TFunc));
  luaI_codedebugline(lua_linenumber);
}


static void codereturn (void)
{
  if (currState->nlocalvar == 0)
    code_byte(RETCODE0);
  else
  {
    code_byte(RETCODE);
    code_byte(currState->nlocalvar);
  }
}


static void close_func (void)
{
  codereturn();
  code_byte(ENDCODE);
  currState->f->code = shrinkvector(currState->f->code, currState->pc, Byte);
  if (currState->maxvars != -1) {  /* debug information? */
    luaI_registerlocalvar(NULL, -1);  /* flag end of vector */
    currState->f->locvars = shrinkvector(currState->f->locvars,
                                    currState->nvars, LocVar);
  }
}


void luaI_codedebugline (int line)
{
  static int lastline = 0;
  if (lua_debug && line != lastline)
  {
    code_byte(SETLINE);
    code_word(line);
    lastline = line;
  }
}

static int adjust_functioncall (Long exp, int i)
{
  if (exp <= 0)
    return -exp; /* exp is -list length */
  else {
    int temp = currState->f->code[exp];
    currState->f->code[exp] = i;
    return temp+i;
  }
}

static void adjust_mult_assign (int vars, Long exps, int temps)
{
  if (exps > 0) { /* must correct function call */
    int diff = vars - currState->f->code[exps];
    if (diff >= 0)
      adjust_functioncall(exps, diff);
    else {
      adjust_functioncall(exps, 0);
      lua_codeadjust(temps);
    }
  }
  else if (vars != -exps)
    lua_codeadjust(temps);
}

static int close_parlist (int dots)
{
  if (!dots)
    lua_codeadjust(0);
  else {
    code_byte(VARARGS);
    code_byte(currState->nlocalvar);
    add_localvar(luaI_createfixedstring("arg"));
  }
  return lua_linenumber;
}


static void storesinglevar (Long v)
{
 if (v > 0)		/* global var */
 {
   code_byte(STOREGLOBAL);
   code_word(v-1);
 }
 else if (v < 0)      /* local var */
 {
   int number = (-v) - 1;
   if (number < 10) code_byte(STORELOCAL0 + number);
   else
   {
     code_byte(STORELOCAL);
     code_byte(number);
   }
 }
 else 
   code_byte(STOREINDEXED0);
}


static void lua_codestore (int i)
{
 if (varbuffer[i] != 0)  /* global or local var */
  storesinglevar(varbuffer[i]);
 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 (currState->pc == elseinit) {  /* no else */
    currState->pc -= sizeof(Word)+1;
    elseinit = currState->pc;
  }
  else {
    currState->f->code[elseAdd] = JMP;
    code_word_at(elseAdd+1, currState->pc-elseinit);
  }
  currState->f->code[thenAdd] = IFFJMP;
  code_word_at(thenAdd+1, elseinit-(thenAdd+sizeof(Word)+1));
}


static void code_shortcircuit (int pc, Byte jmp)
{
  currState->f->code[pc] = jmp;
  code_word_at(pc+1, currState->pc - (pc + sizeof(Word)+1));
}


/*
** Parse LUA code.
*/
void lua_parse (TFunc *tf)
{
  currState = &stateMain;
  init_state(tf);
  if (yyparse ()) lua_error("parse error");
  currState = &stateMain;
  close_func();
}


%}


%union 
{
 int   vInt;
 float vFloat;
 char *pChar;
 Word  vWord;
 Long  vLong;
 TFunc *pFunc;
 TaggedString *pTStr;
}

%start chunk

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

%type <vLong> PrepJump
%type <vLong> exprlist, exprlist1  /* if > 0, points to function return
	counter (which has list length); if <= 0, -list lenght */
%type <vLong> functioncall, expr  /* if != 0, points to function return
					 counter */
%type <vInt>  varlist1, funcParams, funcvalue
%type <vInt>  fieldlist, localdeclist, decinit
%type <vInt>  ffieldlist, ffieldlist1, semicolonpart
%type <vInt>  lfieldlist, lfieldlist1
%type <vInt>  parlist, parlist1, par
%type <vLong> var, singlevar, funcname
%type <pFunc> body

%left AND OR
%left EQ NE '>' '<' LE GE
%left CONC
%left '+' '-'
%left '*' '/'
%left UNARY NOT
%right '^'


%% /* beginning of rules section */

chunk	: chunklist ret ;

chunklist : /* empty */
	  | chunklist stat sc
	  | chunklist function
	  ;

function     : FUNCTION funcname body 	 
	       { 
		code_byte(PUSHFUNCTION);
		code_code($3);
		storesinglevar($2);
	       }
	       ;

funcname	: var { $$ =$1; init_func(); }
		| varexp ':' NAME
	{
	  code_constant($3);
	  $$ = 0;  /* indexed variable */
	  init_func();
	  add_localvar(luaI_createfixedstring("self"));
	}
		;

body :  '(' parlist ')' block END
	{
	  close_func();
          $$ = currState->f;
	  $$->lineDefined = $2;
	  currState = &stateMain;  /* change back to main code */
	}
		;

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

sc	 : /* empty */ | ';' ;

stat   : IF expr1 THEN PrepJump block PrepJump elsepart END
	{ codeIf($4, $6); }

       | WHILE {$<vLong>$=currState->pc;} expr1 DO PrepJump block PrepJump END
       {
         currState->f->code[$5] = IFFJMP;
	 code_word_at($5+1, currState->pc - ($5+sizeof(Word)+1));
         currState->f->code[$7] = UPJMP;
	 code_word_at($7+1, currState->pc - ($<vLong>2));
       }
     
       | REPEAT {$<vLong>$=currState->pc;} block UNTIL expr1 PrepJump
       {
         currState->f->code[$6] = IFFUPJMP;
	 code_word_at($6+1, currState->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 {;}
       | LOCAL localdeclist decinit
	{ currState->nlocalvar += $2;
	  adjust_mult_assign($2, $3, 0);
	}
       ;

elsepart : /* empty */
	 | ELSE block
         | ELSEIF expr1 THEN PrepJump block PrepJump elsepart
	{ codeIf($4, $6); }
         ;
     
block    : {$<vInt>$ = currState->nlocalvar;} statlist ret 
         {
	   if (currState->nlocalvar != $<vInt>1) {
	     for (; currState->nlocalvar > $<vInt>1; currState->nlocalvar--)
	       luaI_unregisterlocalvar(lua_linenumber);
	     lua_codeadjust(0);
	   }
         }
         ;

ret	: /* empty */
        | RETURN exprlist sc
          {
	   adjust_functioncall($2, MULT_RET);
           codereturn();
          }
	;

PrepJump : /* empty */
	 { 
	  $$ = currState->pc;
	  code_byte(0);		/* open space */
	  code_word(0);
         }
	 ;
	   
expr1	 : expr { adjust_functioncall($1, 1); }
	 ;
				
expr :  '(' expr ')'  { $$ = $2; }
     |  expr1 EQ  expr1	{ code_byte(EQOP);   $$ = 0; }
     |	expr1 '<' expr1	{ code_byte(LTOP);   $$ = 0; }
     |	expr1 '>' expr1	{ code_byte(GTOP);   $$ = 0; }
     |	expr1 NE  expr1	{ code_byte(EQOP); code_byte(NOTOP); $$ = 0; }
     |	expr1 LE  expr1	{ code_byte(LEOP);   $$ = 0; }
     |	expr1 GE  expr1	{ code_byte(GEOP);   $$ = 0; }
     |	expr1 '+' expr1 { code_byte(ADDOP);  $$ = 0; }
     |	expr1 '-' expr1 { code_byte(SUBOP);  $$ = 0; }
     |	expr1 '*' expr1 { code_byte(MULTOP); $$ = 0; }
     |	expr1 '/' expr1 { code_byte(DIVOP);  $$ = 0; }
     |	expr1 '^' expr1 { code_byte(POWOP);  $$ = 0; }
     |	expr1 CONC expr1 { code_byte(CONCOP);  $$ = 0; }
     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 0;}
     | table { $$ = 0; }
     |  varexp          { $$ = 0;}
     |  NUMBER          { code_number($1); $$ = 0; }
     |  STRING
     {
       code_string($1);
       $$ = 0;
     }
     |	NIL		{code_byte(PUSHNIL); $$ = 0; }
     |  functioncall    { $$ = $1; }
     |	NOT expr1	{ code_byte(NOTOP);  $$ = 0;}
     |	expr1 AND PrepJump {code_byte(POP); } expr1
     { 
       code_shortcircuit($3, ONFJMP);
       $$ = 0;
     }
     |	expr1 OR PrepJump {code_byte(POP); } expr1	
     { 
       code_shortcircuit($3, ONTJMP);
       $$ = 0;
     }
     ;

table :
     {
      code_byte(CREATEARRAY);
      $<vLong>$ = currState->pc; code_word(0);
     }
      '{' fieldlist '}'
     {
      code_word_at($<vLong>1, $3);
     }
         ;

functioncall : funcvalue funcParams
	{
	  code_byte(CALLFUNC);
	  code_byte($1+$2);
	  $$ = currState->pc;
	  code_byte(0);  /* may be modified by other rules */
	}
	     ;

funcvalue    : varexp { $$ = 0; }
	     | varexp ':' NAME 
	     { 
               code_byte(PUSHSELF); 
	       code_word(luaI_findconstant($3));
               $$ = 1;
	     }
	     ;

funcParams :	'(' exprlist ')'
	{ $$ = adjust_functioncall($2, 1); }
	|	table  { $$ = 1; }
	;

exprlist  :	/* empty */		{ $$ = 0; }
	  |	exprlist1		{ $$ = $1; }
	  ;
		
exprlist1 :  expr	{ if ($1 != 0) $$ = $1; else $$ = -1; }
	  |  exprlist1 ',' { $<vLong>$ = adjust_functioncall($1, 1); } expr 
	{
	  if ($4 == 0) $$ = -($<vLong>3 + 1);  /* -length */
	  else
	  {
	    adjust_functioncall($4, $<vLong>3);
	    $$ = $4;
	  }
	}
	  ;

parlist  :	/* empty */ { $$ = close_parlist(0); }
	  |	parlist1    { $$ = close_parlist($1); }
	  ;
		
parlist1 :	par		  { $$ = $1; }
	  |	parlist1 ',' par
	{
	  if ($1)
            lua_error("invalid parameter list");
          $$ = $3;
	}
	  ;

par : NAME	{ add_localvar($1); $$ = 0; }
    | DOTS	{ $$ = 1; }
    ;
		
fieldlist  : lfieldlist
  	     { flush_list($1/FIELDS_PER_FLUSH, $1%FIELDS_PER_FLUSH); }
	     semicolonpart
	     { $$ = $1+$3; }
	   | ffieldlist1 lastcomma
	     { $$ = $1; flush_record($1%FIELDS_PER_FLUSH); }
	   ;

semicolonpart : /* empty */
	        { $$ = 0; }
	      | ';' ffieldlist
	        { $$ = $2; flush_record($2%FIELDS_PER_FLUSH); }
	      ;

lastcomma  : /* empty */ 
	   | ','
	   ;

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

ffieldlist1 : ffield			{$$=1;}
	   | ffieldlist1 ',' ffield	
		{
		  $$=$1+1;
		  if ($$%FIELDS_PER_FLUSH == 0) flush_record(FIELDS_PER_FLUSH);
		}
	   ; 

ffield      : ffieldkey '=' expr1
           ;

ffieldkey   : '[' expr1 ']'
	    | NAME { code_constant($1); }
	    ;

lfieldlist  : /* empty */ { $$ = 0; }
	    | lfieldlist1 lastcomma { $$ = $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; 
	   add_varbuffer($1);
	   $$ = ($1 == 0) ? 1 : 0;
	  }
	  |	varlist1 ',' var	
	  { 
	   add_varbuffer($3);
	   $$ = ($3 == 0) ? $1 + 1 : $1;
	  }
	  ;
		
var	  :	singlevar { $$ = $1; }
	  |	varexp '[' expr1 ']' 
	  {
	   $$ = 0;		/* indexed variable */
	  }
	  |	varexp '.' NAME
	  {
	    code_constant($3);
	    $$ = 0;		/* indexed variable */
	  }
	  ;
		
singlevar :	NAME
	  {
	   int local = lua_localname($1);
	   if (local == -1)	/* global var */
	    $$ = luaI_findsymbol($1)+1;  /* return positive value */
           else
	    $$ = -(local+1);		/* return negative value */
	  }
	  ;

varexp	: var { lua_pushvar($1); }
	;
	  
localdeclist  : NAME {store_localvar($1, 0); $$ = 1;}
     	  | localdeclist ',' NAME 
	    {
	     store_localvar($3, $1);
	     $$ = $1+1;
	    }
	  ;
		
decinit	  : /* empty */  { $$ = 0; }
	  | '=' exprlist1 { $$ = $2; }
	  ;
	  
%%