/*web2c.yacc amended by RMD. */

%token  array_tok begin_tok case_tok const_tok do_tok downto_tok else_tok
        end_tok file_tok for_tok function_tok goto_tok if_tok label_tok
        of_tok procedure_tok program_tok record_tok repeat_tok then_tok
        to_tok type_tok until_tok var_tok while_tok integer_tok real_tok
        others_tok r_num_tok i_num_tok string_literal_tok single_char_tok
        assign_tok two_dots_tok unknown_tok undef_id_tok var_id_tok
        proc_id_tok fun_id_tok fun_forwd_tok proc_forwd_tok const_id_tok 
        forward_tok extern_tok type_id_tok hhb0_tok hhb1_tok field_id_tok
        define_tok field_tok break_tok write_tok writeln_tok file_id_tok
        with_tok new_tok with_var type_fwd_tok

%nonassoc '=' not_eq_tok '<' '>' less_eq_tok great_eq_tok 
%left '+' '-' or_tok
%right unary_plus_tok unary_minus_tok 
%left '*' '/' div_tok mod_tok and_tok
%right not_tok

%{
#include "w2c.h"

#define symbol(x)       sym_table[x].id
#define MAX_ARGS        50
/* #define YYDEBUG         1 */


static char for_stack[300], control_var[50],
            relation[3], new_string[30] , file_temp[100], file_stat[100], 
            i_o_file[50], i_o_exp[200], i_o_w1[20], i_o_w2[20], i_o_stat[1000], 
            i_o_fmt[100], *the_typ_id = 0, with_varr[300] ;
static int last_type = 0, level, i_o_fun, i_o_typ;
static char *with_v, *ww ;
static char array_bounds[80], array_offset[80];
static int lower_sym, upper_sym, fun_id, proc_num;
boolean doing_statements = FALSE;
static boolean var_formals = FALSE;
static int cur_top_type = 0 ;
static int cur_sub_type = 0 ;
static int lo_var, hi_var; 

extern char conditional[], temp[], *std_header, *vvoid;
extern int tex, mf, strict_for;
extern int yylineno;
extern boolean ansi;
extern FILE *coerce;
extern char coerce_name[];

/* Forward refs */
#ifdef  ANSI
static long labs(long x);
static void compute_array_bounds(void);
static void define_vars(int class);
extern void do_prototype(int fun, int extrn);
extern void gen_function_head(int fun);
static boolean doreturn(char *label);
static void declare_returns( void);
static void return_value(void);
static void do_write(void);
static void send_write(void);
extern int yylex(void);
extern void err_mes(char *s) ;
#else   /* Not ANSI */
static long labs();
static void compute_array_bounds(), define_vars();
extern void do_prototype(), gen_function_head();
static boolean doreturn();
static void declare_returns();
static void return_value () ;
static void do_write();
static void send_write();
#endif  /* Not ANSI */

%}

%start PROGRAM

%%

PROGRAM:                {   level = 0 ; silent() ; }
		    DEFS 
			{   normal() ; }
		    PROGRAM_HEAD
                        {   level++;
			    if ( sprintf( i_o_file, "#include \"%s\"\n", std_header)
				== NULL) perror( "sprintf") ;
                            my_output( i_o_file);
			    *i_o_file = '\0' ;}
		    BLOCK '.'
                        {   new_line();
                            YYACCEPT;}
		;
	    
DEFS:               /* empty */
                |   DEFS DEF
                ;

DEF: 		    define_tok field_tok undef_id_tok ';' 
                        {
                            ii = add_to_table(last_id); 
                            sym_table[ii].typ = field_id_tok;
                        }
		|   define_tok function_tok undef_id_tok
                        {
                            fun_id = add_to_table(last_id); 
			}
		    ':' RESULT_TYPE ';'
 			{  
			    sym_table[fun_id].top_type = cur_top_type ;
                            sym_table[fun_id].sub_type = cur_sub_type  ;
			    sym_table[fun_id].typ = fun_id_tok;
                        }
		|   define_tok const_tok undef_id_tok ';'
                        {
			    ii = add_to_table(last_id); 
			    sym_table[ii].typ = const_id_tok;
			}
		|   define_tok procedure_tok undef_id_tok ';'
                        {
			    ii = add_to_table(last_id); 
			    sym_table[ii].typ = proc_id_tok;
			}
		|   define_tok procedure_tok undef_id_tok '(' ')' ';'
                        {
			    ii = add_to_table(last_id); 
			    sym_table[ii].typ = proc_id_tok;
			}
		|   define_tok type_tok undef_id_tok ';'
                        {
			    ii = add_to_table(last_id); 
			    sym_table[ii].typ = type_id_tok;
			}
		|   type_tok  TYPE_DEF
		|   define_tok var_tok undef_id_tok ';'
                        {
			    ii = add_to_table(last_id); 
			    sym_table[ii].typ = var_id_tok;
			}
		;
	    
PROGRAM_HEAD:       program_tok undef_id_tok ';'
                |   program_tok undef_id_tok '(' FILES ')' ';'
                ;

FILES:              FILE_ID
                |   FILES ',' FILE_ID
                ;

FILE_ID:            NEW_ID
                        {   
                            ii = add_to_table(last_id); 
			    sym_table[ii].typ = file_id_tok;
			    sym_table[ii].top_type = is_file ;
			    sym_table[ii].sub_type = is_char ; 
			    if ( strcmp(last_id, "input") ==0) 
			      { if ( sprintf( file_temp, "*input = stdin; \n") == NULL) perror( "sprintf") ;
				if ( fprintf( coerce, "text input ;\n" ) == EOF) perror( "fprintf") ;
				strcat( file_stat, file_temp) ;
			    }
			    else if ( strcmp(last_id, "output") ==0)
			      { if ( sprintf( file_temp, "*output = stdout; \n") == NULL) perror( "sprintf") ;
				if ( fprintf( coerce, "text output ;\n " ) == EOF) perror( "fprintf") ;
				strcat( file_stat, file_temp) ;
			    }
                        }
		;
	    
