diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /dviware/crudetype/version3/w2c.yacc |
Initial commit
Diffstat (limited to 'dviware/crudetype/version3/w2c.yacc')
-rw-r--r-- | dviware/crudetype/version3/w2c.yacc | 1407 |
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); +} + |