lua/lua.stx

%{

char *rcs_luastx = "$Id: lua.stx,v 3.3 1994/11/06 15:35:04 roberto Exp roberto $";

#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 LISTING
#define LISTING 0
#endif

#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;

/* 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");
 }
 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);
  }
}

static void init_function (void)
{
 if (code == NULL)	/* first function */
 {
  code = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
  if (code == NULL)
   lua_error("not enough memory");
  maxcode = CODE_BLOCK;
 }
}
	     

%}


%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 FUNCTION
%token <vFloat> NUMBER
%token <pChar>  STRING
%token <pChar>  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


%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();
		pc=0; basepc=code; maxcurr=maxcode; 
		nlocalvar=0;
		$<vWord>$ = lua_findsymbol($2); 
	       }
	       '(' parlist ')' 
	       {
	        if (lua_debug)
		{
	         code_byte(SETFUNCTION); 
                 code_code((Byte *)strdup(lua_file[lua_nfile-1]));
		 code_word($<vWord>3);
		}
	        lua_codeadjust (0);
	       }
               block
               END 	 
	       { 
	        codereturn();
	        s_tag($<vWord>3) = LUA_T_FUNCTION;
	        s_bvalue($<vWord>3) = calloc (pc, sizeof(Byte));
		if (s_bvalue($<vWord>3) == NULL)
		  lua_error("not enough memory");
	        memcpy (s_bvalue($<vWord>3), basepc, pc*sizeof(Byte));
		code = basepc; maxcode=maxcurr;
#if LISTING
                PrintCode(code,code+pc);
#endif
	       }
	       ;

method         : FUNCTION NAME { $<vWord>$ = lua_findsymbol($2); } ':' NAME
	       {
		init_function();
		pc=0; basepc=code; maxcurr=maxcode;
		nlocalvar=0;
	        localvar[nlocalvar]=lua_findsymbol("self"); /* self param. */
	        add_nlocalvar(1);
		$<vWord>$ = lua_findconstant($5);
	       }
	       '(' parlist ')'
	       {
	        if (lua_debug)
		{
	         code_byte(SETFUNCTION); 
                 code_code((Byte *)strdup(lua_file[lua_nfile-1]));
		 code_word($<vWord>6);
		}
	        lua_codeadjust (0);
	       }
	       block
	       END
	       {
		Byte *b;
	        codereturn();
	        b = calloc (pc, sizeof(Byte));
		if (b == NULL)
		  lua_error("not enough memory");
	        memcpy (b, basepc, pc*sizeof(Byte));
		code = basepc; maxcode=maxcurr;
#if LISTING
                PrintCode(code,code+pc);
#endif
	        /* assign function to table field */
	        pc=maincode; basepc=*initcode; maxcurr=maxmain;
	        nlocalvar=0;

		lua_pushvar($<vWord>3+1);
                code_byte(PUSHSTRING);
		code_word($<vWord>6);
                code_byte(PUSHFUNCTION);
                code_code(b);
                code_byte(STOREINDEXED0);

		maincode=pc; *initcode=basepc; maxmain=maxcurr;
	       }
	       ;

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

stat	 : { codedebugline(); } stat1 ;
		
sc	 : /* empty */ | ';' ;

cond	: { codedebugline(); } expr1 ;

stat1  : IF cond 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;} cond 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;
         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 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 ret 
         {
	  if (nlocalvar != $<vInt>1)
	  {
           nlocalvar = $<vInt>1;
	   lua_codeadjust (0);
	  }
         }
         ;

ret	: /* empty */
        | { codedebugline(); }
          RETURN  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	{ $$ = 1; }
     |	'-' expr1 %prec UNARY	{ code_byte(MINUSOP); $$ = 1;}
     | table { $$ = 1; }
     |  varexp          { $$ = 1;}
     |  NUMBER          { code_number($1); $$ = 1; }
     |  STRING
     {
      code_byte(PUSHSTRING);
      code_word(lua_findconstant($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(PUSHSTRING);
	       code_word(lua_findconstant($3));
               code_byte(PUSHSELF); 
               $$ = 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 */
	  |	parlist1
	  ;
		
parlist1 :	NAME		  
		{
		 localvar[nlocalvar]=lua_findsymbol($1); 
		 add_nlocalvar(1);
		}
	  |	parlist1 ',' NAME 
		{
		 localvar[nlocalvar]=lua_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 {$<vWord>$ = lua_findconstant($1);} '=' expr1 
	      { 
	       push_field($<vWord>2);
	      }
           ;

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(lua_findconstant($3));
	   $$ = 0;		/* indexed variable */
	  }
	  ;
		
singlevar :	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 */
	  }
	  ;

varexp	: var { lua_pushvar($1); }
	;
	  
localdeclist  : NAME {localvar[nlocalvar]=lua_findsymbol($1); $$ = 1;}
     	  | localdeclist ',' NAME 
	    {
	     localvar[nlocalvar+$1]=lua_findsymbol($3); 
	     $$ = $1+1;
	    }
	  ;
		
decinit	  : /* empty */  { $$ = 0; }
	  | '=' exprlist1 { $$ = $2; }
	  ;
	  
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);
 }
 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 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);
  }
 }
}

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);
}

int yywrap (void)
{
 return 1;
}


/*
** Parse LUA code.
*/
void lua_parse (Byte **code)
{
 initcode = code;
 *initcode = (Byte *) calloc(CODE_BLOCK, sizeof(Byte));
 maincode = 0; 
 maxmain = CODE_BLOCK;
 if (*initcode == NULL) lua_error("not enough memory");
 if (yyparse ()) lua_error("parse error");
 (*initcode)[maincode++] = RETCODE0;
#if LISTING
{ static void PrintCode (Byte *code, Byte *end);
 PrintCode(*initcode,*initcode+maincode); }
#endif
}


#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: 	 printf ("%d    PUSHSELF\n", (p++)-code); 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 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