NEW_ID:             undef_id_tok
		|   var_id_tok 
		|   field_id_tok
		|   file_id_tok
		|   new_tok
		;
	    
BLOCK:                  {   level++;
                            if (level > 2) {
				my_output("{");
				indent++;
				declare_returns();
			    }
                        }  
		    LABEL_DEC_PART
                    CONST_DEC_PART
                    TYPE_DEC_PART
                    VAR_DEC_PART
                        {   if (level == 2) {
			    printf("\n#include \"%s\"\n", coerce_name); }}
		    P_F_DEC_PART
                        {   if (level == 2) {
			    my_output("void main_body() {");
			    my_output(file_stat) ;
			    indent++; 
			}
                        }  
		    STAT_PART
                        {   if (level > 1) {
			    return_value () ;
			    my_output("}");
			    indent--;
			}
                            level--;
                            new_line();
                        }
		;
	    
LABEL_DEC_PART:     /* empty */
                |   label_tok 
                        {   my_output("/*"); }
                    LABEL_LIST ';'
                        {   my_output("*/"); }
                ;

LABEL_LIST:         LABEL
                |   LABEL_LIST ',' LABEL
                ;

LABEL:              i_num_tok
                        {   my_output(temp); }
                ;

CONST_DEC_PART:     /* empty */
                |   const_tok CONST_DEC_LIST
                        {   new_line(); }
                ;

CONST_DEC_LIST:     CONST_DEC
                |   CONST_DEC_LIST CONST_DEC
                ;

CONST_DEC:              {   my_output("#define ");
                        }
                    undef_id_tok
                        {   ii=add_to_table(last_id);
                            cur_top_type = 0 ;
                            cur_sub_type = 0 ;
                            sym_table[ii].typ = const_id_tok;
                            my_output(last_id);
                            my_output(" ");
                        }
                    '=' CONSTANT ';'
                        {   sym_table[ii].val=last_i_num;
                            sym_table[ii].top_type = cur_top_type ;
                            sym_table[ii].sub_type = cur_sub_type ;
                            cur_top_type = 0 ;
                            cur_sub_type = 0 ;
                            new_line() ;
                        }
                ;

CONSTANT:           i_num_tok
                        {   
                            (void) sscanf(temp, "%ld", &last_i_num);
                            if (labs((long) last_i_num) > 32767)
                              (void) strcat(temp, "L");
                            my_output(temp);
                            cur_top_type = is_int ;
                            cur_sub_type = is_int ;
                            $$ = is_int;
                        }
		|   r_num_tok
                        {   my_output(temp);
                            cur_top_type = is_real ;
                            cur_sub_type = is_real ;
                            $$ = is_real;
                        }
		|   STRING
		|   CHAR_CONST
 		    	{   cur_top_type = is_char ;
			    cur_sub_type = is_char ;}
		|   CONSTANT_ID
		;
	    
STRING:             string_literal_tok
                        {   int i, j; char s[132];
                            j = 1;
                            s[0] = '"';
                            for (i=1; yytext[i-1]!=0; i++) {
				if (yytext[i] == '\\' || yytext[i] == '"')
				  s[j++]='\\';
				else if (yytext[i] == '\'') i++;
				s[j++] = yytext[i];
			    }
                            s[j-1] = '"';
                            s[j] = 0;
                            my_output(s);
                            cur_sub_type = is_char ;
                            cur_top_type = is_string ;
			    $$ = is_string; 
                        }
		;
	    
CHAR_CONST: 	    single_char_tok
                        {   char s[5];
                            s[0]='\'';
                            if (yytext[1] == '\\' || yytext[1] == '\'') {
				s[2] = yytext[1];
				s[1] = '\\';
				s[3] = '\'';
				s[4] = '\0';
			    }
                            else {
				s[1] = yytext[1];
				s[2]='\'';
				s[3]='\0';
			    }
			    /* bodge: Put the actual char into last_i_num*/
                            last_i_num = yytext[1];
			    $$ = is_char ;
                            my_output(s);
                        }
		;
	    
CONSTANT_ID:        const_id_tok
                        {   cur_top_type = sym_table[l_s].top_type ;
                            cur_sub_type = sym_table[l_s].sub_type ;
			    if (cur_top_type == is_int || cur_top_type == is_char)
			      last_i_num = sym_table[l_s].val ;
                            my_output(last_id);
			    $$ = cur_top_type ; 
			}
		;
	    
TYPE_DEC_PART:      /* empty */
                |   type_tok TYPE_DEF_LIST
                ;

TYPE_DEF_LIST:      TYPE_DEF
                |   TYPE_DEF_LIST TYPE_DEF
                ;

TYPE_DEF: 		{   my_output("typedef"); }
		    NEW_TYPE_ID
                        {   cur_top_type = 0 ;
                            cur_sub_type = 0 ;
                            sym_table[ii].typ = type_id_tok;
                            (void) strcpy(safe_string, last_id);
                            last_type = ii;
                        }
		    '=' 
                        {   
                            array_bounds[0] = '\0' ;
                            array_offset[0] = '\0' ;
                        }
		    TYPE ';'
                        {   if (*array_offset) {
			    err_mes( "Cannot typedef arrays with offsets");
			    exit(1);
			}
                            if (last_type) { 
				sym_table[last_type].top_type = cur_top_type ;
				sym_table[last_type].sub_type = cur_sub_type ;
			    }
                            cur_sub_type = 0 ;
                            cur_top_type = 0 ;
                            my_output(safe_string);
                            my_output(array_bounds);
                            semicolon();
                            last_type = 0;
                        }
		;
	    
