summaryrefslogtreecommitdiff
path: root/dviware/crudetype/version3/w2c.yacc
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/crudetype/version3/w2c.yacc
Initial commit
Diffstat (limited to 'dviware/crudetype/version3/w2c.yacc')
-rw-r--r--dviware/crudetype/version3/w2c.yacc1407
1 files changed, 1407 insertions, 0 deletions
diff --git a/dviware/crudetype/version3/w2c.yacc b/dviware/crudetype/version3/w2c.yacc
new file mode 100644
index 0000000000..c3226d4968
--- /dev/null
+++ b/dviware/crudetype/version3/w2c.yacc
@@ -0,0 +1,1407 @@
+/*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);
+}
+