/* * Copyright (C) 1999-2003 Rildo Pragana, * Bernard Giroud, David Essex, Jim Noeth. * Copyright (C) 1991,1993 Rildo Pragana. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA */ /* ** Parser for Cobol Compiler ** */ %{ //#define YYDEBUG 1 #define YYMAXDEPTH 1000 #include #include #include #include #if defined(SunOS) va_list __builtin_va_alist; #endif #include #include "htcoboly.h" #include "htcoblib.h" #include "htglobals.h" /* #if 1 */ #if USE_PARSER_TEST_MODE #define UNIMPLEMENTED(xyz) #else #define UNIMPLEMENTED(xyz) yyerror("`%s' is not currently implemented", xyz); #endif // walter int fg=0, bg=0, co=0; //struct lit *init_alphab=NULL, *init_alpha=NULL, *init_num=NULL, *init_numedt=NULL, *init_alphaedt=NULL; // fim walter extern int screen_io_enable,scr_line,scr_column; extern int decimal_comma; extern char currency_symbol; extern int has_linkage; extern int module_flag; extern int nested_flag; extern FILE *lexin; extern FILE *o_src; extern struct sym *screen_status_field; /* pointer to the screen status */ extern struct sym *cursor_field; /* pointer to the cursor field */ extern struct sym *curr_paragr,*curr_section; extern struct sym *curr_field; extern short curr_call_mode; extern short curr_call_convention; extern struct sym *pgm_id; extern unsigned stack_offset; /* offset das variaveis na pilha */ extern unsigned global_offset; /* offset das variaveis globais (DATA) */ extern int paragr_num; extern int loc_label; extern char picture[]; extern int picix,piccnt,decimals,sign,v_flag,n_flag,pscale; extern int at_linkage,stack_plus; extern char *toktext; extern int yylex(void); extern struct index_to_table_list *index2table; extern int pgm_segment; extern int initial_flag; extern struct lit *spe_lit_ZE; extern struct lit *spe_lit_SP; extern struct lit *spe_lit_LV; extern struct lit *spe_lit_HV; extern struct lit *spe_lit_QU; struct sym *curr_file; struct sym *alloc_filler( void ); int curr_division=0; int need_subscripts=0; static int is_var=0; extern char *yytext; extern int envdiv_bypass_save_sw; extern int stabs_on_sw; extern int HTG_prg_uses_fileio; extern int HTG_prg_uses_term; /* extern int HTG_prg_uses_dcall; */ unsigned long lbend, lbstart; unsigned int perform_after_sw; int write_advancing_sw; int decl_lbl; /* struct math_var *vl1, *vl2; */ struct math_ose *tmose=NULL; struct ginfo *gic=NULL; static void assert_numeric_sy (struct sym *sy); static void assert_numeric_dest_sy (struct sym *sy); static char err_msg_bad_form[] = "ill-formed %s statement"; %} %union { struct sym *sval; /* symbol */ int ival; /* int */ struct coord_pair pval; /* lin,col */ struct lit *lval; /* literal */ unsigned long dval; /* label definition, compacted */ struct ddval { /* dual label definition */ int lb1,lb2; } ddval; char *str; struct vref *rval; /* variable reference (with subscripts) */ struct refmod *rmval; /* variable with RefMod specifier */ struct string_from *sfval; /* variable list in string statement */ struct unstring_delimited *udval; struct unstring_destinations *udstval; struct tallying_list *tlval; struct tallying_for_list *tfval; struct replacing_list *repval; struct replacing_by_list *rbval; struct converting_struct *cvval; struct inspect_before_after *baval; struct scr_info *sival; struct perf_info *pfval; struct perform_info *pfvals; struct sortfile_node *snval; struct selsubject *ssbjval; struct math_var *mval; /* math variables container list */ struct math_ose *mose; /* math ON SIZE ERROR variables container */ struct ginfo *gic; /* generic container */ struct invalid_keys *iks; /* [NOT] INVALID KEY */ struct invalid_key_element *ike; /* [NOT] INVALID KEY */ struct condition condval; struct list *lstval; /* generic container list */ struct gvar_list *glistval; /* generic variable list */ } %nonassoc LOW_PREC %token IDSTRING %token STRING VARIABLE VARCOND SUBSCVAR %token LABELSTR CMD_LINE ENVIRONMENT_VARIABLE INKEY ESCKEY %token CHAR MULTIPLIER %token USAGENUM ZERONUM CONDITIONAL %token TO IS ARE THRU THAN NO %token COMMENTING DIRECTION READ WRITE INPUT_OUTPUT RELEASE %token NLITERAL CLITERAL %token PORTNUM DATE_TIME %left '+' '-' %left '*' '/' %left POW_OP %left OR %left AND %right NOT %token ACCEPT ACCESS ADD ADDRESS ADVANCING AFTER ALL ALPHABET %token ALPHABETIC ALPHABETIC_LOWER ALPHABETIC_UPPER ALPHANUMERIC %token ALPHANUMERIC_EDITED ALSO ALTERNATE ANY AREA AREAS ASSIGN %token AT AUTHOR AUTO %token BACKGROUNDCOLOR BEFORE BELL BLANK BLINK BLOCK BOTTOM BY %token CALL CALL_CONV_C CALL_CONV_STDCALL CALL_LOADLIB CANCEL CENTER CF CH %token CHAIN CHAINING CHARACTER CHARACTERS CLASS CLOSE %token CODE CODE_SET COLLATING COLOR COLUMN COLUMNS COMMA COMMON COMPUTE CONFIGURATION %token CONSOLE CONTAINS CONTENT CONTINUE CONTROL CONTROLS CONVERTING %token CORRESPONDING COUNT CURRENCY CURSOR %token DATA DATE_COMPILED DATE_WRITTEN DE DEBUGGING DECIMAL_POINT %token DECLARATIVES DELETE DELIMITED DELIMITER DEPENDING DETAIL DISPLAY %token DISPLAY_SCREEN DIVIDE DIVISION DOWN DUPLICATES DYNAMIC %token ELSE END END_ACCEPT END_ADD END_CALL END_CALL_LOADLIB END_CHAIN END_COMPUTE END_DELETE %token END_DISPLAY END_DIVIDE END_EVALUATE END_IF END_MULTIPLY END_OF_PAGE %token END_PERFORM END_READ END_RETURN END_REWRITE END_SEARCH END_START %token END_STRINGCMD END_SUBTRACT END_UNSTRING END_WRITE ENVIRONMENT %token EOL EOS ERASE ERROR_TOK EVALUATE EXCEPTION EXIT EXTEND %token EXTERNAL %token FALSE_TOK FD FILE_CONTROL FILE_ID FILE_TOK FILLER FINAL FIRST %token FOOTING FOR FOREGROUNDCOLOR FROM FULL FUNCTION %token GENERATE GIVING GLOBAL GO GOBACK GROUP %token HEADING HIGHLIGHT HIGHVALUES %token IDENTIFICATION IF IGNORE IN INDEXED INDICATE INITIALIZE INITIAL_TOK %token INITIATE INPUT INSPECT INSTALLATION INTO INVALID I_O I_O_CONTROL %token JUSTIFIED %token KEY %token LABEL LAST LEADING LEFT LENGTH LIMIT LIMITS LINAGE LINE LINES LINKAGE LISTSEP %token LOCK LOWER LOWLIGHT LOWVALUES LPAR %token MERGE MINUS MODE MOVE MULTIPLE MULTIPLY %token NATIVE NEGATIVE NEXT NOECHO NOT NOTEXCEP NULL_TOK NUMBER NUMBERS %token NUMERIC NUMERIC_EDITED %token OBJECT_COMPUTER OCCURS OF OFF OMITTED ON ONLY OPEN OPTIONAL ORDER %token ORGANIZATION OTHER OUTPUT OVERFLOW_TOK %token PADDING PAGE PAGE_COUNTER PARAGRAPH PERFORM PF PH PICTURE PLUS POINTER POSITION %token POSITIVE PREVIOUS PROCEDURE PROCEED PROGRAM PROGRAM_ID %token QUOTES %token RANDOM RD READY RECORD RECORDS REDEFINES REEL REFERENCE RELATIVE %token REMAINDER REMOVAL RENAMES REPLACING REPORT REPORTS REQUIRED RESERVE RESET %token RETURN RETURNING REVERSEVIDEO REWIND REWRITE RF RH RIGHT ROUNDED RUN %token SAME SCREEN SD SEARCH SECTION SECURE SECURITY SELECT SENTENCE SEPARATE %token SEQUENCE SEQUENTIAL SET SIGN SIZE SORT SORT_MERGE SOURCE SOURCE_COMPUTER %token SPACES SPECIAL_NAMES STANDARD STANDARD_1 STANDARD_2 START STATUS %token STD_ERROR STD_OUTPUT STOP STRINGCMD SUBTRACT SUM SYNCHRONIZED %token TALLYING TAPE TCOBPROTO1 TCOBPROTO2 TERMINATE TEST THEN TIMES TOKDUMMY %token TOP TRACE TRAILING TRUE_TOK TYPE %token UNDERLINE UNIT UNLOCK UNSTRING UNTIL UP UPDATE UPON UPPER USAGE USE USING %token VALUE VALUES VARYING %token WHEN WITH WORKING_STORAGE %token ZERO %right OF %nonassoc PERIOD_TOK %type sync_options %type organization_options access_options open_mode %type integer cond_op conditional before_after %type IF ELSE usage read_next_opt %type multiplier_opt using_options using_parameters %type if_part %type anystring name name_var gname gname_opt def_name_opt def_name procedure_section %type field_description label filename data_name noallname paragraph assign_clause %type literal gliteral without_all_literal all_literal special_literal %type nliteral %type perform_thru_opt write_options %type read_into_opt write_from_opt release_from_opt %type variable perform_range perform_options name_or_lit delimited_by %type string_with_pointer %type switches_details %type all_opt with_duplicates with_test_opt optional_opt %type subscript subscripts %type string_from_list string_from %type unstring_count_opt unstring_delim_opt unstring_tallying %type unstring_delimited_vars unstring_delimited %type unstring_destinations unstring_dest_var %type inspect_before_after %type tallying_list tallying_clause %type tallying_for_list %type replacing_kind plus_minus_opt %type replacing_list replacing_clause %type replacing_by_list %type converting_clause %type var_or_nliteral read_key_opt %type screen_clauses %type /*screen_attribs */screen_attrib sign_clause separate_opt screen_attribx %type report_clause_column_is report_clause_column_orientation %type variable_indexed search_varying_opt key_is_opt %type search search_all search_when search_when_list search_at_end %type parm_type sign_condition class_condition %type intrinsic_parm_list intrinsic_parm %type parm_list parameter expr expr_opt %type cond_name thru_gname_opt %type perform_after %type perform_after_opt %type ext_cond extended_cond_op %type returning_options %type sort_file_list sort_input sort_output merge_using %type not_opt selection_subject selection_object when_case %type selection_subject_set %type screen_to_name %type signed_nliteral %type sentence_or_nothing when_case_list %type rounded_opt %type var_list_name var_list_gname %type on_size_error_opt on_size_error %type address_of_opt display_upon display_line_options %type set_variable set_variable_or_nlit set_target add_to_opt %type name_list string_list %type condition implied_op_condition %type qualified_var unqualified_var /*%type end_program_opt program_sequence nested_program*/ %type program_sequences program_sequence %type from_rec_varying to_rec_varying %type depend_rec_varying %type file_description redefines_var %type on_exception_or_overflow on_not_exception %type on_end read_at_end_opt %type read_invalid_key_opt %type read_invalid_key read_not_invalid_key %type invalid_key_opt %type invalid_key_sentence not_invalid_key_sentence %type start_body %type accept_display_options accept_display_option %type with_lock_opt close_options_opt %type goto_label_list goto_label %type gname_list name_var_list use_phrase_option %type sort_keys sort_key sort_keys_names sort_keys_idx sort_key_idx sort_keys_names_idx %% /************ Parser for Cobol Source **************/ /* COMPILATION UNIT STRUCTURE */ root_: program_sequences { gen_main_rtn(); } ; program_sequences: program { pgm_segment++; $$=1; } | program_sequence { $$=1 ; } | program_sequence program { $$=1 ; } /* program_sequence program_sequence end_program_opt { pgm_segment++; if (!($1|$3)) yyerror("END PROGRAM expected"); $$=$3; } | program_sequence program_sequence { pgm_segment++; if ($1) yyerror("too many END PROGRAM"); $$=1; } */ ; program_sequence: program end_program { pgm_segment++ ; $$ = 1; } | program { pgm_segment++ ; nested_flag = 1; } program_sequence end_program { $$ = 1; } | program_sequence program end_program {pgm_segment++ ; nested_flag = 1; $$ = 1; } /* | program_sequence program { yyerror("aaaaaaa"); $$ = 1; } | program program_sequence { yyerror("aaaaaaaaaa") ; $$ = 1; } */ ; /*end_program_opt: * nothing * { $$=0; } | end_program { $$=1; } ;*/ end_program: END PROGRAM { clear_symtab(); clear_offsets(); curr_division= CDIV_IDENT; } IDSTRING { curr_division = CDIV_COMMENT; } ; /* * MAIN PROGRAM STRUCTURE */ program: identification_division environment_division_opt data_division_opt procedure_division_opt ; /* * IDENTIFICATION DIVISION */ identification_division: IDENTIFICATION DIVISION PERIOD_TOK PROGRAM_ID PERIOD_TOK { curr_division = CDIV_IDENT; } IDSTRING { curr_division = CINITIAL; if (pgm_header($7) != 0) { yyerror("Invalid character(s) in PROGRAM-ID name"); /* YYABORT; */ } } programid_opts_opt PERIOD_TOK { define_special_fields(); } identification_division_options_opt ; programid_opts_opt: /*nothing */ | is_opt INITIAL_TOK programid_program_opt { initial_flag=1; } | is_opt COMMON programid_program_opt { UNIMPLEMENTED("PROGRAM-ID ... COMMON clause") } ; programid_program_opt: | PROGRAM { } ; identification_division_options_opt: /*nothing */ | identification_division_options_opt identification_division_option ; identification_division_option: AUTHOR PERIOD_TOK { curr_division = CDIV_COMMENT1; } | DATE_WRITTEN PERIOD_TOK { curr_division = CDIV_COMMENT1; } | DATE_COMPILED PERIOD_TOK { curr_division = CDIV_COMMENT1; } | INSTALLATION PERIOD_TOK { curr_division = CDIV_COMMENT1; } | SECURITY PERIOD_TOK { curr_division = CDIV_COMMENT1; } ; /* * ENVIRONMENT DIVISION */ environment_division_opt: ENVIRONMENT DIVISION PERIOD_TOK { curr_division = CDIV_ENVIR; } configuration_opt input_output_opt { curr_division = CINITIAL; } | /*nothing */ ; /* * CONFIGURATION SECTION */ configuration_opt: CONFIGURATION SECTION PERIOD_TOK configuration_section | /*nothing */ ; configuration_section: configuration_section configuration_option { } | /* nothing */ { } ; configuration_option: SOURCE_COMPUTER PERIOD_TOK { envdiv_bypass_save_sw=1; } STRING debug_mode_opt PERIOD_TOK { envdiv_bypass_save_sw=0; } | OBJECT_COMPUTER PERIOD_TOK { envdiv_bypass_save_sw=1; } STRING program_collating_opt PERIOD_TOK { envdiv_bypass_save_sw=0; } | SPECIAL_NAMES PERIOD_TOK special_names_opt | error { yyerror("invalid format in CONFIGURATION SECTION"); } ; program_collating_opt: PROGRAM collating_sequence | /* nothing */ ; collating_sequence: collating_opt SEQUENCE is_opt STRING ; collating_opt: COLLATING { } | /* nothing */ { } ; debug_mode_opt: with_opt DEBUGGING MODE { stabs_on_sw = 1; } | /* nothing */ { } ; special_names_opt: /* nothing */ | special_names PERIOD_TOK | error { yyerror("invalid format in SPECIAL-NAMES clause");} ; special_names: special_name | special_names special_name ; special_name: /*special_name_opt*/ /*symbolic_characters_opt*/ switches_details_list | alphabet_details /* parsed but unimplemented */ | currency_details | decimal_point_details | screen_status_details | cursor_details | special_name_class /* | error { yyerror("invalid format in SPECIAL-NAMES clause");} */ /* | DATA DIVISION { yyerror("missing period in SPECIAL-NAMES clause");} */ ; currency_details: CURRENCY sign_opt is_opt CLITERAL { currency_symbol = $4->name[0]; } ; sign_opt: SIGN | /* nothing */ ; special_name_class: CLASS STRING is_opt special_name_class_item_list {} ; special_name_class_item_list: special_name_class_item {} | special_name_class_item_list special_name_class_item {} ; special_name_class_item: CLITERAL {} | CLITERAL THRU CLITERAL {} ; decimal_point_details: DECIMAL_POINT is_opt COMMA { decimal_comma=1; } ; screen_status_details: DISPLAY_SCREEN STATUS is_opt STRING { screen_status_field=$4; } ; cursor_details: CURSOR is_opt STRING { cursor_field=$3; } ; switches_details_list: | switches_details_list switches_details ; switches_details: STRING is_opt STRING {if ($1->name[0] != 'S' || $1->name[1] != 'W') yyerror("Invalid switch name"); define_switch_field($3, $1);} switch_on_opt switch_off_opt { close_fields();} ; switch_on_opt: ON status_opt is_opt STRING {save_switch_value($4, 1);} | /* nothing */ ; switch_off_opt: OFF status_opt is_opt STRING {save_switch_value($4, 0);} | /* nothing */ ; status_opt: STATUS | /* nothing */ ; alphabet_details: ALPHABET STRING is_opt alphabet_type { $2->defined=1; UNIMPLEMENTED("Alphabet clause") } ; alphabet_type: NATIVE { } | STANDARD_1 { } | STANDARD_2 { } | alphabet_literal_list { } ; alphabet_literal_list: alphabet_literal_item | alphabet_literal_list alphabet_literal_item ; alphabet_literal_item: without_all_literal { } | without_all_literal THRU without_all_literal { } | without_all_literal alphabet_also_list { } ; alphabet_also_list: ALSO without_all_literal | alphabet_also_list ALSO without_all_literal ; /* * INPUT OUTPUT SECTION */ input_output_opt: INPUT_OUTPUT SECTION PERIOD_TOK input_output_section { } | /*nothing */ ; input_output_section: file_control_paragraph i_o_control_paragraph { } | error { yyerror("INPUT-OUTPUT SECTION format wrong"); } ; file_control_paragraph: FILE_CONTROL PERIOD_TOK file_control { } ; i_o_control_paragraph: /* nothing */ | I_O_CONTROL PERIOD_TOK i_o_control_opt { } ; /* * FILE CONTROL ENTRY */ file_control: file_select | file_control file_select ; file_select: SELECT optional_opt def_name { $3->type='F'; /* mark as file variable */ curr_file=$3; $3->pic=0; /* suppose not indexed yet */ $3->defined=1; $3->parent=NULL; /* assume no STATUS yet this is "file status" var in files */ $3->organization = 2; $3->access_mode = 1; $3->times=-1; $3->alternate=NULL; /* reset alternate key list */ $3->flags.optional=$2; /* according to keyword */ $3->refmod_redef.declarative=NULL; /* no declarative yet */ } select_clauses PERIOD_TOK { if ((curr_file->organization==ORG_INDEXED) && !(curr_file->ix_desc)) { yyerror("indexed file must have a record key"); YYABORT; } } ; select_clauses: select_clauses select_clause | /* nothing */ ; select_clause: organization_opt is_opt organization_options { curr_file->organization=$3; } | ASSIGN to_opt assign_clause { curr_file->filenamevar=$3;} | ACCESS mode_opt is_opt access_options { /*{ curr_file->access_mode=$4; }*/ if (curr_file->access_mode < 5) { curr_file->access_mode=$4; } else { curr_file->access_mode = $4 + 5; } } | file_opt STATUS is_opt STRING { curr_file->parent=$4; } | RECORD key_opt is_opt STRING { curr_file->ix_desc=$4; } | RELATIVE key_opt is_opt STRING { curr_file->ix_desc=$4; } | ALTERNATE RECORD key_opt is_opt STRING with_duplicates { add_alternate_key($5,$6); } | RESERVE NLITERAL areas_opt | error { yyerror("invalid clause in select"); } ; file_opt: FILE_TOK | /* nothing */ ; organization_opt: ORGANIZATION { } | /* nothing */ ; assign_clause: PORTNUM { $$=NULL; } | filename { $$=$1; } | PORTNUM filename { $$=$2; } | EXTERNAL filename { curr_file->access_mode = curr_file->access_mode + 5; $$=$2; } | error { yyerror("Invalid ASSIGN clause in SELECT statement"); } ; with_duplicates: with_opt DUPLICATES { $$=1; } | /* nothing */ { $$=0; } ; optional_opt: OPTIONAL { $$=1; } | /* nothing */ { $$=0; } ; areas_opt: AREA | AREAS | /* nothing */ ; is_opt: IS { } | /* nothing */ ; are_opt: ARE { } | /* nothing */ ; mode_opt: MODE | /* nothing */ ; organization_options: INDEXED { $$=1; } | SEQUENTIAL { $$=2; } | RELATIVE { $$=3; } | LINE SEQUENTIAL { $$=4; } | anystring { yyerror("invalid option, %s",$1->name); } ; access_options: SEQUENTIAL { $$=1; } | DYNAMIC { $$=2; } | RANDOM { $$=3; } | anystring { yyerror("invalid access option, %s", $1->name); } ; /* I-O CONTROL paragraph */ i_o_control_opt: /* nothing */ | i_o_control_list PERIOD_TOK { UNIMPLEMENTED("I-O-CONTROL paragraph") } ; i_o_control_list: i_o_control_clause | i_o_control_list i_o_control_clause ; i_o_control_clause: i_o_control_same_clause | i_o_control_multiple_file_tape_clause ; i_o_control_same_clause: SAME same_clause_options are_opta for_opt string_list ; same_clause_options: /* nothing */ | RECORD { } | SORT { } | SORT_MERGE { } ; i_o_control_multiple_file_tape_clause: MULTIPLE FILE_TOK tape_opt contains_opt i_o_control_multiple_file_list ; i_o_control_multiple_file_list: i_o_control_multiple_file | i_o_control_multiple_file_list i_o_control_multiple_file ; i_o_control_multiple_file: STRING i_o_control_multiple_file_position_opt { } ; i_o_control_multiple_file_position_opt: | POSITION integer { } ; tape_opt: TAPE | /* nothing */ ; are_opta: AREA | /* nothing */ ; for_opt: FOR | /* nothing */ ; string_list: STRING { $$ = $1; } | string_list STRING { $$ = $2; } | error { yyerror("string expected"); } ; name_list: variable { $$ = (struct sym *)chain_var($1); } | name_list variable { $$ = (struct sym *)chain_var($2); } | error { yyerror("variable expected"); } ; /* end enviroment division */ /* * DATA DIVISION */ data_division_opt: DATA DIVISION PERIOD_TOK { curr_division = CDIV_DATA; } file_section_opt working_storage_opt linkage_section_opt report_section_opt screen_section_opt { curr_division = CINITIAL; } | /* nothing */ ; /* * FILE SECTION */ file_section_opt: FILE_TOK SECTION PERIOD_TOK { curr_field=NULL; } file_section { close_fields(); } | /* nothing */ ; /* * WORKING STORAGE SECTION */ working_storage_opt: WORKING_STORAGE SECTION PERIOD_TOK { curr_field=NULL; } working_storage_section { close_fields(); } | /* nothing */ ; /* * LINKAGE SECTION */ linkage_section_opt: LINKAGE SECTION PERIOD_TOK { at_linkage=1; curr_field=NULL; has_linkage++; } linkage_section { close_fields(); at_linkage=0; } | /* nothing */ ; /* * COMMUNICATION SECTION */ /* Not Implemented */ /* * REPORT SECTION */ /* Work in progress - not finished */ report_section_opt: REPORT SECTION PERIOD_TOK report_sections { } | /* nothing */ ; report_sections: report_sections report_section | /* nothing */ ; report_section: RD { /*curr_division = CDIV_FD;*/ } STRING { $3->type='W'; $3->picstr = 0; $3->parent = 0; $3->clone = 0; $3->times = -1; curr_division = CDIV_PROC; UNIMPLEMENTED("Report Section") } report_controls PERIOD_TOK { curr_division = CDIV_DATA; } report_description { /* update_report_field($4); */ /* define_field(1,$4); */ } ; report_controls: /* nothing */ | report_controls report_control ; report_control: is_opt GLOBAL { } | CODE gliteral { } | report_controls_control { } | report_controls_page { } ; report_controls_control: control_is_are final_opt report_break_list ; report_controls_page: PAGE limit_is_are_opt integer line_lines_opt heading_opt first_detail_opt last_detail_opt footing_opt ; heading_opt: /* nothing */ | HEADING is_opt integer ; line_lines_opt: lines_opt | LINE ; lines_opt: /* nothing */ | LINES ; control_is_are: CONTROL is_opt | CONTROLS are_opt ; limit_is_are_opt: /* nothing */ | LIMIT IS | LIMITS ARE ; footing_opt: /* nothing */ | FOOTING is_opt integer ; last_detail_opt: /* nothing */ | LAST DETAIL is_opt integer ; first_detail_opt: /* nothing */ | FIRST DETAIL is_opt integer ; final_opt: /* nothing */ | FINAL ; report_break_list: /* nothing */ | report_break_list name { $2->defined=1; } ; report_description: report_item | report_description report_item ; report_item: integer def_name_opt { if ($2 == NULL) { $2 = alloc_filler(); picix=piccnt=v_flag=n_flag=decimals=pscale=0; picture[picix]=0; } define_field($1,$2); curr_division = CDIV_DATA; } report_clauses PERIOD_TOK { update_report_field($2); curr_division = CDIV_DATA; } ; report_clauses: report_clause | report_clauses report_clause ; report_clause: report_clause_line { } | report_clause_next_group { } | report_clause_type { } | report_clause_usage_display { } | report_clause_picture { } | report_clause_sign_is { } | report_clause_justified { } | report_clause_blank_zero { } | report_clause_column { } | report_clause_svs { } | report_clause_group_indicate { } ; report_clause_type: TYPE is_opt report_clause_type2 { } ; report_clause_type2: REPORT HEADING { } | PAGE HEADING { } | CONTROL HEADING { curr_division = CDIV_PROC; } name_final_opt { curr_division = CDIV_DATA; } | DETAIL { } | CONTROL FOOTING { curr_division = CDIV_PROC; } name_final_opt { curr_division = CDIV_DATA; } | PAGE FOOTING { } | REPORT FOOTING { } | RH { } | PH { } | CH { curr_division = CDIV_PROC; } name_final_opt { curr_division = CDIV_DATA; } | DE { } | CF { curr_division = CDIV_PROC; } name_final_opt { curr_division = CDIV_DATA; } | PF { } | RF { } ; report_clause_sign_is: SIGN is_opt leading_trailing SEPARATE character_opt { } | leading_trailing SEPARATE character_opt { } ; report_clause_picture: PICTURE { curr_division = CDIV_PIC; } is_opt picture { curr_division = CDIV_DATA; } ; report_clause_usage_display: USAGE is_opt DISPLAY { } | DISPLAY { } ; report_clause_justified: JUSTIFIED right_opt ; report_clause_next_group: NEXT GROUP is_opt integer_on_next_page ; report_clause_line: report_clause_line_is integer ON NEXT PAGE { } | report_clause_line_is integer NEXT PAGE { } | report_clause_line_is integer { } | report_clause_line_is PLUS integer { } ; report_clause_line_is: LINE is_are_opt | LINE NUMBER is_opt | LINE NUMBERS are_opt | LINES are_opt ; report_clause_column: report_clause_column_is integer { } ; report_clause_column_is: COLUMN report_clause_column_orientation is_are_opt { $$=$2; } | COLUMN NUMBER report_clause_column_orientation is_opt { $$=$3; } | COLUMN NUMBERS report_clause_column_orientation are_opt { $$=$3; } | COLUMNS report_clause_column_orientation are_opt { $$=$2; } ; report_clause_column_orientation: /* nothing */ { $$=0; } | LEFT { $$=0; } | CENTER { $$=1; } | RIGHT { $$=2; } ; is_are_opt: /* nothing */ | IS { } | ARE { } ; report_clause_svs: SOURCE { curr_division = CDIV_PROC; } is_opt gname_page_counter { curr_division = CDIV_DATA; } | VALUE is_opt literal { } | SUM { curr_division = CDIV_PROC; } gname_list { curr_division = CDIV_DATA; } upon_opt reset_opt { } ; gname_page_counter: gname { } | PAGE_COUNTER { } ; report_clause_group_indicate: | GROUP indicate_opt { } ; report_clause_blank_zero: BLANK when_opt ZERO { } ; indicate_opt: | INDICATE { } ; upon_opt: | UPON gname_list { } ; reset_opt: | RESET gname { } | RESET FINAL { } ; number_opt: | NUMBER { } ; leading_trailing: LEADING { } | TRAILING { } ; right_opt: | RIGHT { } ; name_final_opt: gname { } | FINAL { } ; integer_on_next_page: integer { } | PLUS integer { } | NEXT PAGE { } ; of_opt: OF | /* nothing */ ; /* end report section */ /* * SCREEN SECTION */ screen_section_opt: SCREEN SECTION PERIOD_TOK { screen_io_enable++; curr_field=NULL; HTG_prg_uses_term = 1; } screen_section { close_fields(); } | /* nothing */ ; /* * SCREEN SECTION DESCRIPTION ENTRY */ screen_section: screen_section screen_item | /* nothing */ ; screen_item: integer def_name_opt { if ($2 == NULL) { $2 = alloc_filler(); } picix=piccnt=v_flag=n_flag=decimals=pscale=0; picture[picix]=0; define_field($1,$2); } screen_clauses PERIOD_TOK { update_screen_field($2,$4); } ; screen_clauses: screen_clauses LINE { curr_division = CDIV_PROC; } number_is_opt plus_minus_opt name_or_lit { curr_division = CDIV_DATA; scr_set_line($1,$6,$5); $$=$1; } | screen_clauses COLUMN { curr_division = CDIV_PROC; } number_is_opt plus_minus_opt name_or_lit { curr_division = CDIV_DATA; scr_set_column($1,$6,$5); $$=$1; } | screen_clauses with_opt screen_attrib { $1->attr |= $3; $$=$1; } | screen_clauses with_opt FOREGROUNDCOLOR { curr_division = CDIV_PROC; } name_or_lit { curr_division = CDIV_DATA; $1->color = NULL; $1->foreground = $5; $$=$1; } | screen_clauses with_opt BACKGROUNDCOLOR { curr_division = CDIV_PROC; } name_or_lit { curr_division = CDIV_DATA; $1->color = NULL; $1->background = $5; $$=$1; } | screen_clauses with_opt COLOR { curr_division = CDIV_PROC; } name_or_lit { curr_division = CDIV_DATA; $1->foreground = NULL; $1->background = NULL; $1->color = $5; $$=$1; } | screen_clauses screen_source_destination | screen_clauses value_is_are gliteral { curr_field->value = $3; $$=$1; } | screen_clauses pictures | screen_clauses SIZE { curr_division = CDIV_PROC; } name_or_lit { curr_division = CDIV_DATA; $1->size = $4; $$=$1; } | /* nothing */ { $$ = alloc_scr_info(); } ; screen_source_destination: USING { curr_division = CDIV_PROC; } name_or_lit { curr_division = CDIV_DATA; $0->from = $0->to = $3; } | FROM { curr_division = CDIV_PROC; } name_or_lit screen_to_name { curr_division = CDIV_DATA; $0->from = $3; $0->to = $4; } | TO { curr_division = CDIV_PROC; } name { curr_division = CDIV_DATA; $0->from = NULL; $0->to = $3; } ; screen_to_name: /* nothing */ { $$=NULL; } | TO name { $$ = $2; } ; screen_attrib: BLANK SCREEN { $$ = SCR_BLANK_SCREEN; } | BLANK LINE { $$ = SCR_BLANK_LINE; } | ERASE EOL { $$ = SCR_ERASE_EOL; } | ERASE EOS { $$ = SCR_ERASE_EOS; } | ERASE { $$ = SCR_ERASE_EOL; } | with_opt BELL { $$ = SCR_BELL; } | sign_clause { $$ = $1; } | FULL { $$ = SCR_FULL; } | REQUIRED { $$ = SCR_REQUIRED; } | SECURE { $$ = SCR_SECURE; } | AUTO { $$ = SCR_AUTO; } | JUSTIFIED RIGHT { $$ = SCR_JUST_RIGHT; } | JUSTIFIED LEFT { $$ = SCR_JUST_LEFT; } | BLINK { $$ = SCR_BLINK; } | REVERSEVIDEO { $$ = SCR_REVERSE_VIDEO; } | UNDERLINE { $$ = SCR_UNDERLINE; } | LOWLIGHT { $$ = SCR_LOWLIGHT; } | HIGHLIGHT { $$ = SCR_HIGHLIGHT; } | BLANK when_opt ZERO { $$ = SCR_BLANK_WHEN_ZERO; } | with_opt NOECHO { $$ = SCR_NOECHO; } | with_opt UPDATE { $$ = SCR_UPDATE; } | with_opt NO ADVANCING { $$ = SCR_NO_ADVANCING; } | UPPER { $$ = SCR_UPPER; } | LOWER { $$ = SCR_LOWER; } ; /* wakter */ screen_attribx: BLANK SCREEN { $$ = SCR_BLANK_SCREEN; } | BLANK LINE { $$ = SCR_BLANK_LINE; } | ERASE EOL { $$ = SCR_ERASE_EOL; } | ERASE EOS { $$ = SCR_ERASE_EOS; } | ERASE { $$ = SCR_ERASE_EOL; } | with_opt BELL { $$ = SCR_BELL; } | sign_clause { $$ = $1; } | FULL { $$ = SCR_FULL; } | REQUIRED { $$ = SCR_REQUIRED; } | SECURE { $$ = SCR_SECURE; } | AUTO { $$ = SCR_AUTO; } | JUSTIFIED RIGHT { $$ = SCR_JUST_RIGHT; } | JUSTIFIED LEFT { $$ = SCR_JUST_LEFT; } | BLINK { $$ = SCR_BLINK; } | REVERSEVIDEO { $$ = SCR_REVERSE_VIDEO; } | UNDERLINE { $$ = SCR_UNDERLINE; } | LOWLIGHT { $$ = SCR_LOWLIGHT; } | HIGHLIGHT { $$ = SCR_HIGHLIGHT; } | BLANK when_opt ZERO { $$ = SCR_BLANK_WHEN_ZERO; } | with_opt NOECHO { $$ = SCR_NOECHO; } | with_opt UPDATE { $$ = SCR_UPDATE; } | with_opt NO ADVANCING { $$ = SCR_NO_ADVANCING; } | UPPER { $$ = SCR_UPPER; } | LOWER { $$ = SCR_LOWER; } | FOREGROUNDCOLOR integer { $$ = 0; fg = $2; } | BACKGROUNDCOLOR integer { $$ = 0; bg = $2; } ; /* fim walter */ sign_clause: sign_is_opt LEADING separate_opt { $$ = SCR_SIGN_LEADING | $3; } | sign_is_opt TRAILING separate_opt { $$ = $3; } ; separate_opt: SEPARATE character_opt { $$ = SCR_SIGN_SEPARATE; } | /* nothing */ { $$ = 0; } ; character_opt: CHARACTER | /* nothing */ ; sign_is_opt: SIGN is_opt | is_opt ; plus_minus_opt: PLUS { $$ = 1; } | '+' { $$ = 1; } | MINUS { $$ = -1; } | '-' { $$ = -1; } | /* nothing */ { $$ = 0; } ; number_is_opt: NUMBER is_opt | /* nothing */ ; /* end screen section */ /* * File description entry */ file_section: file_section FD { curr_division = CDIV_FD; } STRING { curr_division = CDIV_DATA; } file_description_fd_clauses PERIOD_TOK { curr_field=NULL; if ($4->filenamevar == NULL) { yyerror("External file name not defined for file %s", $4->name); } } file_description { close_fields(); alloc_file_entry($4); gen_fdesc($4,$9); } | file_section SD { curr_division = CDIV_FD; } STRING { curr_division = CDIV_DATA; } file_description_sd_clauses PERIOD_TOK { $4->organization=2; curr_field=NULL; } file_description { close_fields(); alloc_file_entry($4); $4->sort_file = 1; gen_fdesc($4,$9); } | error { yyerror("missing or invalid file description entry"); } | /* nothing */ ; file_description: field_description { $$=$1; } | file_description field_description { if (($2 != NULL) && ($2->level == 1)) { /* multiple 01 records (for a file descriptor) */ $2->redefines=$1; $$=$2; } else $$=$1; } ; /* * DATA DESCRIPTION ENTRY */ field_description: integer def_name_opt { picix=piccnt=v_flag=n_flag=decimals=pscale=0; if ($1 == 78) { yyerror("level 78 not supported"); } if ($2==NULL) { define_field($1,alloc_filler()); } else { define_field($1,$2); } } data_clauses PERIOD_TOK { $$=$2; if (($$ == NULL) || ($$->level != 66)) update_field(curr_field); } ; data_clauses: /* nothing */ | data_clauses data_clause | data_clauses redefines_clause ; redefines_clause: REDEFINES { curr_division = CDIV_PROC; /* parsing variable */ } redefines_var { curr_division = CDIV_DATA; if ($-2 != NULL) { $-2->redefines = lookup_for_redefines($3); } else { yywarn("cannot redefine an unnamed field"); } } ; redefines_var: VARIABLE { $$=$1; } | SUBSCVAR { $$=$1; } ; data_clause: array_options | pictures | usage_option | sign_clause { curr_field->flags.separate_sign = ($1 & SCR_SIGN_SEPARATE) ? 1 : 0; curr_field->flags.leading_sign = ($1 & SCR_SIGN_LEADING) ? 1 : 0; } | value_option | SYNCHRONIZED sync_options {curr_field->flags.sync=1;} | JUSTIFIED sync_options {if ($2 != 2) curr_field->flags.just_r=1;} | is_opt EXTERNAL {save_named_sect(curr_field);} | is_opt GLOBAL {} | BLANK when_opt ZERO { curr_field->flags.blank=1; } | RENAMES { curr_division = CDIV_PROC /* for parsing variable */; } variable thru_gname_opt { curr_division = CDIV_DATA; update_renames_field($3, $4);} ; sync_options: /* nothing */ {$$=0;} | LEFT {$$=2;} | RIGHT {$$=1;} ; thru_gname_opt: /* nothing */ { $$ = NULL;} | THRU variable { $$ = $2;} ; /* OCCURS clause */ array_options: OCCURS integer times_opt { curr_field->times = $2; curr_field->occurs_flg++; } indexed_by_opt | OCCURS integer TO integer times_opt DEPENDING { curr_division = CDIV_PROC; /* needed for parsing variable */ } on_opt gname { curr_division = CDIV_DATA; create_occurs_info($2,$4,$9); } indexed_by_opt ; key_is_opt: DIRECTION key_opt is_opt STRING { $4->level=0; if ($1 == ASCENDING) { $4->level=-1; } if ($1 == DESCENDING) { $4->level=-2; } $$=$4; } | { $$=NULL; } ; indexed_by_opt: key_is_opt INDEXED by_opt index_name_list { /*define_implicit_field($4, $1, curr_field->times);*/ /* Fix Me: Does not work, thus dup vars can be defined if ($4->defined) { yyerror("variable redefined, '%s'",$4->name); $4->defined=1; } else { define_implicit_field($4, $1, curr_field->times); } */ } | /* nothing */ ; index_name_list: def_name { define_implicit_field($1, $-2, curr_field->times); /* Fix Me: Does not work, thus dup vars can be defined if ($4->defined) { yyerror("variable redefined, '%s'",$4->name); $4->defined=1; } else { define_implicit_field($4, $1, curr_field->times); } */ } | index_name_list def_name { define_implicit_field($2,$-2,curr_field->times); } ; /* USAGE clause */ usage_option : usage_opt is_opt usage { set_usage(curr_field, $3); } ; usage: USAGENUM { $$=$1; } | DISPLAY { $$=USAGE_DISPLAY; } | POINTER { $$=USAGE_POINTER; } ; /* VALUE clause */ value_option: value_is_are value_list ; value_is_are: VALUE is_opt | VALUES are_opt ; value_list: value | value_list comma_opt value ; value: gliteral { set_variable_values($1,$1); } | gliteral THRU gliteral { set_variable_values($1,$3); } ; /* Pictures clause */ pictures: PICTURE { curr_division = CDIV_PIC; /* first pic char found */ picix=piccnt=v_flag=n_flag=decimals=pscale=0; picture[picix]=0; } is_opt picture { /* finish picture */ picture[picix+2]=0; curr_field->decimals=decimals; curr_field->pscale=pscale; if (curr_field->type == DTYPE_DISPLAY && piccnt > 18) { yyerror("Maximum elementary numeric item size of %s > 18 digits exceeded", curr_field->name); } if (curr_field->type == DTYPE_ALPHANUMERIC && piccnt > 12750) { yyerror("Maximum elementary alphanumeric item size of %s > 12750 exceeded", curr_field->name); } } ; picture: /* nothing */ | picture pic_elem ; pic_elem: CHAR multiplier_opt { if (!save_pic_char ( $1, $2 )) { yyerror("invalid char in picture"); YYERROR; } } ; multiplier_opt: /* nothing */ { $$ = 1; } | MULTIPLIER { $$ = $1; } ; /* File description entry */ file_description_fd_clauses: | file_description_fd_clauses file_description_fd_clause ; file_description_sd_clauses: | file_description_sd_clauses file_description_sd_clause ; file_description_fd_clause: is_opt EXTERNAL { $0->type = 'K'; } | is_opt GLOBAL { $0->type = 'J'; } | file_description_clause_block | file_description_clause_record | file_description_clause_label | file_description_clause_value | file_description_clause_data | file_description_clause_report | file_description_clause_linage | file_description_clause_code_set ; file_description_sd_clause: file_description_clause_record | file_description_clause_data ; file_description_clause_block: BLOCK contains_opt integer to_integer_opt chars_or_recs_opt { /* unimplemented - clause ignored */ } ; file_description_clause_record: RECORD contains_opt integer to_rec_varying character_opts { if ($4 != NULL) { UNIMPLEMENTED ("RECORD CONTAINS integer1 TO integer2 CHARACTERS clause") /* unimplemented */ } } | RECORD is_opt VARYING in_opt size_opt from_rec_varying to_rec_varying character_opts depend_rec_varying { if ($9 != NULL) { set_rec_varying_info( $-2,$6,$7,$9 ); } else { yyerror("clause \'DEPENDING ON data-name-1\' is missing"); } } ; file_description_clause_label: LABEL record_is_are std_or_omitt { /* obsolete */ } ; file_description_clause_value: VALUE OF FILE_ID is_opt filename { if ($-2->filenamevar != NULL) { yyerror("Re-defining file name defined in SELECT statement"); } else { $-2->filenamevar = $5; } } ; file_description_clause_data: DATA record_is_are var_strings { /* obsolete */ } ; file_description_clause_report: report_is_are STRING { save_report( $2,$0 ); } ; file_description_clause_code_set: CODE_SET is_opt STRING { UNIMPLEMENTED ("Code-set is alphabet") /* unimplemented */ } ; file_description_clause_linage: LINAGE is_opt data_name lines_opt file_description_clause_linage_footing file_description_clause_linage_top file_description_clause_linage_bottom { UNIMPLEMENTED ("Linage is clause") /* unimplemented */ } ; file_description_clause_linage_footing: | with_opt FOOTING at_opt data_name { /* unimplemented */ } ; file_description_clause_linage_top: | lines_at_opt TOP data_name { /* unimplemented */ } ; file_description_clause_linage_bottom: | lines_at_opt BOTTOM data_name { /* unimplemented */ } ; lines_at_opt: /* nothing */ | LINES | LINES AT | AT ; report_is_are: REPORT is_opt | REPORTS are_opt ; var_strings: STRING { } | var_strings STRING { } ; chars_or_recs_opt: /* nothing */ | CHARACTERS | RECORDS ; to_integer_opt: /* nothing */ | TO integer { } ; depend_rec_varying: { $$ = NULL; } | DEPENDING on_opt STRING { $$ = $3; } ; from_rec_varying: /* nothing */ { $$ = NULL; } | from_opt nliteral { $$ = $2; } ; from_opt: FROM | /* nothing */ ; to_rec_varying: /* nothing */ { $$ = NULL; } | TO nliteral { $$ = $2; } ; record_is_are: RECORD is_opt | RECORDS are_opt ; std_or_omitt: STANDARD | OMITTED ; usage_opt: /* nothing */ | USAGE ; times_opt: /* nothing */ | TIMES ; when_opt: /* nothing */ | WHEN ; contains_opt: /* nothing */ | CONTAINS ; character_opts: /* nothing */ | CHARACTERS ; order_opt: /* nothing */ | ORDER ; data_opt: /* nothing */ | DATA ; /* * DATA DIVISION - working storage section */ working_storage_section: working_storage_section field_description | /* nothing */ ; /* * DATA DIVISION - linkage section */ linkage_section: /* nothing */ | linkage_section field_description ; /* procedure_division: | procedure_division procedure_decl ; */ /* * PROCEDURE DIVISION */ procedure_division_opt: PROCEDURE DIVISION { curr_division = CDIV_PROC; } using_parameters PERIOD_TOK { proc_header($4); } declaratives_opt procedure_division { /* close procedure_division sections & paragraphs */ close_section(); /* this also closes paragraph */ resolve_labels(); proc_trail($4); } | /* nothing */ ; procedure_division: | procedure_division procedure_decl ; procedure_decl: procedure_section { close_section(); open_section($1); } | paragraph { close_paragr(); open_paragr($1); } | {free_expr_list(); stabs_line();} statements PERIOD_TOK /* | {free_expr_list(); stabs_line();} statements */ | error { yyerror("unknown or wrong statement"); } PERIOD_TOK | PERIOD_TOK { } ; /* Procedure Division Declaratives */ declaratives_opt: DECLARATIVES PERIOD_TOK { decl_lbl=loc_label++; gen_jmplabel(decl_lbl); } declaratives_procedure declaratives_division END DECLARATIVES PERIOD_TOK { gen_dstlabel(decl_lbl); } | /* nothing */ ; declaratives_division: | declaratives_division declaratives_decl /* | declaratives_division procedure_decl */ ; declaratives_decl: declaratives_procedure | paragraph { close_paragr(); open_paragr($1); } | {free_expr_list(); stabs_line();} statements PERIOD_TOK | error { yyerror("unknown or wrong statement"); } PERIOD_TOK /* | PERIOD_TOK { } */ ; declaratives_procedure: procedure_section { close_section(); open_section($1); } use_phrase | error { yyerror("section name expected"); } ; use_phrase: USE AFTER use_phrase_exception_error PROCEDURE on_opt use_phrase_option PERIOD_TOK { /* mark_decl_list($6); */ } | error { yyerror("use statement expected"); } ; use_phrase_exception_error: EXCEPTION | ERROR_TOK | STANDARD EXCEPTION | STANDARD ERROR_TOK ; use_phrase_option: gname_list { $$=$1; } | open_mode { $$=NULL; UNIMPLEMENTED ("Declaratives open-mode clause") /* unimplemented */ } ; /* Procedure division sections and paragraphs */ procedure_section: LABELSTR SECTION PERIOD_TOK { struct sym *lab=$1; if (lab->defined != 0) { lab = install(lab->name,SYTB_LAB,2); } lab->defined = 1; $$=lab; } ; paragraph: LABELSTR dot_or_eos { struct sym *lab=$1; if (lab->defined != 0) { if ((lab=lookup_label(lab,curr_section))==NULL) { lab = install($1->name,SYTB_LAB,2); } } lab->parent = curr_section; lab->defined=1; $$=lab; } ; dot_or_eos: '.' | PERIOD_TOK ; /* * PROCEDURE DIVISION - COBOL verbs */ statement_list: statements { } ; statements: statement | statements statement ; statement: move_statement | initialize_statement | compute_statement | add_statement | subtract_statement | multiply_statement | divide_statement | accept_statement | display_statement | open_statement | close_statement | read_statement | return_statement | release_statement | write_statement | rewrite_statement | delete_statement | start_statement | perform_statement | goto_statement | exit_statement | stop_statement | call_statement | call_loadlib_statement | chain_statement | set_statement | sort_statement | merge_statement | inspect_statement | string_statement | unstring_statement | initiate_statement | generate_statement | terminate_statement | proto_statement | trace_statement | goback_statement | cancel_statement | unlock_statement | if_statement | evaluate_statement | search_statement | CONTINUE { stabs_line(); } /* | NEXT SENTENCE { stabs_line(); } */ ; perform_statement: PERFORM perform_options ; if_statement: if_part { gen_dstlabel($1); } end_if_opt | if_part ELSE { $$=gen_passlabel(); gen_dstlabel($1); } /* sentence { gen_dstlabel($3); } */ conditional_statement { gen_dstlabel($3); } end_if_opt ; search_statement: SEARCH search end_search_opt | SEARCH ALL search_all end_search_opt ; evaluate_statement: EVALUATE { $$ = gen_evaluate_start(); } selection_subject_set { compute_subject_set_size($3); } when_case_list end_evaluate_or_eos { release_sel_subject($2,$3); } ; end_evaluate_or_eos: END_EVALUATE | PERIOD_TOK ; selection_subject_set: { $$=NULL; /* to store non-numeric symbols */ } selection_subject { $$=save_sel_subject($2,NULL,$1); } | selection_subject_set ALSO { $$=NULL; /* to store non-numeric symbols */ } selection_subject { $$=save_sel_subject($4,$1,$3); } ; selection_subject: expr /* this already includes identifiers and literals */ { if (push_expr($1)) $$=SSUBJ_EXPR; else { $0 = $1; $$=SSUBJ_STR; } } | condition { push_condition(); $$=SSUBJ_COND; } | TRUE_TOK { $$=SSUBJ_TRUE; } | FALSE_TOK { $$=SSUBJ_FALSE; } ; when_case_list: WHEN { $$ = loc_label++; /* mark end of "when" case */ } { $$=$-1; /* store inherited subject set */ } when_case sentence_or_nothing { $$=gen_end_when($-2,$2,$5); } | when_case_list WHEN { $$ = loc_label++; } { $$=$-1; } when_case { gen_bypass_when_case($1); } sentence_or_nothing { $$=gen_end_when($-2,$3,$7); } ; when_case: { $$ = NULL; } selection_object { gen_when_check(0,$0,$2,$-1,$1); $$=0; } | when_case ALSO { $$ = NULL; } selection_object { gen_when_check($1+1,$0,$4,$-1,$3); $$=$1+1; } | OTHER { $$=-1; } ; selection_object: ANY { $$=SOBJ_ANY; } | TRUE_TOK { $$=SOBJ_TRUE; } | FALSE_TOK { $$=SOBJ_FALSE; } | not_opt expr { if (push_expr($2)) { if ($1) $$=SOBJ_NEGEXPR; else $$=SOBJ_EXPR; } else { /* non-numeric comparation */ $0 = $2; if ($1) $$=SOBJ_NEGSTR; else $$=SOBJ_STR; } } | not_opt expr THRU expr { if (push_expr($4) && push_expr($2)) { if ($1) $$=SOBJ_NEGRANGE; else $$=SOBJ_RANGE; } else { yyerror("ranges only accepted for numeric variables"); } } | not_opt cond_name { gen_condition($2); if ($1) $$=SOBJ_NEGCOND; else $$=SOBJ_COND; } ; sentence_or_nothing: /* nothing */ { $$ = 0; } | conditional_statement { $$ = 1; } ; if_part: IF condition { $$=gen_testif(); } end_then_opt conditional_statement { $$=$3; } /* sentence { $$=$3; }*/ ; /* Fix me: This does not conform to the ANSI85 standard. However, it does reduce the number of conflicts. */ conditional_statement: { stabs_line(); } statement_list | { stabs_line(); } NEXT SENTENCE /* | { stabs_line(); } CONTINUE */ ; not_opt: /* nothing */ { $$=0; } | NOT { $$=1; } ; end_if_opt: | END_IF ; end_then_opt: | THEN ; search: variable_indexed { $$=loc_label++; /* determine END label name */ gen_marklabel(); /* yydebug=1; */ } search_varying_opt { $$=loc_label++; /* determine search loop start label */ if ($3 == NULL) { $3=determine_table_index_name($1); if ($3 == NULL) { yyerror("Unable to determine search index for table '%s'", $1->name); } } gen_jmplabel($$); /* generate GOTO search loop start */ } search_at_end { gen_jmplabel($2); /* generate GOTO END */ gen_dstlabel($4); /* generate search loop start label */ $$ = $2; } search_when_list { /* increment loop index, check for end */ gen_SearchLoopCheck($5, $3, $1); gen_jmplabel($4); /* generate goto search loop start label */ gen_dstlabel($2); /* generate END label */ } ; search_all: variable_indexed { lbend=loc_label++; /* determine END label name */ gen_marklabel(); lbstart=loc_label++; /* determine search_all loop start label */ $$=determine_table_index_name($1); if ($$ == NULL) { yyerror("Unable to determine search index for table '%s'", $1->name); } else { /* Initilize and store search table index boundaries */ Initialize_SearchAll_Boundaries($1, $$); } gen_jmplabel(lbstart); /* generate GOTO search_all loop start */ } search_at_end { gen_jmplabel(lbend); /* generate GOTO END */ gen_dstlabel(lbstart); /* generate search loop start label */ } search_all_when_list { /* adjust loop index, check for end */ gen_SearchAllLoopCheck($3, $2, $1, curr_field, lbstart, lbend); } ; search_varying_opt: VARYING variable { $$=$2; } | { $$=NULL; } ; search_at_end: at_opt END { $$=loc_label++; /* determine ATEND label name */ gen_dstlabel($$); /* determine ATEND label name */ } statement_list { $$=$3; } | { $$=loc_label++; /* determine ATEND label name */ gen_dstlabel($$); /* determine ATEND label name */ } ; search_when_list: search_when { $$=$1; } | search_when_list search_when { $$=$1; } ; search_when: WHEN search_when_conditional { $$=gen_testif(); } search_when_statement { $$ = $0; gen_jmplabel($$); /* generate GOTO END */ gen_dstlabel($3); } ; search_when_statement: statement_list | NEXT SENTENCE /* | CONTINUE */ ; search_when_conditional: /* name cond_op name { gen_compare($1,$2,$3); } | name cond_op nliteral { gen_compare($1,$2,(struct sym *)$3); } | name extended_cond_op name_or_lit { gen_compare($1,$2,$3); } | name_or_lit extended_cond_op name { gen_compare($1,$2,$3); } | nliteral cond_op nliteral { gen_compare((struct sym *)$1,$2,(struct sym*)$3); } */ name_or_lit extended_cond_op name_or_lit { gen_compare($1,$2,$3); } ; search_all_when_list: search_all_when | search_all_when_list search_all_when ; search_all_when: WHEN { curr_field = NULL; } search_all_when_conditional { $$=gen_testif(); } search_all_when_statement { gen_jmplabel(lbend); /* generate GOTO END */ gen_dstlabel($4); } ; search_all_when_statement: statement_list /* statement */ | NEXT SENTENCE /* | CONTINUE */ ; search_all_when_conditional: variable is_opt CONDITIONAL to_opt variable { if ($3 != EQUAL) yyerror("Only = conditional allowed in search all statement"); if (curr_field == NULL) curr_field = $1; gen_compare($1,$3,$5); } | variable is_opt CONDITIONAL to_opt literal { if ($3 != EQUAL) yyerror("Only = conditional allowed in search all statement"); if (curr_field == NULL) curr_field = $1; gen_compare($1,$3,(struct sym *)$5); } | search_all_when_conditional AND { $$=gen_andstart(); } search_all_when_conditional { gen_dstlabel($3); } ; end_search_opt: | END_SEARCH ; unlock_statement: UNLOCK name { gen_unlock($2); } ; proto_statement: TCOBPROTO1 gname { gen_tcob_proto1( $2 ); } | TCOBPROTO2 gname gname { gen_tcob_proto2( $2,$3 ); } ; trace_statement: READY TRACE { } | RESET TRACE { } ; initiate_statement: INITIATE name ; generate_statement: GENERATE name ; terminate_statement: TERMINATE name ; cancel_statement: CANCEL gname { gen_cancel($2); } | CANCEL ALL { gen_cancel(NULL); } ; /* MERGE statement */ merge_statement: MERGE name sort_keys { sort_keys_append($2, $3); } sort_collating_opt { gen_sort($2); } merge_using { gen_sort_using($2, $7); } sort_output { if ($9 != NULL) { gen_sort_giving($2, $9); } } ; merge_using: USING sort_file_list { $$=$2; } ; /* SORT statement */ sort_statement: sort_file; | sort_variable_indexed; sort_file: SORT name sort_keys { sort_keys_append($2, $3); } sort_duplicates_opt sort_collating_opt { gen_sort($2); } sort_input { if ($8 != NULL) { gen_sort_using($2, $8); } } sort_output { if ($10 != NULL) { gen_sort_giving($2, $10); } } ; sort_variable_indexed: // walter SORT variable_indexed sort_keys_idx { sort_keys_append($2, $3); } sort_duplicates_opt sort_collating_opt { gen_sort($2); } ; sort_keys: sort_key { $$=sort_keys_list_append(NULL, $1); } | sort_keys sort_key { $$=sort_keys_list_append($1, $2); } ; sort_keys_idx: sort_key_idx { $$=sort_keys_list_append(NULL, $1); } | sort_keys_idx sort_key_idx { $$=sort_keys_list_append($1, $2); } ; sort_key: on_opt DIRECTION key_opt sort_keys_names { $$=sort_key_list_create($4, $2); } ; sort_key_idx: on_opt DIRECTION key_opt sort_keys_names_idx { $$=sort_key_list_create($4, $2); } ; sort_keys_names: name { $$ = gvar_list_append(NULL, $1, source_lineno); } | sort_keys_names name { $$ = gvar_list_append($1, $2, source_lineno); } ; sort_keys_names_idx: variable_indexed { $$ = gvar_list_append(NULL, $1, source_lineno); } | sort_keys_names_idx variable_indexed { $$ = gvar_list_append($1, $2, source_lineno); } ; sort_duplicates_opt: | with_opt DUPLICATES in_opt order_opt { UNIMPLEMENTED ("SORT with duplicates in order clause") /* unimplemented */ } ; sort_collating_opt: | collating_sequence { UNIMPLEMENTED ("SORT/MERGE collating sequence clause") /* unimplemented */ } ; /* SORT and MERGE statement clauses */ sort_input: INPUT PROCEDURE is_opt perform_range { $$=NULL; } | USING sort_file_list { $$=$2; } ; sort_output: OUTPUT PROCEDURE is_opt perform_range { $$=NULL; } | GIVING sort_file_list { $$=$2; } ; sort_file_list: name { $$ = alloc_sortfile_node($1); } | sort_file_list name { $1->next = alloc_sortfile_node($2); $$=$1; } ; /* MOVE statement */ move_statement: MOVE gname TO name_var_list { gen_moves($2, $4); } | MOVE CORRESPONDING name_var TO name_var { gen_movecorr($3, $5); } | MOVE LENGTH OF gname TO name_var { gen_movelength($4, $6); } | MOVE gname TO { yyerror("Expected variable"); } ; /* INITIALIZE statement walter 13-12-05 (_verb) gname_list removi o initialize_replacing_opt*/ initialize_statement: /* INITIALIZE gname_list initialize_replacing_opt { gen_initializes_verb($2,init_alphab,init_alpha,init_alphaedt,init_num,init_numedt); } */ INITIALIZE gname_list initialize_replacing_opt { gen_initializes($2); } | INITIALIZE { yyerror("INITIALIZE: expected a variable name");} ; initialize_replacing_opt: | REPLACING initialize_replacing_lists { UNIMPLEMENTED ("INITIALIZE ... REPLACING clause") } ; initialize_replacing_lists: initialize_replacing_list | initialize_replacing_lists initialize_replacing_list ; initialize_replacing_list: initialize_type_list data_opt BY gname { /* not implimented */ } ; initialize_type_list: ALPHABETIC { } | ALPHANUMERIC { } | NUMERIC { } | ALPHANUMERIC_EDITED { } | NUMERIC_EDITED { } ; /* Compute statement */ compute_statement: COMPUTE compute_body end_compute_opt | COMPUTE { yyerror(err_msg_bad_form, "COMPUTE");} ; compute_body: var_list_name CONDITIONAL expr on_size_error_opt { if ($2 != EQUAL) yyerror("= expected"); else if ($4 == NULL) gen_compute1($1, $3); else gen_compute2($1, $3, $4); delete_mathvar_info($1); if ($4 != NULL) tmose = NULL; } ; end_compute_opt: /* nothing */ | END_COMPUTE ; /* Add statement */ add_statement: ADD add_body end_add_opt | ADD { yyerror(err_msg_bad_form, "ADD");} ; add_body: var_list_gname TO var_list_name on_size_error_opt { gen_add1($1, $3, $4); delete_mathvar_info($1); delete_mathvar_info($3); if ($4 != NULL) tmose = NULL; } | var_list_gname add_to_opt GIVING var_list_name on_size_error_opt { gen_add2($1, $4, $2, $5); delete_mathvar_info($1); delete_mathvar_info($4); if ($5 != NULL) tmose = NULL; } | CORRESPONDING var_list_gname TO var_list_name rounded_opt on_size_error_opt { gen_addcorr1($2, $4, $5, $6); delete_mathvar_info($2); delete_mathvar_info($4); if ($6 != NULL) tmose = NULL; } ; add_to_opt: /* nothing */ { $$ = NULL; } | TO gname { $$ = $2; } ; end_add_opt: /* nothing */ | END_ADD ; /* Subtract statement */ subtract_statement: SUBTRACT subtract_body end_subtract_opt | SUBTRACT { yyerror(err_msg_bad_form, "SUBTRACT");} ; subtract_body: var_list_gname FROM var_list_name on_size_error_opt { gen_subtract1($1, $3, $4); delete_mathvar_info($1); delete_mathvar_info($3); if ($4 != NULL) tmose = NULL; } | var_list_gname FROM gname GIVING var_list_name on_size_error_opt { assert_numeric_sy($3); gen_subtract2($1, $5, $3, $6); delete_mathvar_info($1); delete_mathvar_info($5); if ($6 != NULL) tmose = NULL; } | CORRESPONDING var_list_gname FROM var_list_name rounded_opt on_size_error_opt { gen_subtractcorr1($2, $4, $5, $6); delete_mathvar_info($2); delete_mathvar_info($4); if ($6 != NULL) tmose = NULL; } ; end_subtract_opt: | END_SUBTRACT ; /* Multiply statement */ multiply_statement: MULTIPLY multiply_body end_multiply_opt | MULTIPLY { yyerror(err_msg_bad_form, "MULTIPLY");} ; multiply_body: gname BY gname GIVING var_list_name on_size_error_opt { assert_numeric_sy($1); assert_numeric_sy($3); gen_multiply2($5, $1, $3, $6); delete_mathvar_info($5); if ($6 != NULL) tmose = NULL; } | gname BY var_list_name on_size_error_opt { assert_numeric_sy($1); gen_multiply1($3, $1, $4); delete_mathvar_info($3); if ($4 != NULL) tmose = NULL; } ; end_multiply_opt: /* nothing */ | END_MULTIPLY ; /* Divide statement */ divide_statement: DIVIDE divide_body end_divide_opt | DIVIDE { yyerror(err_msg_bad_form, "DIVIDE");} ; divide_body: gname BY gname GIVING var_list_name on_size_error_opt { assert_numeric_sy($1); assert_numeric_sy($3); gen_divide2($5, $1, $3, $6); delete_mathvar_info($5); if ($6 != NULL) tmose = NULL; } | gname BY gname GIVING name rounded_opt REMAINDER name on_size_error_opt { assert_numeric_sy($1); assert_numeric_sy($3); assert_numeric_dest_sy($5); gen_divide4($1, $3, $5, $8, $6, $9); if ($9 != NULL) tmose = NULL; } | gname INTO gname GIVING name rounded_opt REMAINDER name on_size_error_opt { assert_numeric_sy($1); assert_numeric_sy($3); assert_numeric_dest_sy($5); gen_divide4($3, $1, $5, $8, $6, $9); if ($9 != NULL) tmose = NULL; } | gname INTO gname GIVING var_list_name on_size_error_opt { assert_numeric_sy($1); assert_numeric_sy($3); gen_divide2($5, $3, $1, $6); delete_mathvar_info($5); if ($6 != NULL) tmose = NULL; } | gname INTO var_list_name on_size_error_opt { assert_numeric_sy($1); gen_divide1($3, $1, $4); delete_mathvar_info($3); if ($4 != NULL) tmose = NULL; } ; end_divide_opt: /* nothing */ | END_DIVIDE ; /* Accept statement */ accept_statement: accept_hardware /* Accept format 1 (hardware) */ | accept_chronological /* Accept format 2 (chronological) */ | accept_screen /* Accept format 3 (screen) */ | ACCEPT { yyerror(err_msg_bad_form, "ACCEPT");} ; accept_hardware: ACCEPT name FROM INKEY end_accept_opt { gen_accept_from_inkey($2); } | ACCEPT name FROM INPUT STATUS end_accept_opt { gen_accept_from_inkey($2); } | ACCEPT name FROM CMD_LINE end_accept_opt { gen_accept_from_cmdline($2); } | ACCEPT name FROM ESCKEY end_accept_opt { gen_accept_from_escapekey($2); } /* walter */ | ACCEPT name FROM ENVIRONMENT_VARIABLE CLITERAL end_accept_opt { save_literal($5,'X'); $5->all=0; gen_accept_env_var($2, $5); } ; accept_chronological: ACCEPT name FROM DATE_TIME end_accept_opt { gen_accept_from_chron($2, $4, 0); } ; accept_screen: ACCEPT name accept_display_options end_accept_opt { /* walter acrescentei co ao final de todo gen_accept( */ /* gen_accept($2, $3, 1); */ co = ((bg * 8) + fg); gen_accept($2, $3, 1, co); } | ACCEPT name accept_display_options on_opt EXCEPTION { screen_io_enable++; HTG_prg_uses_term = 1; /* gen_accept($2, $3, 1); */ co = ((bg * 8) + fg); gen_accept($2, $3, 1, co); } variable { gen_store_fnres($7); $$ = gen_check_zero(); } statement_list { gen_dstlabel($8); } end_accept_opt ; end_accept_opt: /* Nothing */ | END_ACCEPT ; /* Display statement */ display_statement: display_line | display_screen | DISPLAY { yyerror(err_msg_bad_form, "DISPLAY");} ; display_line: DISPLAY display_varlist display_upon display_line_options end_display_opt /* walter acrescentei 0 */ { gen_display_line($3, $4, 0); } ; display_screen: DISPLAY display_varlist accept_display_options end_display_opt { /* walter acrescentei co ao final de todo gen_accept( */ /* gen_accept($2, $3, 1); */ co = ((bg * 8) + fg); gen_display_screen($3, co); } ; display_varlist: gname { put_disp_list($1); } | display_varlist sep_opt gname { put_disp_list($3); } ; display_upon: UPON CONSOLE { $$ = 1; } | UPON STD_OUTPUT { $$ = 1; } | UPON STD_ERROR { $$ = 2; } ; display_line_options: /* nothing */ { $$ = 0; } | display_line_options with_opt NO ADVANCING { $$ = $1 | SCR_NO_ADVANCING; } | display_line_options with_opt ERASE { $$ = $1 | SCR_ERASE_EOL; } | display_line_options with_opt ERASE EOS { $$ = $1 | SCR_ERASE_EOS; } | display_line_options with_opt ERASE EOL { $$ = $1 | SCR_ERASE_EOL; } | display_line_options with_opt ERASE SCREEN { $$ = $1 | SCR_ERASE_EOS; } ; end_display_opt: /* Nothing */ | END_DISPLAY ; /* common options for display and accept */ /*line_position: | at_opt scr_line scr_position { } | scr_line_position { } ;*/ scr_line: LINE number_opt expr { screen_io_enable++; HTG_prg_uses_term = 1; push_expr($3); gen_gotoy_expr(); } ; scr_position: COLUMN number_opt expr { screen_io_enable++; HTG_prg_uses_term = 1; push_expr($3); gen_gotox_expr(); } | POSITION expr { screen_io_enable++; HTG_prg_uses_term = 1; push_expr($2); gen_gotox_expr(); } ; scr_line_position: AT NLITERAL { screen_io_enable++; HTG_prg_uses_term = 1; scr_push_display_position($2); } | AT variable { screen_io_enable++; HTG_prg_uses_term = 1; scr_push_display_position($2); } ; accept_display_options: /* walter acrescentei co = 0 */ /* nothing */ { fg = 0; bg = 0; $$ = 0; } | accept_display_options accept_display_option { $$ = $1 | $2; } ; accept_display_option: with_opt screen_attribx { $$ = $2; } | scr_line { $$ = 0; } | scr_position { $$ = 0; } | scr_line_position { $$ = 0; } /* walter | FOREGROUNDCOLOR integer { $$ = 0; fg = $2; } | BACKGROUNDCOLOR integer { $$ = 0; bg = $2; } */ ; /* Open statement */ open_statement: OPEN open_options { HTG_prg_uses_fileio = 1; } | OPEN { yyerror(err_msg_bad_form, "OPEN");} ; open_options: open_mode open_varlist { } | open_options open_mode open_varlist { } ; /* OPENMD { $$ = $1; } */ open_mode: INPUT { $$=1; } | I_O { $$=2; } | OUTPUT { $$=3; } | EXTEND { $$=4; } | error { yyerror("invalid OPEN mode"); } ; open_varlist: name { gen_open($0, $1); } | open_varlist sep_opt name { gen_open($0, $3); } ; /* Close statement */ close_statement: CLOSE close_files | CLOSE { yyerror(err_msg_bad_form, "CLOSE");} ; close_files: close_file | close_files sep_opt close_file ; close_file: name close_options_opt { gen_close($1); } ; close_options_opt: close_options { $$=0; UNIMPLEMENTED ("CLOSE options clause") } | with_lock_opt { $$=$1; } ; close_options: with_opt NO REWIND { } | REEL { } | UNIT { } | REEL for_opt REMOVAL { } | UNIT for_opt REMOVAL { } ; with_lock_opt: with_opt LOCK { $$=1; } | with_opt IGNORE LOCK { $$=2; } | /* nothing */ { $$=0; } ; /* Return statements */ return_statement: RETURN return_body end_return_opt | RETURN { yyerror(err_msg_bad_form, "RETURN");} ; return_body: name record_opt read_into_opt { if (gen_reads($1, $3, NULL, 1, 4, 0) != 0) { YYABORT; } } | name record_opt read_into_opt read_at_end_opt { if (gen_reads($1, $3, NULL, 1, 5, 0) != 0) { YYABORT; } else { ginfo_container4($4); gic = NULL; } } ; /* Read statements */ read_statement: READ read_body end_read_opt { } | READ { yyerror(err_msg_bad_form, "READ");} ; read_body: name read_next_opt record_opt read_into_opt with_lock_opt read_key_opt { if (gen_reads($1, $4, $6, $2, 0, $5) != 0) { YYABORT; } else { gen_perform_decl($1); } } | name read_next_opt record_opt read_into_opt with_lock_opt read_key_opt read_at_end_opt { if (gen_reads($1, $4, $6, $2, 1, $5) != 0) { YYABORT; } else { ginfo_container4($7); gen_perform_decl($1); gic = NULL; } } | name read_next_opt record_opt read_into_opt with_lock_opt read_key_opt read_invalid_key_opt { if (gen_reads($1, $4, $6, $2, 2, $5) != 0) { YYABORT; } else { gen_test_invalid_keys ($7, $1, 23); gen_perform_decl($1); } } ; read_next_opt: /* nothing */ { $$ = 0; } | NEXT { $$ = 1; } | PREVIOUS { $$ = 2; } ; read_into_opt: /* nothing */ { $$ = NULL; } | INTO name { $$ = $2; } ; read_key_opt: /* nothing */ { $$ = NULL; } | KEY is_opt name { $$ = $3; } ; read_at_end_opt: NOT at_opt on_end { ginfo_container2($3, 2); $$=ginfo_container3($3, 2); } | AT on_end { ginfo_container2($2, 1); $$=ginfo_container3($2, 1); } | on_end { ginfo_container2($1, 1); $$=ginfo_container3($1, 1); } | AT on_end NOT at_opt { ginfo_container2($2, 1); } on_end { ginfo_container2($6, 2); $$=ginfo_container3($6, 3); } | on_end NOT at_opt { ginfo_container2($1, 1); } on_end { ginfo_container2($5, 2); $$=ginfo_container3($5, 3); } ; on_end: END { if ( gic == NULL ) { gic=ginfo_container0(); } $$=ginfo_container1(gic); stabs_line(); } statement_list { $$=$2; } ; read_invalid_key_opt: read_invalid_key { $$ = gen_invalid_keys ($1, NULL); } | read_not_invalid_key { $$ = gen_invalid_keys (NULL, $1); } | read_invalid_key read_not_invalid_key { $$ = gen_invalid_keys ($1, $2); } ; read_invalid_key: INVALID key_opt { $$ = gen_before_invalid_key (); } statement_list { $$ = gen_after_invalid_key ($3); } ; read_not_invalid_key: NOT INVALID key_opt { $$ = gen_before_invalid_key (); } statement_list { $$ = gen_after_invalid_key ($4); } ; end_read_opt: /* nothing */ | END_READ ; end_return_opt: /* nothing */ | END_RETURN ; /* Release statement */ release_statement: RELEASE name release_from_opt { gen_release($2, $3); } ; release_from_opt: /* nothing */ { $$ = NULL; } | FROM gname { $$ = $2; } ; /* Write statement */ write_statement: WRITE name write_from_opt write_options { if ($2->level != 1) yyerror("variable %s could not be used for WRITE", $2->name); gen_write($2, $4, $3, write_advancing_sw); } invalid_key_opt end_write_opt {gen_test_invalid_keys ($6, $2, 22);} ; write_from_opt: /* nothing */ { $$ = NULL; } | FROM gname { $$ = $2; } ; write_options: /* nothing */ { $$ = NULL; write_advancing_sw = 0; } | before_after advancing_opt gname line_lines_opt { /* gen_loadvar($3); */ $$ = $3; write_advancing_sw = $1; } | before_after advancing_opt PAGE { write_advancing_sw = -$1; $$ = NULL; } ; end_write_opt: /* nothing */ | END_WRITE ; /* Rewrite statement */ rewrite_statement: REWRITE name write_from_opt { if ($2->level != 1) yyerror("variable %s could not be used for REWRITE", $2->name); gen_rewrite($2, $3); } invalid_key_opt end_rewrite_opt {gen_test_invalid_keys ($5, $2, 22);} ; end_rewrite_opt: /* nothing */ | END_REWRITE ; /* Delete statement */ delete_statement: DELETE name record_opt { gen_delete($2); } invalid_key_opt end_delete_opt {gen_test_invalid_keys ($5, $2, 23);} ; end_delete_opt: /* nothing */ | END_DELETE ; /* Start statement */ start_statement: START start_body invalid_key_opt {gen_test_invalid_keys ($3, $2, 23);} end_start_opt ; start_body: name { gen_start($1,0,NULL); $$ = $1;} | name KEY is_opt cond_op name { gen_start($1,$4,$5); $$ = $1;} ; end_start_opt: /* nothing */ | END_START ; /* GO TO statements Format 1: Unconditional Format 2: Conditional (DEPENDING ON) Format 3: Altered (Paragraph-name. GO TO.) - not implemented */ goto_statement: GO to_opt goto_label { gen_goto($3); } | GO to_opt goto_label_list DEPENDING on_opt variable { if (is_numeric_sy($6)) gen_goto_depending($3, $6); else yyerror("variable '%s' must be numeric", $6->name); } ; goto_label: label { $$ = insert_list(NULL, $1); } ; goto_label_list: label { $$ = insert_list(NULL, $1); } | goto_label_list label { $$ = insert_list($1, $2); } | goto_label_list LISTSEP label { $$ = insert_list($1, $3); } ; /* CALL statement */ call_statement: CALL { curr_call_mode=CM_REF; } call_convention_opt gname using_options returning_options { $$ = loc_label++; /* exception check */ } { $$ = loc_label++; /* not exception check */ } { $$ = emt_call((struct lit *)$4, $5, $7, $8, $6); /* gen_store_fnres($6); */ /* If paramater is a variable then dynamic link libs are required */ /* if ($4->litflag == 0 ) { HTG_prg_uses_dcall = 1; } */ } on_exception_or_overflow on_not_exception { check_call_except($10, $11, $7, $8, $9); } end_call_opt | CALL { yyerror(err_msg_bad_form, "CALL"); } ; call_convention_opt: { curr_call_convention = 0; } | CALL_CONV_C { curr_call_convention = 0; } | CALL_CONV_STDCALL { curr_call_convention = 1; } /* | CALL_CONV_STDCALL { yyerror("STDCALL (WINAPI) convention is not implimented"); }*/ ; /* CALL-LOADLIB statement */ call_loadlib_statement: CALL_LOADLIB gname { emt_call_loadlib((struct lit *)$2); } end_call_loadlib_opt | CALL_LOADLIB { yyerror(err_msg_bad_form, "CALL-LOADLIB"); } ; /* END-CALL-LOADLIB */ end_call_loadlib_opt: END_CALL_LOADLIB { } | { } ; /* CHAIN statement */ chain_statement: CHAIN { curr_call_mode=CM_CHAIN; } gname using_options { $$ = loc_label++; /* exception check */ } { $$ = gen_chain($3,$4,$5); } on_exception_or_overflow {/* check_call_except($9,$10,$6,$7,$8);*/ } end_chain_opt | CHAIN { yyerror(err_msg_bad_form, "CHAIN"); } ; /* EXIT statement */ exit_statement: EXIT { gen_exit(0); } | EXIT PARAGRAPH { gen_exit(0); } | EXIT PROGRAM { gen_exit(1); } ; /* Stop statement */ stop_statement: STOP RUN { gen_stoprun(); } | STOP stop_literal { struct sym *sy; /* walter acrescentei 0 ao final */ gen_display_line(2, SCR_NO_ADVANCING, 0); sy = define_temp_field(DTYPE_ALPHANUMERIC,1); /* walter acrescentei 0 ao final gen_accept(sy, 0, 1); */ gen_accept(sy, 0, 1, 0); } ; stop_literal: CLITERAL { save_literal($1,'X'); $1->all=0; put_disp_list((struct sym *)$1); } | NLITERAL { save_literal($1,'X'); $1->all=0; put_disp_list((struct sym *)$1); } ; /* Goback statement */ goback_statement: GOBACK { gen_goback(); } ; var_list_name: name rounded_opt sep_opt { $$ = create_mathvar_info(NULL, $1, $2); } | var_list_name name rounded_opt sep_opt { $$ = create_mathvar_info($1, $2, $3); } ; var_list_gname: gname sep_opt { $$ = create_mathvar_info(NULL, $1, 0); } | var_list_gname gname sep_opt { $$ = create_mathvar_info($1, $2, 0); } ; rounded_opt: /* Nothing */ { $$=0; } | ROUNDED { $$=1; } ; on_size_error_opt: /* nothing */ { $$=NULL; } | NOT on_opt SIZE on_size_error { $$=math_on_size_error4($4, 2); } | on_opt SIZE on_size_error { $$=math_on_size_error4($3, 1); } | on_opt SIZE on_size_error NOT on_opt SIZE { $3->lbl1=$3->ose; } on_size_error { $$=math_on_size_error4($8, 3); } ; on_size_error: ERROR_TOK { if ( tmose == NULL ) { tmose=math_on_size_error0(); $$=math_on_size_error1(tmose); } else { $$=math_on_size_error1(tmose); } stabs_line(); } statement_list { math_on_size_error2(tmose); $$=$2; } ; size_opt: /* nothing */ | SIZE ; end_call_opt: /* nothing */ | END_CALL ; end_chain_opt: /* nothing */ | END_CHAIN ; /* SET statement */ set_statement: SET set_list ; set_list: set_target TO address_of_opt set_variable_or_nlit { gen_set_list($1,SET_TO,$4,0,$3); } | set_target UP BY var_or_nliteral { gen_set_list($1,SET_UP_BY,$4,0,0); } | set_target DOWN BY var_or_nliteral { gen_set_list($1,SET_DOWN_BY,$4,0,0); } | address_of_opt variable TO address_of_opt set_variable { gen_set($2,SET_TO,$5,$1,$4); } ; set_target: /* variable { $$ = $1; } */ name_list { $$ = $1; } | cond_name { $$ = (struct sym *)chain_var($1); } ; set_variable: variable { $$ = $1; } | NULL_TOK { $$ = NULL; } ; set_variable_or_nlit: name_or_lit { $$ = $1; } | ON { $$ = (struct sym *)define_num_lit(1); } | OFF { $$ = (struct sym *)spe_lit_ZE; } | NULL_TOK { $$ = NULL; } | TRUE_TOK { $$ = (struct sym *)1; /* no (struct sym *) may have this value! */ } ; address_of_opt: /* nothing */ { $$ = 0; } | ADDRESS of_opt { $$ = 1; } ; /* String and Unstring statements */ string_statement: STRINGCMD string_from_list INTO name string_with_pointer { gen_stringcmd( $2, $4, $5 ); } on_overflow_opt end_stringcmd_opt ; unstring_statement: UNSTRING name unstring_delimited INTO unstring_destinations string_with_pointer unstring_tallying { gen_unstring( $2, $3, $5, $6, $7 ); } on_overflow_opt end_unstring_opt ; unstring_delimited: DELIMITED by_opt unstring_delimited_vars { $$=$3; } | /* nothing */ { $$=NULL; } ; unstring_delimited_vars: all_opt gname { $$=alloc_unstring_delimited($1,$2); } | unstring_delimited_vars OR all_opt gname { struct unstring_delimited *ud; ud=alloc_unstring_delimited($3,$4); ud->next = $1; $$=ud; } ; unstring_destinations: unstring_dest_var { $$=$1; } | unstring_destinations sep_opt unstring_dest_var { $3->next = $1; $$ = $3; } ; unstring_dest_var: name unstring_delim_opt unstring_count_opt { $$ = alloc_unstring_dest( $1, $2, $3 ); } ; unstring_delim_opt: /* nothing */ { $$=NULL; } | DELIMITER in_opt name { $$=$3; } ; unstring_count_opt: /* nothing */ { $$=NULL; } | COUNT in_opt name { $$=$3; } ; unstring_tallying: /* nothing */ { $$=NULL; } | TALLYING in_opt name { $$=$3; } ; all_opt: /* nothing */ { $$=0; } | ALL { $$=1; } ; on_overflow_opt: { curr_division = CDIV_EXCEPTION; } on_overflow on_not_overflow { curr_division = CDIV_PROC; } ; on_exception_or_overflow: on_opt exception_or_overflow { $$ = begin_on_except(); } statement_list { gen_jmplabel($0); $$=$3; } | /* nothing */ { $$ = 0; } ; exception_or_overflow: EXCEPTION | OVERFLOW_TOK ; on_not_exception: NOT on_opt EXCEPTION { $$ = begin_on_except(); } statement_list { gen_jmplabel($-1); $$=$4; } | /* nothing */ { $$ = 0; } ; on_overflow: on_opt OVERFLOW_TOK { $$ = gen_at_end(1); } statement_list { gen_dstlabel($3); } | /* nothing */ ; on_not_overflow: not_excep on_opt OVERFLOW_TOK { $$ = gen_at_end(0); } statement_list { gen_dstlabel($4); } | /* nothing */ ; invalid_key_opt: invalid_key_sentence {$$ = gen_invalid_keys($1, NULL);} | not_invalid_key_sentence {$$ = gen_invalid_keys(NULL, $1);} | invalid_key_sentence not_invalid_key_sentence {$$ = gen_invalid_keys($1, $2);} | { $$ = NULL;} ; invalid_key_sentence: INVALID key_opt { $$ = gen_before_invalid_key(); } statement_list { $$ = gen_after_invalid_key($3); } ; not_invalid_key_sentence: not_excep INVALID key_opt { $$ = gen_before_invalid_key(); } statement_list { $$ = gen_after_invalid_key($4); } ; not_excep: NOTEXCEP | NOT ; string_with_pointer: with_opt POINTER name { $$ = $3; } | /* nothing */ { $$ = NULL; } ; string_from_list: string_from { $$ = $1; } | string_from_list sep_opt string_from { $3->next = $1; $$ = $3; } | error { yyerror("variable expected"); } ; string_from: gname { /* Item with no DELIMITED BY section implies use delimiter of next item */ $$ = alloc_string_from( $1, (struct sym *)-1 ); } | gname DELIMITED by_opt delimited_by { $$ = alloc_string_from( $1, $4 ); } ; delimited_by: gname { $$=$1; } | SIZE { $$=NULL; } | error { yyerror("SIZE or identifier expected"); } ; end_stringcmd_opt: /* nothing */ | END_STRINGCMD ; end_unstring_opt: /* nothing */ | END_UNSTRING ; /* INSPECT statement */ inspect_statement: INSPECT name tallying_clause { gen_inspect($2,(void *)$3,0); } replacing_clause { gen_inspect($2,(void *)$5,1); } | INSPECT name converting_clause { gen_inspect($2,(void *)$3,2); } ; converting_clause: CONVERTING noallname TO noallname inspect_before_after { $$ = alloc_converting_struct($2,$4,$5); } ; tallying_clause: TALLYING tallying_list { $$=$2; } | /* nothing */ { $$=NULL; } ; tallying_list: tallying_list name FOR tallying_for_list { $$ = alloc_tallying_list($1,$2,$4); } | /* nothing */ { $$ = NULL; } ; tallying_for_list: tallying_for_list CHARACTERS inspect_before_after { $$ = alloc_tallying_for_list($1,INSPECT_CHARACTERS,NULL,$3); } | tallying_for_list ALL noallname inspect_before_after { $$ = alloc_tallying_for_list($1,INSPECT_ALL,$3,$4); } | tallying_for_list LEADING noallname inspect_before_after { $$ = alloc_tallying_for_list($1,INSPECT_LEADING,$3,$4); } | /* nothing */ { $$ = NULL; } ; replacing_clause: REPLACING replacing_list { $$ = $2; } | /* nothing */ { $$ = NULL; } ; replacing_list: replacing_list CHARACTERS BY noallname inspect_before_after { $$ = alloc_replacing_list($1,INSPECT_CHARACTERS,NULL,$4,$5); } | replacing_list replacing_kind replacing_by_list { $$ = alloc_replacing_list($1,$2,$3,NULL,NULL); } | /* nothing */ { $$ = NULL; } ; replacing_by_list: replacing_by_list noallname BY noallname inspect_before_after { $$ = alloc_replacing_by_list($1,$2,$4,$5); } | /* nothing */ { $$ = NULL; } ; replacing_kind: ALL { $$ = INSPECT_ALL; } | LEADING { $$ = INSPECT_LEADING; } | TRAILING { $$ = INSPECT_TRAILING; } | FIRST { $$ = INSPECT_FIRST; } ; inspect_before_after: inspect_before_after BEFORE initial_opt noallname { $$ = alloc_inspect_before_after($1,1,$4); } | inspect_before_after AFTER initial_opt noallname { $$ = alloc_inspect_before_after($1,2,$4); } | /* nothing */ { $$ = alloc_inspect_before_after(NULL,0,NULL); } ; initial_opt: INITIAL_TOK | /* nothing */ ; expr: gname { $$ = $1; } | expr '*' expr { $$ = (struct sym *)create_expr('*',(struct expr *)$1,(struct expr *)$3); } | expr '/' expr { $$ = (struct sym *)create_expr('/',(struct expr *)$1,(struct expr *)$3); } | expr '+' expr { $$ = (struct sym *)create_expr('+',(struct expr *)$1,(struct expr *)$3); } | expr '-' expr { $$ = (struct sym *)create_expr('-',(struct expr *)$1,(struct expr *)$3); } | expr POW_OP expr { $$ = (struct sym *)create_expr('^',(struct expr *)$1,(struct expr *)$3); } | '(' expr ')' { $$=$2; } ; /* expr_opt will be NULL or a (struct sym *) pointer if the expression was given, otherwise it will be valued -1 */ expr_opt: /* nothing */ { $$ = (struct sym *)-1; } | expr { $$ = $1; } ; using_options: /* nothing */ { $$=0; } | USING { $$=0; /* to save how many parameters */ } dummy { $$=CALL; } parm_list { $$=$2; } /* modified to signal calling pgm */ ; returning_options: /* nothing */ { $$=0; } | RETURNING variable { $$=$2; } | GIVING variable { $$=$2; } ; dummy: /* nothing */ ; using_parameters: /* defined at procedure division */ /* nothing */ { $$=0; } | USING gname_list { gen_save_usings($2); $$=1; } | CHAINING gname_list { gen_save_chainings($2); $$=2; } ; parm_list: parm_list sep_opt parameter { if ($0 == USING) gen_save_using($3); else if ($0 == CALL) { gen_push_using($3); } } | parameter { if ($0 == USING) gen_save_using($1); else if ($0 == CALL) { gen_push_using($1); } } ; parameter: gname {$$=$1; if ($$->litflag==1) { struct lit *lp=(struct lit *)$$; lp->call_mode=curr_call_mode; } else $$->call_mode=curr_call_mode; } /*| BY parm_type gname*/ | by_opt parm_type gname { if ( curr_call_mode == CM_CHAIN ) yyerror("parameter types not allowed on CHAIN"); else { $$=$3; curr_call_mode=$2; if ($$->litflag==1) { struct lit *lp=(struct lit *)$$; lp->call_mode=curr_call_mode; } else $$->call_mode=curr_call_mode; } } /* | OMITTED { $$=save_special_literal('0','9', "%ZEROS%"); $$->call_mode=CM_VAL; } */ ; parm_type: REFERENCE {$$=CM_REF;} | VALUE {$$=CM_VAL;} | CONTENT {$$=CM_CONT;} /* | DESCRIPTOR {$$=CM_CONT;}*/ ; intrinsic_parm_list: intrinsic_parm_list sep_opt intrinsic_parm { gen_push_using($3); } | intrinsic_parm { gen_push_using($1); } ; intrinsic_parm: gname {$$=$1;$$->call_mode=CM_REF;} ; perform_range: label perform_thru_opt { gen_perform_thru($1,$2); $$ = ($2 == NULL) ? $1 : $2; } ; perform_options: perform_statements END_PERFORM { $$ = NULL; } | gname TIMES { gen_push_int($1); $$=gen_marklabel(); gen_perform_test_counter($$); } perform_statements { gen_perform_times($3); } END_PERFORM { $$ = NULL; } | with_test_opt UNTIL { if ($1 == 2) { $$.lb2=gen_passlabel(); } $$.lb1=gen_marklabel(); } condition { $$.lb1=gen_orstart(); if ($1 == 2) { $$.lb2=gen_passlabel(); gen_dstlabel($3.lb2); } } perform_statements { if ($1 == 2) { gen_jmplabel($3.lb1); gen_dstlabel($5.lb2); gen_jmplabel($3.lb2); gen_dstlabel($5.lb1); } else { gen_jmplabel($3.lb1); gen_dstlabel($5.lb1); } } END_PERFORM { $$ = NULL; } | with_test_opt VARYING name FROM gname by_opt gname UNTIL { /* Check if initailization of the 'VARYING identifier' is required. Initailization of the 'VARYING identifier' is not neccessary if it is the same as the 'FROM identifier'. */ if ($5->litflag == '1') { gen_move($5,$3); } else { if(strcmp($5->name, $3->name) != 0) { gen_move($5,$3); } } /* BEFORE=1 AFTER=2 */ if ($1 == 2) { $$.lb2=gen_passlabel(); } $$.lb1=gen_marklabel(); } condition { $$=gen_orstart(); /* BEFORE=1 AFTER=2 */ if ($1 == 2) { gen_add($7,$3,0); gen_dstlabel($9.lb2); } } perform_after_opt perform_statements { int i; struct perf_info *rf; /*struct perform_info *rpi;*/ char *vn; /* Check for duplicate variables in VARYING/AFTER */ if ($12 != NULL) { if ((vn = check_perform_variables($3, $12)) != NULL) { yyerror("Duplicate variable '%s' in VARYING/AFTER clause", vn); } } if ($1 == 2) { if ($12 != NULL) { for (i=5; i>=0; i--) { rf = $12->pf[i]; if (rf != NULL) { gen_jmplabel(rf->ljmp); gen_dstlabel(rf->lend); } } } gen_jmplabel($9.lb1); gen_dstlabel($11); } else { if ($12 != NULL) { for (i=5; i>=0; i--) { rf = $12->pf[i]; if (rf != NULL) { gen_add(rf->pname1, rf->pname2, 0); gen_jmplabel(rf->ljmp); gen_dstlabel(rf->lend); } } } gen_add($7,$3,0); gen_jmplabel($9.lb1); gen_dstlabel($11); } } END_PERFORM { $$ = NULL; } | label perform_thru_opt { gen_perform_thru($1,$2); $$ = NULL; } | label perform_thru_opt with_test_opt UNTIL { $$=gen_marklabel(); /* BEFORE=1 AFTER=2 */ if ($3 == 2) { gen_perform_thru($1,$2); } } condition { unsigned long lbl; lbl=gen_orstart(); /* BEFORE=1 AFTER=2 */ if ($3 == 1) { gen_perform_thru($1,$2); } gen_jmplabel($5); gen_dstlabel(lbl); } | label perform_thru_opt gname TIMES { unsigned long lbl; gen_push_int($3); lbl = gen_marklabel(); gen_perform_test_counter(lbl); gen_perform_thru($1,$2); gen_perform_times(lbl); } | label perform_thru_opt with_test_opt VARYING name FROM gname by_opt gname UNTIL { /* Check if initailization of the 'VARYING identifier' is required. Initailization of the 'VARYING identifier' is not neccessary if it is the same as the 'FROM identifier'. */ if ($7->litflag == '1') { gen_move($7,$5); } else { if(strcmp($7->name, $5->name) != 0) { gen_move($7,$5); } } if ($3 == 2) { $$.lb2=gen_passlabel(); } $$.lb1 = gen_marklabel(); } condition { $$ = gen_orstart(); /* BEFORE=1 AFTER=2 */ if ($3 == 2) { gen_add($9,$5, 0); gen_dstlabel($11.lb2); } } perform_after_opt { int i; struct perf_info *rf; /*struct perform_info *rpi;*/ char *vn = NULL; /* Check for duplicate varaibles in VARYING/AFTER */ if ($14 != NULL) { if ((vn = check_perform_variables($5, $14)) != NULL) { yyerror("Duplicate variable '%s' in VARYING/AFTER clause", vn); } } gen_perform_thru($1,$2); /* BEFORE=1 AFTER=2 */ if ($3 == 2) { if ($14 != NULL) { for (i=5; i>=0; i--) { rf = $14->pf[i]; if (rf != NULL) { gen_jmplabel(rf->ljmp); gen_dstlabel(rf->lend); } } } gen_jmplabel($11); gen_dstlabel($13); } else { if ($14 != NULL) { for (i=5; i>=0; i--) { rf = $14->pf[i]; if (rf != NULL) { gen_add(rf->pname1, rf->pname2, 0); gen_jmplabel(rf->ljmp); gen_dstlabel(rf->lend); } } } gen_add($9,$5,0); gen_jmplabel($11); gen_dstlabel($13); } $$ = NULL; } ; perform_thru_opt: /* nothing */ { $$ = NULL; } | THRU label { $$ = $2;} ; with_test_opt: { $$=1; perform_after_sw=1; } | with_opt TEST before_after { $$=$3; perform_after_sw=$3; } ; perform_after_opt: /* nothing */ { $$=NULL; } | AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$=$$; } | AFTER perform_after AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$->pf[1] = $4; $$=$$; } | AFTER perform_after AFTER perform_after AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$->pf[1] = $4; $$->pf[2] = $6; $$=$$; } | AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$->pf[1] = $4; $$->pf[2] = $6; $$->pf[3] = $8; $$=$$; } | AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$->pf[1] = $4; $$->pf[2] = $6; $$->pf[3] = $8; $$->pf[4] = $10; $$=$$; } | AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after AFTER perform_after { $$=create_perform_info(); $$->pf[0] = $2; $$->pf[1] = $4; $$->pf[2] = $6; $$->pf[3] = $8; $$->pf[4] = $10; $$->pf[5] = $12; $$=$$; } ; perform_after: name FROM gname by_opt gname UNTIL { /* Check if initailization of the 'VARYING identifier' is required. Initailization of the 'VARYING identifier' is not neccessary if it is the same as the 'FROM identifier'. */ if ($3->litflag == '1') { gen_move($3,$1); } else { if(strcmp($3->name, $1->name) != 0) { gen_move($3,$1); } } /* BEFORE=1 AFTER=2 */ if (perform_after_sw == 2) { $$.lb2=gen_passlabel(); } $$.lb1 = gen_marklabel(); } condition { unsigned long lbl; lbl=gen_orstart(); /* BEFORE=1 AFTER=2 */ if (perform_after_sw == 2) { gen_add($5,$1,0); gen_dstlabel($7.lb2); $$ = create_perf_info($5, $1, $7.lb1, lbl); } else { $$ = create_perf_info($5, $1, $7.lb1, lbl); } } ; perform_statements: {stabs_line();} statement_list /* | { stabs_line(); } CONTINUE */ ; before_after: BEFORE { $$=1; } | AFTER { $$=2; } ; condition: expr extended_cond_op { if ($2 & COND_UNARY) { if ($2 & COND_CLASS) { gen_class_check($1,$2); } else { struct sym *sy = (struct sym *)save_special_literal('0','9', "%ZEROS%"); gen_compare($1,$2&~COND_UNARY,sy); } } } expr_opt { if ($2 & COND_UNARY) { if ((int)$4 != -1) { yyerror("class or sign conditions are unary"); } } else { if ((int)$4 == -1) { yyerror("expression expected in a binary condition"); } else { gen_compare($1,$2,$4); } } $$.sy=$1; /* for implied operands */ $$.oper=$2; } | NOT condition { gen_not(); $$=$2; } | condition AND { $$=gen_andstart(); } implied_op_condition { gen_dstlabel($3); $$=$4; } | condition OR { $$=gen_orstart(); } implied_op_condition { gen_dstlabel($3); $$=$4; } | '(' condition ')' { $$ = $2; } | cond_name { /*if ($1->level != 88) yyerror("condition unknown");*/ gen_condition($1); $$.sy=NULL; $$.oper=0; } ; implied_op_condition: condition { $$ = $1; } | cond_op expr { if ($-2.sy == NULL) { yyerror("invalid implied condition"); } else { gen_compare($-2.sy,$1,$2); } $$.sy = $-2.sy; $$.oper = $1; } | expr { /* implied both the first operand and the operator */ if (($-2.sy == NULL)|| ($-2.oper & COND_UNARY)) { yyerror("invalid implied condition"); } else { gen_compare($-2.sy,$-2.oper,$1); } $$.sy = $-2.sy; $$.oper = $-2.oper; } ; sign_condition: POSITIVE { $$=GREATER; } | NEGATIVE { $$=LESS; } | ZERO { $$=EQUAL; } ; class_condition: NUMERIC { $$=CLASS_NUMERIC; } | ALPHABETIC { $$=CLASS_ALPHABETIC; } | ALPHABETIC_LOWER { $$=CLASS_ALPHABETIC_LOWER; } | ALPHABETIC_UPPER { $$=CLASS_ALPHABETIC_UPPER; } ; extended_cond_op: IS ext_cond { $$ = $2; } | IS NOT ext_cond { $$ = $3 ^ 7; } | IS ext_cond OR ext_cond { $$ = $2 | $4; } | ext_cond { $$ = $1; } | NOT is_opt ext_cond { $$ = $3 ^ 7; } | ext_cond OR ext_cond { $$ = $1 | $3; } ; ext_cond: conditional { $$ = $1; } | class_condition { $$ = $1 | COND_UNARY | COND_CLASS; } | sign_condition { $$ = $1 | COND_UNARY; } ; cond_op: conditional { $$ = $1; } | NOT conditional { $$ = $2 ^ 7; } | conditional OR conditional { $$ = $1 | $3; } ; conditional: CONDITIONAL than_to_opt { $$ = $1; } ; comma_opt: /* nothing */ | ',' ; sep_opt: /* nothing */ | LISTSEP ; /* this token doesn't really exists, but forces look ahead to keep line numbers synchronized with our position because we need to generate correct debug stabs */ /* dummy_opt: / nothing / | TOKDUMMY ; */ key_opt: /* nothing */ | KEY ; advancing_opt: /* nothing */ | ADVANCING ; than_to_opt: /* nothing */ | TO { } | THAN { } ; record_opt: /* nothing */ | RECORD ; at_opt: /* nothing */ | AT ; in_opt: /* nothing */ | IN ; in_of: IN | OF ; by_opt: /* nothing */ | BY ; with_opt: /* nothing */ | WITH ; on_opt: /* nothing */ | ON ; gname_opt: gname { $$ = $1; } | /* nothing */ { $$ = NULL; } ; to_opt: /* nothing */ | TO { } ; name_var_list: name_var { $$ = gvar_list_append(NULL, $1, source_lineno); } | name_var_list sep_opt name_var { $$ = gvar_list_append($1, $3, source_lineno); } ; gname_list: gname { $$ = gvar_list_append(NULL, $1, source_lineno); } | gname_list sep_opt gname { $$ = gvar_list_append($1, $3, source_lineno); } ; gname: name { /*if (!is_variable($1)) { yyerror("The symbol \"%s\" is not an allowed argument here", $1->name); }*/ $$ = $1; } | gliteral { $$ = (struct sym *)$1;} | FUNCTION LABELSTR '(' { $2->type = 'f'; /* function type */ $$=CALL; } intrinsic_parm_list ')' { $$ = gen_intrinsic_call((struct sym *)$2); } | FUNCTION LABELSTR { $2->type = 'f'; /* function type */ $$=CALL; $$ = gen_intrinsic_call((struct sym *)$2); } ; name_or_lit: name { $$ = $1; } | literal { $$ = (struct sym *)$1; } ; noallname: name { $$ = $1; } | without_all_literal { $$ = (struct sym *)$1; } ; gliteral: without_all_literal | all_literal ; without_all_literal: literal { $$=$1; } | special_literal { $$=$1; } ; all_literal: ALL literal { $2->all=1; $$=$2; } | ALL special_literal { $$=$2; } ; special_literal: SPACES { $$=spe_lit_SP; } | ZERO { $$=spe_lit_ZE; } | QUOTES { $$=spe_lit_QU; } | HIGHVALUES { $$=spe_lit_HV; } | LOWVALUES { $$=spe_lit_LV; } ; var_or_nliteral: variable { $$ = $1; } | nliteral { $$ = (struct sym *)$1; } ; nliteral: signed_nliteral { save_literal($1,'9'); $1->all = 0; $$=$1; } ; literal: signed_nliteral { save_literal($1,'9'); $1->all=0; $$=$1; } | CLITERAL { save_literal($1,'X'); $1->all=0; $$=$1; } ; signed_nliteral: NLITERAL { check_decimal_point($1); $$=$1; } | '+' NLITERAL { check_decimal_point($2); $$=$2; } | '-' NLITERAL { check_decimal_point($2); invert_literal_sign( $2 ); $$=$2; } ; def_name_opt: def_name { $$ = $1; } | /* nothing */ { $$ = NULL; } ; def_name: STRING { if ($1->defined) yyerror("variable redefined, %s",$1->name); $1->defined=1; $$=$1; } | FILLER { $$=alloc_filler(); } ; variable_indexed: SUBSCVAR { if ($1->occurs_flg == 0 && !in_occurs($1)) // walter yyerror("\"%s\" is not an indexed variable ", $1->name); $$=$1; } ; /*variable: VARIABLE { $$=$1; } | VARIABLE in_of subs_var { struct sym *v; v=lookup_variable($1,$3); if ($$==NULL) yyerror("\"%s\" is not child of \"%s\"",$1,$3); if ($3->litflag==2) { ((struct vref *)$3)->sym = v; $$ = $3; } else { $$ = v; } } | LABELSTR { yyerror("%s is not a defined variable",$1->name); } ; */ filename: literal { $$=(struct sym *)$1; } | STRING {$$=$1; } ; data_name: literal { $$=(struct sym *)$1; } | STRING {$$=$1; } ; cond_name: VARCOND '(' { curr_division = CDIV_SUBSCRIPTS; } subscripts ')' { curr_division = CDIV_PROC; $$ = (struct sym *)create_subscripted_var( $1, $4 ); /*check_subscripts($$);*/ } | VARCOND { $$=$1; } ; name: variable '(' gname ':' gname_opt ')' { $$=(struct sym *)create_refmoded_var($1, $3, $5); check_refmods((struct sym *)$$); is_var=1; } | variable { is_var=1; } | LABELSTR { yyerror("Invalid argument expecting variable"); is_var=2; } ; name_var: gname { if (!is_var) yyerror("Invalid argument expecting variable"); is_var=0; } ; /*subs_var: variable | subscripted_variable ; subscripted_variable: SUBSCVAR '(' { curr_division = CDIV_SUBSCRIPTS; } subscripts ')' { curr_division = CDIV_PROC; $$ = (struct sym *)create_subscripted_var( $1, $4 ); check_subscripts($$); } | SUBSCVAR in_of subs_var '(' { curr_division = CDIV_SUBSCRIPTS; } subscripts ')' { curr_division = CDIV_PROC; $$ = (struct sym *)create_subscripted_var( lookup_variable($1,$3), $6 ); check_subscripts($$); } ; */ variable: qualified_var { $$=$1; if (need_subscripts && $1->occurs_flg == 0) { /* verify if the variable is present in the same area of occurs clause */ if(!in_occurs($1)) { yyerror("this variable \'%s\' must be subscripted or indexed", $1->name); need_subscripts=0; } } } | qualified_var LPAR { curr_division = CDIV_SUBSCRIPTS; } subscripts ')' { curr_division = CDIV_PROC; $$ = (struct sym *)create_subscripted_var( $1, $4 ); check_subscripts($$); } ; qualified_var: unqualified_var { $$=$1; if ($1->clone != 0) yyerror("this variable \'%s\' must be qualified", $1->name); } | unqualified_var in_of qualified_var { $$=lookup_parent($1,$3); if ($$ == NULL) { yyerror("this variable \'%s\' is not defined in '%s'", $1->name, $3->name); $$=$1; } } ; unqualified_var: VARIABLE { if (($1->defined == 0) && ($1->type == 0)) { yyerror("Undefined variable \'%s\' found", $1->name); } $$=$1; } | SUBSCVAR { need_subscripts=1; $$=$1; } ; subscripts: subscript { $$ = $1; } | subscripts comma_opt subscript { $$ = add_subscript( $1, $3 ); } ; subscript: gname { $$ = create_subscript( $1 ); } | subscript '+' gname { $$ = add_subscript_item( $1, '+', $3 ); } | subscript '-' gname { $$ = add_subscript_item( $1, '-', $3 ); } ; integer: signed_nliteral { char *s; $$=0; s=$1->name; while (isdigit(*s)) $$ = $$ * 10 + *s++ - '0'; if (*s) yyerror("only integers accepted here"); } ; label: LABELSTR in_of LABELSTR { struct sym *lab=$1; struct sym *sec=$3; if (sec->defined == 0) { sec->defined = 2; sec->parent = NULL; } else { if ((sec=lookup_label($3,NULL))==NULL) { sec = install($3->name,SYTB_LAB,2); sec->defined=2; sec->parent = NULL; } } if (lab->defined == 0) { lab->defined = 2; lab->parent = $3; } else { if ((lab=lookup_label($1,$3))==NULL) { lab = install($1->name,SYTB_LAB,2); lab->defined=2; lab->parent = $3; } } $$ = lab; } | LABELSTR { struct sym *lab=$1; if (lab->defined == 0) { lab->defined = 2; lab->parent = curr_section; } else { if ((lab=lookup_label(lab,curr_section))==NULL) { lab = install($1->name,SYTB_LAB,2); lab->defined=2; lab->parent = curr_section; } } $$ = lab; } | NLITERAL {$$=define_label((struct sym *)$1,1,NULL,0);} | NLITERAL in_of NLITERAL {$$=define_label((struct sym *)$1,1,(struct sym *)$3,1);} | NLITERAL in_of LABELSTR {$$=define_label((struct sym *)$1,1,$3,0);} ; anystring: STRING | LABELSTR ; %% /* ** Yacc auxiliary routines */ /* *********************************************** * hterror is called where yyerror is normally * * called within the parser, but it also passes* * an error number and severity. The error * * number identifies the longer description of * * the error message in the compiler document- * * ation. The severity is used to set the * * return code that the compiler will return. * ***********************************************/ void hterror(int erno, int severity, char *s,...) { HTG_temporary_error_code = erno; HTG_temporary_severity = severity; yyerror(s); HTG_temporary_error_code = 256; HTG_temporary_severity = 8; return; } void yywarn(char *s,...) { va_list ap; va_start (ap, s); HTG_temporary_severity = 4; yyerror(s, ap); va_end(ap); HTG_temporary_severity = 8; } extern FILE *o_lst; void yyerror(char *s,...) { char buff1[BUFSIZ], buff2[BUFSIZ]; const char *label; va_list argptr; int slen=0; /* Determine the type of the error */ switch (HTG_temporary_severity) { case TCOB_SEVERITY_INFO: label = "info: "; break; case TCOB_SEVERITY_WARN: label = "warning: "; if (HTG_RETURN_CODE < 4) HTG_RETURN_CODE = 4; wrncnt++; break; case TCOB_SEVERITY_ERROR: label = "error: "; if (HTG_RETURN_CODE < 8) HTG_RETURN_CODE = 8; errcnt++; break; default: label = "error: "; if (HTG_RETURN_CODE < HTG_temporary_severity) HTG_RETURN_CODE = HTG_temporary_severity; errcnt++; break; } /* Build the error message */ va_start(argptr,s); vsprintf (buff1, s, argptr); va_end (argptr); /* Display the error */ slen = strlen(yytext); if (slen != 0) { sprintf (buff2, "%s:%6d: %s%s, on or before \'%s\'\n", source_filename, source_lineno, label, buff1, yytext); } else { sprintf (buff2, "%s:%6d: %s%s\n", source_filename, source_lineno, label, buff1); } fputs (buff2, stderr); if (HTG_list_flag) fputs (buff2, o_lst); } static void assert_numeric_sy (struct sym *sy) { if (!is_numeric_sy(sy)) yyerror("invalid (non numeric) variable or literal \'%s\' used in arithmetic verb", sy->name); } static void assert_numeric_dest_sy (struct sym *sy) { if (!is_numeric_dest_sy(sy)) yyerror("invalid destination variable \'%s\' used in arithmetic verb", sy->name); }