NEW_TYPE_ID: 	    undef_id_tok 
			{   ii = add_to_table(last_id); }
		|   type_fwd_tok
			{   ii = l_s ;}
		;
	    
TYPE:               SIMPLE_TYPE
			{   the_typ_id = 0;}
		|   TYPE_ID
		|   STRUCTURED_TYPE
			{   the_typ_id = 0;}
		;
	    
SIMPLE_TYPE:        SUBRANGE_TYPE
                        {   if (last_type) 
			      {
				  sym_table[ii].val = lower_bound;
				  sym_table[ii].val_sym = lower_sym;
				  sym_table[ii].upper = upper_bound;
				  sym_table[ii].upper_sym = upper_sym;
				  /* dont set its top_type or sub_type as this is done at TYPE_DEF*/ 
				  ii= -1;
			      }
			      /* The following code says: if the bounds are known at translation time
			       * on an integral type, then we select the smallest type of data which
			       * can represent it in ANSI C.  We only use unsigned types when necessary.
			       */
			      {
				  if (lower_bound>= -128 && upper_bound<=127)
				    my_output("schar");
				  else if (lower_bound >= 0
					   && upper_bound <= 255)
				    my_output("unsigned char");
				  else if (lower_bound >= -32768
					   && upper_bound <= 32767)
				    my_output("short");
				  else if (lower_bound >= 0
					   && upper_bound <= 65535)
				    my_output("unsigned short");
				  else my_output("integer");
			      }
			/* else my_output("integer");*/
			  }
		;
	    
SUBRANGE_TYPE:      SUB_CONSTANT two_dots_tok SUB_CONSTANT
                ;

POSSIBLE_PLUS:      /* empty */
                |   unary_plus_tok
                ;

SUB_CONSTANT:       POSSIBLE_PLUS i_num_tok
                        {   lower_bound = upper_bound;
                            lower_sym = upper_sym;
                            (void) sscanf(temp, "%ld", &upper_bound);
                            upper_sym = -1; /* no sym table entry */
                            cur_top_type = is_int ;
                            cur_sub_type = is_int ;
                        }
		|   const_id_tok
                        {   lower_bound = upper_bound;
                            lower_sym = upper_sym;
                            upper_bound = sym_table[l_s].val;
                            upper_sym = l_s;
                            cur_top_type = sym_table[l_s].top_type  ;
                            cur_sub_type = sym_table[l_s].sub_type  ;
                        }
		|   CHAR_CONST
                        {   lower_bound = upper_bound;
                            lower_sym = upper_sym;
                            upper_bound = last_i_num ;
                            upper_sym = -1; /* no sym table entry */
			    cur_top_type = is_char ;
                            cur_sub_type = is_char ;
                        }
		;
	    
TYPE_ID:            type_id_tok
                        {   
                            if (last_type) {
				sym_table[last_type].upper = sym_table[l_s].upper;
				sym_table[last_type].upper_sym = sym_table[l_s].upper_sym;
				sym_table[last_type].val = sym_table[l_s].val;
				sym_table[last_type].val_sym = sym_table[l_s].val_sym;
			    }
                            cur_top_type = sym_table[l_s].top_type  ;
                            cur_sub_type = sym_table[l_s].sub_type  ;
                            if (strcmp( last_id, "integer") ==0) {
				cur_top_type = is_int ;                          
				cur_sub_type = is_int ;
			    }
                            if (strcmp( last_id, "text") ==0) {
				cur_top_type = is_file ;                          
				cur_sub_type = is_char ;
			    }
                            if (strcmp( last_id, "char") ==0) {
				cur_top_type = is_char ;                          
				cur_sub_type = is_char ;
			    }
                            if (strcmp( last_id, "real") ==0) {
				cur_top_type = is_real ;                          
				cur_sub_type = is_real ;
			    }
                            my_output(last_id); 
			    the_typ_id = sym_table[l_s].id ;
                        }
		;
	    
STRUCTURED_TYPE:    ARRAY_TYPE
                        {   
			    if ( cur_top_type = is_char)
			      cur_top_type = is_string ;  
			    else cur_top_type = is_array ;
			}
		|   RECORD_TYPE
 		    	{  
			    if(!last_type) 
			      err_mes(" warning: Record types are unreliable unless you use type ids");
			    else cur_sub_type = last_type ;
			    cur_top_type = is_record ;}
		|   FILE_TYPE
                        {   cur_top_type = is_file ;}
		|   POINTER_TYPE
   			{   
			    /* The sub-type of a pointer must be the actual
			       identifier, because its type might not yet
			       be defined*/
			    cur_top_type = is_point ;
			    cur_sub_type = l_s  ;
                            my_output(last_id); my_output("*");
			}
		;
	    
POINTER_TYPE:       '^' type_id_tok
		|   '^' type_fwd_tok
		|   '^' undef_id_tok
			{   ii = add_to_table(last_id);
			    l_s = ii ;
			    sym_table[ii].typ = type_fwd_tok ; }
		;
	    
ARRAY_TYPE: 	    array_tok '[' INDEX_TYPE ']' of_tok COMPONENT_TYPE
		|   array_tok '[' INDEX_TYPE ',' INDEX_TYPE ']' of_tok
                    COMPONENT_TYPE
		;
	    
INDEX_TYPE:             SUBRANGE_TYPE
                                { compute_array_bounds(); }
                |       type_id_tok
                                { lower_bound = sym_table[l_s].val;
                                  lower_sym = sym_table[l_s].val_sym;
                                  upper_bound = sym_table[l_s].upper;
                                  upper_sym = sym_table[l_s].upper_sym;
                                  compute_array_bounds();
                                }
                ;

COMPONENT_TYPE:     TYPE
			{   cur_sub_type = cur_top_type ;}
		;

 RECORD_TYPE:        record_tok
                        {   my_output("struct"); my_output("{"); indent++;
			    if(last_type) 
			      sym_table[last_type].val = last_sym_used+1 ;}
		    FIELD_LIST end_tok
                        {   indent--; my_output("}"); semicolon(); 
			    if(last_type) {
				cur_sub_type = last_type ;
				sym_table[last_type].upper = last_sym_used ;}}
		;
	    
FIELD_LIST: 	    FIXED_FIELDS
		;
	    
FIXED_FIELDS: 	    RECORD_SECTION
		|   FIXED_FIELDS ';' RECORD_SECTION
		;
	    
RECORD_SECTION:         {   field_list[0] = 0; lo_var= last_sym_used+1 ;}
		    VAR_ID_DEC_LIST ':'
                        {   
                            array_bounds[0] = '\0' ;
			    array_offset[0] = '\0' ;
                        }
		    TYPE
			{   define_vars (field_id_tok);}
		|   /* empty */
		;
	    
FILE_TYPE:          file_tok of_tok 
                        {   my_output("text /* file of "); }
                    TYPE
                        {   my_output("*/");}
                ;

VAR_DEC_PART:       /* empty */
                |   var_tok VAR_DEC_LIST
                ;

VAR_DEC_LIST:       VAR_DEC
                |   VAR_DEC_LIST VAR_DEC
                ;

VAR_DEC: 
                        {   array_bounds[0] = '\0' ;
                            array_offset[0] = '\0' ;
                            cur_sub_type = 0 ;
                            var_formals = FALSE;
                            lo_var= last_sym_used+1;
                        }
                    VAR_ID_DEC_LIST ':'
                        {   
                            array_bounds[0] = '\0' ;        
                            array_offset[0] = '\0' ;
                        }
                    TYPE ';'
                        {   define_vars( var_id_tok);
                            cur_sub_type = 0 ;
                        }
                ;

VAR_ID_DEC_LIST:    VAR_ID
                |   VAR_ID_DEC_LIST ',' VAR_ID
                ;

VAR_ID:             NEW_ID
                        {   
			    hi_var = add_to_table(last_id);
                        }
		;
	    
P_F_DEC_PART:       /*empty*/
                |   P_F_DEC_PART P_F_DEC
                ;

P_F_DEC:            PROCEDURE_DEC ';'
                        {   new_line(); pop_stack(); }
                |   FUNCTION_DEC ';'
                        {   new_line(); pop_stack(); }
                ;

PROCEDURE_DEC:      PROCEDURE_HEAD
                        {   
			    do_prototype( proc_num, FALSE ); 
                            gen_function_head(proc_num);        
                        }
		    BLOCK
		|   PROCEDURE_HEAD DIRECTIVE
		|   FORWARD_HEAD ';'
    			{   proc_num = l_s ;
			    un_forward( proc_num) ; 
			    gen_function_head( proc_num) ; 
			    push_stack(); 
                            if ( fprintf(stderr, " %s (forward)\n",
					 last_id) == EOF) perror( "fprintf");
			    (void) strcpy(my_routine, last_id);
                            uses_eqtb = uses_mem = FALSE;
                        }
		    BLOCK
		;
	    
DIRECTIVE:          forward_tok 
			{   do_prototype( proc_num, FALSE ); 
			    forward( proc_num) ;}
		|   extern_tok 
			{   do_prototype( proc_num, TRUE ); }
		;

FORWARD_HEAD: 	    procedure_tok proc_forwd_tok
		|   function_tok fun_forwd_tok
		;
	    
	    
PROCEDURE_HEAD:     procedure_tok undef_id_tok
                        {   proc_num = add_to_table (last_id) ;
			    silent() ;
                            push_stack(); 
			    if ( fprintf(stderr, "%3d Procedure %s\n",
					 pf_count++, last_id) == EOF) perror( "fprintf");
                            sym_table[proc_num].typ = proc_id_tok;
                            sym_table[proc_num].arg_typ = NULL ;
			    (void) strcpy(my_routine, last_id);
                            uses_eqtb = uses_mem = FALSE;
			    lo_var= last_sym_used+1;
                        }
		    PARAM ';'
                        {   normal();}
		;
	    
PARAM:              /* empty */
			{   sym_table[proc_num].upper_sym = 0;}
		|   '('
			{   sym_table[proc_num].val_sym = lo_var;
                        }
		    FORM_PAR_SEC_L ')'
			{   sym_table[proc_num].upper_sym = last_sym_used; }
		;
	    
FORM_PAR_SEC_L:     FORM_PAR_SEC
                |   FORM_PAR_SEC_L ';' FORM_PAR_SEC
                ;

FORM_PAR_SEC:           {   var_formals = FALSE ;} 
		    FORM_PAR_SEC1
		|   var_tok 
                        {   var_formals = TRUE ;} 
		    FORM_PAR_SEC1
			{   var_formals = FALSE ;}
		;
	    
FORM_PAR_SEC1:          {   lo_var= last_sym_used+1;}
		    VAR_ID_DEC_LIST ':' TYPE_ID
                        {  
			    define_vars( var_id_tok);
                        }
		;
	    
FUNCTION_DEC:       FUNCTION_HEAD
                        {   
			    if (sym_table[proc_num].var_formal)
			      un_forward( proc_num) ; 
			    else do_prototype( proc_num, FALSE ); 
                            gen_function_head( proc_num);        
                        }
		    BLOCK
		|   FUNCTION_HEAD DIRECTIVE
		;
	    
FUNCTION_HEAD: 	    function_tok undef_id_tok
                        {   proc_num = add_to_table (last_id) ;
			    silent() ;
                            push_stack(); 
                            if ( fprintf(stderr, "%3d Function %s\n",
					 pf_count++, last_id) == EOF) perror( "fprintf");
                            sym_table[proc_num].typ = fun_id_tok;
			    (void) strcpy(my_routine, last_id);
                            uses_eqtb = uses_mem = FALSE;
			    lo_var= last_sym_used+1;
                        }
		    PARAM ':'
                        {   array_bounds[0] = '\0' ;
                            array_offset[0] = '\0' ;
                        }
		    RESULT_TYPE 
                        {   sym_table[proc_num].arg_typ = the_typ_id ;
			    sym_table[proc_num].top_type = cur_top_type ;
                            sym_table[proc_num].sub_type = cur_sub_type  ;
                        }
		    ';'
                        {   normal();}
		;
	    
RESULT_TYPE:        TYPE_ID
                ;

STAT_PART:          begin_tok STAT_LIST end_tok
                ;

COMPOUND_STAT:      begin_tok 
                        {   my_output("{"); indent++; new_line();}
                    STAT_LIST end_tok
                        {   indent--; my_output("}"); new_line(); }
                ;

STAT_LIST:          STATEMENT
                |   STAT_LIST ';' STATEMENT
                ;

STATEMENT:          UNLAB_STAT
                |   S_LABEL ':'
                    UNLAB_STAT
                ;

S_LABEL:            i_num_tok
                        {   if (!doreturn(temp)) {
                                if ( sprintf(safe_string, "lab%s:",
                                               temp) == NULL) perror( "sprintf");
                                my_output(safe_string);
                            }
                        }
                ;

UNLAB_STAT:         SIMPLE_STAT
                        {   semicolon(); }
                |   STRUCT_STAT
                        {   semicolon(); }
                ;

SIMPLE_STAT:        ASSIGN_STAT
		|   PROC_STAT
		|   NEW_STAT
		|   WRITE_STAT
		|   GO_TO_STAT
		|   EMPTY_STAT
		|   break_tok
                        {   my_output("break");}
		;
	    
ASSIGN_STAT:        VARIABLE assign_tok 
                        {   my_output(" = "); }
                    EXPRESS
                |   FUNC_ID_AS assign_tok
                        {   my_output("Result = "); }
                    EXPRESS
                ;

VARIABLE:           VAR_OR_WITH
                        {   cur_top_type = sym_table[l_s].top_type ;
			    cur_sub_type = sym_table[l_s].sub_type ;
			    if (strcmp(last_id, "mem") ==0) 
			      uses_mem = 1 ;
			    else if (strcmp(last_id, "eqtb") ==0)
			      uses_eqtb = 1;
			    my_output(last_id);
			    if (sym_table[l_s].need_var )
			      (void) my_output( "[0]" );
			}
		    VAR_DESIG_LIST
			{   if($3) $$ = $3 ;
			    else $$ = cur_top_type ;}
		|   file_id_tok
		  	{   my_output(last_id);
			    $$ = is_file ;
			}
		;
	    
VAR_OR_WITH: 	    var_id_tok
		;
	    
FUNC_ID_AS:         fun_id_tok
                        {   $$ = ex_32; }
                ;

VAR_DESIG_LIST:     /*empty*/
			{   $$ = 0;}
		|   VAR_DESIG_LIST VAR_DESIG
			{   $$ = $2 ;}
		;
	    
VAR_DESIG: 	    '['
                        {   my_output("[");
			    $$ = cur_sub_type ; 
			    if (cur_top_type != is_array &&
				cur_top_type != is_point &&
				cur_top_type != is_string )
			      err_mes("index on non-array") ; }
		    EXPRESS VAR_DESIG1
                        {   my_output("]"); 
			    $$ = $2; cur_top_type = $2 ;}
		|   '.' field_id_tok
 			{  
			    if (cur_top_type != is_record)
			      err_mes("field on non-record") ; 
			    cur_top_type = sym_table[l_s].top_type ;
			    cur_sub_type = sym_table[l_s].sub_type ;
			    if (tex || mf)
			      {
				  if (strcmp(last_id, "int") ==0)
				    my_output(".cint");
				  else if (strcmp(last_id, "lh") ==0)
				    my_output(".v.LH");
				  else if (strcmp(last_id, "rh") ==0)
				    my_output(".v.RH");
				  else 
				    {if ( sprintf(safe_string, ".%s", last_id) == NULL) perror( "sprintf");
				     my_output(safe_string);
				 }
			      }
			    else {
				if ( sprintf(safe_string, ".%s", last_id) == NULL) perror( "sprintf");
				my_output(safe_string);
			    }
			    $$ = cur_top_type ;
			}
		|   '^'
			{   int ii = cur_sub_type ;
			    if ( cur_top_type != is_point )
			      err_mes(" ^ on non-pointer") ; 
			    else {
				my_output( "[0]") ;
				cur_top_type = sym_table[ii].top_type ;
				cur_sub_type = sym_table[ii].sub_type ; }
			}
		|   '.' 
                    hhb0_tok
                        {   my_output(".hh.b0"); $$ = is_int ;}
		|   '.' 
                    hhb1_tok
                        {   my_output(".hh.b1"); $$ = is_int ;}
		;
	    
VAR_DESIG1:         ']'
                |   ','
                        {   my_output("][");}
                    EXPRESS     ']'
                ;
                
EXPRESS:            UNARY_OP EXPRESS    %prec '*'
                        {   $$ = $2; }
                |   EXPRESS '+' {my_output("+");} EXPRESS
                        {   $$ = max($1, $4);}
                |   EXPRESS '-' {my_output("-");} EXPRESS
                        {   $$ = max($1, $4);}
                |   EXPRESS '*' {my_output("*");} EXPRESS
                        {   $$ = max($1, $4);}
                |   EXPRESS div_tok {my_output("/");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS '=' {my_output("==");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS not_eq_tok {my_output("!=");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS mod_tok {my_output("%");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS '<' {my_output("<");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS '>' {my_output(">");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS less_eq_tok {my_output("<=");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS great_eq_tok {my_output(">=");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS and_tok {my_output("&&");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS or_tok {my_output("||");} EXPRESS
                        {   $$ = is_int;}
                |   EXPRESS '/'
                        {   my_output("/ ((double)"); }
                    EXPRESS
                        {   $$ = is_real; my_output(")"); }
                |   FACTOR
                        {   $$ = $1; }
                ;

UNARY_OP:           unary_plus_tok
                |   unary_minus_tok
                        {   my_output("- (integer)"); }
                |   not_tok
                        {   my_output("!"); }
                ;

FACTOR: 	    '('
                        {   my_output("("); }
		    EXPRESS ')'
                        {   my_output(")"); $$ = $3; }
		|   VARIABLE
		|   CONSTANT
		|   FUN_CALL
                        {   my_output(last_id); 
			    $$ =  sym_table[l_s].top_type  ;
                        }
		    PARAM_LIST
                        {   $$ = $2 ; }
		;

FUN_CALL: 	    fun_id_tok
		|   fun_forwd_tok
		;
	    
PARAM_LIST:         /*empty*/
                        {   my_output("()"); }                          
                |       '('
                        {   my_output("("); }
                    ACTUAL_PARAM_L ')'
                        {   my_output(")"); }
                ;

ACTUAL_PARAM_L:     ACTUAL_PARAM
                |   ACTUAL_PARAM_L ',' 
                        {   my_output(","); }
                    ACTUAL_PARAM
                ;

ACTUAL_PARAM: 	    EXPRESS 
		; 

PROC_STAT:          PROC_NAME
                        {   my_output(last_id); }
		    PARAM_LIST
		;

PROC_NAME: 	    proc_id_tok
		|   proc_forwd_tok
		;
	    
NEW_STAT: 	    new_tok '(' VARIABLE 
			{   int ii = cur_sub_type;
			    char *c = sym_table[ii].id ;
			    if (cur_top_type != is_point)
			      err_mes( "NEW on non-pointer") ;
			    if ( sprintf ( new_string, "= (%s*) xmalloc( sizeof( %s)) ", c, c)
				== NULL) perror( "sprintf");
			    my_output( new_string) ; }
		    ')'
		;
	    

WRITE_STAT: 	    WR_FUN  
 			{   *i_o_stat = '\0'; *i_o_fmt = '\0'; }
		    WR_ARGS
			{   normal() ;
			    send_write();
			}
		;
	    
WR_FUN: 	    write_tok
			{   i_o_fun = write_tok ;}
		|   writeln_tok
			{   i_o_fun = writeln_tok ;}
		;
	    
WR_ARGS:  	    /*empty*/
			{   strcpy( i_o_file, "output" );
			    if (i_o_fun != writeln_tok)
			      err_mes( "You cant WRITE nothing") ;
			}
		|   '(' file_id_tok ')'
			{   strcpy( i_o_file, last_id ) ;
			    if (i_o_fun != writeln_tok)
			      err_mes( "You cant WRITE nothing") ;
			}
		    /* Here we need a production WR_ARGS -> ( DATA ) . (i.e. 
			the file is not named). Unfortunately I dont know how to
			prevent a conflict which YACC resolves the wrong way. If
			it reads 'write(file-name,...' it reduces file-name >>
			variable >> factor >> express >> WR_ITEM  and tries to
			treat the file as something to be written to output*/
		|   '(' file_id_tok ','
			{   strcpy( i_o_file, last_id ) ; }
		    WR_DATA ')'
		;
	    
WR_DATA: 	    WR_ITEM
		|   WR_DATA ',' WR_ITEM
		;

WR_ITEM: 		{   *i_o_w1 = '\0' ;
			    *i_o_w2 = '\0' ;
			    *i_o_exp = '\0' ;
			    to_string (i_o_exp) ;}
		    EXPRESS
			{   i_o_typ =  $2 ;}
		    WIDTH1
			{   do_write () ;}
		;
	    
WIDTH1: 	    /*empty*/
		|   ':' {   to_string (i_o_w1) ;}
		    EXPRESS WIDTH2
		;
	    
WIDTH2: 	    /*empty*/
		|   ':' {   to_string (i_o_w2) ;}
		    EXPRESS
		;
	    
GO_TO_STAT:         goto_tok i_num_tok
                        {   if (doreturn(temp)) {
                            if (strcmp( sym_table[proc_num].arg_typ, "void"))
                              my_output("return(Result)");
                            else
                              my_output("return");
                        } else {
                            if ( sprintf(safe_string, "goto lab%s",
                                           temp) == NULL) perror( "sprintf");
                            my_output(safe_string);
                        }
                        }
                ;

EMPTY_STAT:         /* empty */
                ;

STRUCT_STAT:        COMPOUND_STAT
		|   CONDIT_STAT
		|   REPETIT_STAT
		;

CONDIT_STAT:        IF_STATEMENT
                |   CASE_STATEMENT
                ;

IF_STATEMENT:       BEGIN_IF_STAT
                |   BEGIN_IF_STAT ELSE_STAT
                ;

BEGIN_IF_STAT:      if_tok 
                        {   my_output("if"); my_output("("); }
                    EXPRESS 
                        {   my_output(")"); new_line();}
                    then_tok STATEMENT
                ;

ELSE_STAT:          else_tok
                        {   my_output("else"); }
                    STATEMENT
                ;

CASE_STATEMENT:     case_tok 
                        {   my_output("switch"); my_output("("); }
                    EXPRESS of_tok 
                        {   my_output(")"); new_line();
                            my_output("{"); indent++;
                        }
                    CASE_EL_LIST END_CASE
                        {   indent--; my_output("}"); new_line(); }
                ;

CASE_EL_LIST:       CASE_ELEMENT 
                |   CASE_EL_LIST ';' CASE_ELEMENT
                ;

CASE_ELEMENT:       CASE_LAB_LIST ':' UNLAB_STAT
                        {   my_output("break"); semicolon(); }
                ;

CASE_LAB_LIST:      CASE_LAB
                |   CASE_LAB_LIST ',' CASE_LAB
                ;

CASE_LAB: 	    i_num_tok
                        {   my_output("case"); 
                            my_output(temp);
                            my_output(":"); new_line();
                        }
		|   const_id_tok
                        {   my_output("case"); 
                            my_output(last_id);
                            my_output(":"); new_line();
                        }
		|   others_tok
                        {   my_output("default:"); new_line(); }
		;
	    
END_CASE:           end_tok
                |   ';'  end_tok
                ;

REPETIT_STAT:       WHILE_STATEMENT
                |   REP_STATEMENT
                |   FOR_STATEMENT
                ;

WHILE_STATEMENT:    while_tok 
                        {   my_output("while");
                            my_output("(");
                        }
                    EXPRESS 
                        {   my_output(")"); }
                    do_tok STATEMENT
                ;

REP_STATEMENT:      repeat_tok 
                        {   my_output("do"); my_output("{"); indent++; }
                    STAT_LIST until_tok 
                        {   indent--; my_output("}"); 
                            my_output("while"); my_output("( ! (");
                        }
                    EXPRESS
                        {   my_output(") )"); }
                ;

FOR_STATEMENT:      for_tok 
                        {   
                            my_output("{");
                            my_output("register");
                            my_output("integer");
                            if (strict_for)
                              my_output("for_begin,");
                            my_output("for_end;");
                        }
                    CONTROL_VAR assign_tok 
                        {   if (strict_for)
                              my_output("for_begin");
                        else
                          my_output(control_var);
                              my_output("="); }
                    FOR_LIST do_tok
                        {   my_output("; if (");
                            if (strict_for) my_output("for_begin");
                            else my_output(control_var);
                            my_output(relation);
                            my_output("for_end)");
                            if (strict_for) {
                                my_output("{");
                                my_output(control_var);
                                my_output("=");
                                my_output("for_begin");
                                semicolon();
                            }
                            my_output("do"); 
                            indent++; 
                            new_line();}
                    STATEMENT
                        {   
                            char *top = rindex(for_stack, '#');
                            indent--; new_line();
                            my_output("while"); 
                            my_output("("); 
                            my_output(top+1); 
                            my_output(")"); 
                            my_output(";");
                            my_output("}");
                            if (strict_for)
                              my_output("}");
                            *top=0;
                            new_line();
                        }
                ;

CONTROL_VAR:        var_id_tok
                        {   (void) strcpy(control_var, last_id); }
                ;

FOR_LIST:           EXPRESS 
                        {   my_output(";"); }
                    to_tok 
                        {   
                            (void) strcpy(relation, "<=");
                            my_output("for_end");
                            my_output("="); }
                    EXPRESS
                        {   
                            if ( sprintf(for_stack + strlen(for_stack),
                                           "#%s++ < for_end", control_var) == NULL) perror( "sprintf");
                        }
                |   EXPRESS 
                        {   my_output(";"); }
                    downto_tok 
                        {   
                            (void) strcpy(relation, ">=");
                            my_output("for_end");
                            my_output("="); }
                    EXPRESS
                        {   
                            if ( sprintf(for_stack + strlen(for_stack),
                                           "#%s-- > for_end", control_var) == NULL) perror( "sprintf");
                        }
                ;

%%

static void compute_array_bounds()
{
    long lb;
    char tmp[200];

    if (lower_sym == -1) {      /* lower is a constant */
        lb = lower_bound - 1;
        if (lb==0) lb = -1;     /* Treat lower_bound==1 as if lower_bound==0 */
        if (upper_sym == -1)    /* both constants */
          {if ( sprintf(tmp, "[%ld]", upper_bound - lb) == NULL) perror( "sprintf");}
        else {                  /* upper a symbol, lower constant */
            if (lb < 0)
              {if ( sprintf(tmp, "[%s + %ld]",
			    symbol(upper_sym), (-lb)) == NULL) perror( "sprintf");}
            else
              if ( sprintf(tmp, "[%s - %ld]",
			   symbol(upper_sym), lb) == NULL) perror( "sprintf");
        }
        if (lower_bound < 0 || lower_bound > 1) {
            if (*array_bounds) {
                err_mes( "Cannot handle offset in second dimension\n");
                exit(1);
            }
            if (lower_bound < 0) {
                if ( sprintf(array_offset, "+%ld", -lower_bound) == NULL) perror( "sprintf");
            } else {
                if ( sprintf(array_offset, "-%ld", lower_bound) == NULL) perror( "sprintf");
            }
        }
        (void) strcat(array_bounds, tmp);
    }
    else {                      /* lower is a symbol */
        if (upper_sym != -1)    /* both are symbols */
          { if ( sprintf(tmp, "[%s - %s + 1]", symbol(upper_sym),
			 symbol(lower_sym)) == NULL) perror( "sprintf");}
	else {			/* upper constant, lower symbol */
	    if ( sprintf(tmp, "[%ld - %s]", upper_bound + 1,
			 symbol(lower_sym)) == NULL) perror( "sprintf");
	}
        if (*array_bounds) {
            err_mes( "Cannot handle symbolic offset in second dimension\n");
            exit(1);
        }
        if ( sprintf(array_offset, "- (int)(%s)", symbol(lower_sym)) == NULL) perror( "sprintf");
        (void) strcat(array_bounds, tmp);
    }
}

/*Define a list of variables. These extend from index lo_var to hi_var inclusive
of sym_table. This is called to define ordinary variables; fields in a field
list (class = field_id_tok); a tag in a variant; or formal parameters (var_formals
is true). If the type is a type id, we put its id-pointer into arg_typ; use this
 when we calculate the proc. header.
*/
static void define_vars( class)
int class;
{ int k;
  char output_string[100], real_symbol[100];
  if (!hi_var) return;
  for (k=lo_var; k<=hi_var; k++) {
      strcpy( real_symbol, sym_table[k].id ) ;
      if (cur_top_type == is_file)
	sym_table[k].typ = file_id_tok ;
      else sym_table[k].typ = class ;
      sym_table[k].arg_typ  = the_typ_id ;
      /* If we are defining a formal parameter, need_var will indicate that it
	 must be passed by pointer. 
	 */
      sym_table[k].var_formal = var_formals ;
      sym_table[k].need_var = var_formals &&
	(( cur_top_type == is_record) ||
	 ( cur_top_type == is_int) ||
	 ( cur_top_type == is_char) );
      sym_table[k].top_type = cur_top_type ;
      sym_table[k].sub_type = cur_sub_type ;
      if (*array_offset && class == var_id_tok) {
	  if ( sprintf(output_string, "#define %s (%s %s)\n",
		       real_symbol, next_temp, array_offset) == NULL) perror( "sprintf");
	  my_output(output_string);
	  (void) strcpy(real_symbol, next_temp);
	  find_next_temp();
      }
      if ( sprintf(output_string, "%s%s%s",
		   var_formals?"*":"" ,
		   real_symbol, array_bounds ) == NULL) perror( "sprintf") ;
      my_output(output_string);
      if ( k<hi_var )  my_output( ",");
  }
  semicolon();
  hi_var = 0;
}


/*
 * If we're not processing TeX, we return 0 (false).  Otherwise,
 * return 1 if the label is "10" and we're not in one of four TeX
 * routines where the line labeled "10" isn't the end of the routine.
 * Otherwise, return 0.
 */
static boolean doreturn(label)
char *label;
{
    if (!tex) return(FALSE);
    if (strcmp(label, "10") ==0) return(FALSE);
    if (strcmp(my_routine, "macrocall") ==0)  return(FALSE);
    if (strcmp(my_routine, "hpack") ==0)  return(FALSE);
    if (strcmp(my_routine, "vpackage") ==0)  return(FALSE);
    if (strcmp(my_routine, "trybreak") ==0)  return(FALSE);
    return(TRUE);
}


/* Return the absolute value of a long */
static long labs(x)
long x;
{
    if (x < 0L) return(-x);
    return(x);
}

static void declare_returns()
{
    if (sym_table[proc_num].arg_typ != NULL) {
        my_output("register");
        my_output( sym_table[proc_num].arg_typ);
        my_output("Result;");
    }
    if (tex) {
        if ( sprintf(safe_string, "%s_regmem",
                       my_routine) == NULL) perror( "sprintf");
        my_output(safe_string);
        new_line();
    }
}

static void return_value () 
{
    if (sym_table[proc_num].arg_typ != NULL) {
        my_output("return(Result)");
        semicolon();
    }
}

/* Generate a WRITE statement, I hope! On entry, i_o_file is the file to write,
i_o_exp is the expression and i_o_w1 and i_o_w2 are widths, or 0 if not given.
i_o_typ should be the type of the expression, but this is unreliable.
i_o_stat assembles the args to be written in format i_o_fmt */
static void do_write()
{
    char i_o_c, item[200], fmt[50] ;
    if ( *i_o_w2 && i_o_typ != is_real)
      err_mes( "Cannot print non-reals with two widths\n");
    if (i_o_typ == is_char) i_o_c = 'c' ;
    else if (i_o_typ == is_int) i_o_c = 'd' ;
    else if (i_o_typ == is_real) i_o_c = 'E' ;
    else if ( (i_o_typ ==  is_array && cur_sub_type == is_char ) 
	     || i_o_typ == is_string ) i_o_c = 's' ;
    else err_mes( "Unprintable expression\n");
    if ( *i_o_w2) {
	if ( sprintf( fmt, "%%s%%s%%*.*E" ) == NULL) perror( "sprintf") ;
	strcat( i_o_fmt, fmt);
	if ( sprintf( item, " %s, %s, %s,", i_o_w1, i_o_w2, i_o_exp) == NULL) perror( "sprintf") ; 
	strcat( i_o_stat, item);
    }
    else if ( *i_o_w1)
      {
	  if ( sprintf( fmt, "%%*%c", i_o_c ) == NULL) perror( "sprintf") ;
	  strcat( i_o_fmt, fmt);
	  if ( sprintf( item, " %s, %s,", i_o_w1, i_o_exp) == NULL) perror( "sprintf") ; 
	  strcat( i_o_stat, item);
      }
    else
      {
	  if ( sprintf( fmt, "%%%c", i_o_c ) == NULL) perror( "sprintf") ;
	  strcat( i_o_fmt, fmt);
	  if ( sprintf( item, " %s,", i_o_exp) == NULL) perror( "sprintf") ; 
	  strcat( i_o_stat, item);
      }
}

/* generate the actual write statement. Both i_o_stat and i_o_fmt have unwanted
extra comma at end*/
static void send_write()
{
    int n ; char *c ;
    /*    n= strlen(i_o_fmt) -1;
	  if (n >= 0)
	  c = i_o_fmt + n ;
	  else     c = i_o_fmt ;
	  *c = '\0' ;*/
    if (i_o_fun == writeln_tok) 
      { strcat (i_o_fmt, "%c") ;
	strcat (i_o_stat, " '\\n',") ; }
    n= strlen(i_o_stat) -1;
    if (n >= 0)
      c = i_o_stat + n;
    else   c = i_o_stat ;
    *c = ')' ; c++; *c = '\0' ;
    if ( sprintf(i_o_exp, "fprintf( *%s, \"%s\", ", i_o_file, i_o_fmt) == NULL) perror( "sprintf") ;
    my_output( i_o_exp) ;
    my_output ( i_o_stat);
}